1 (*
2  * Hedgewars, a free turn based strategy game
3  * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
4  *
5  * This program is free software; you can redistribute it and/or modify
6  * it under the terms of the GNU General Public License as published by
7  * the Free Software Foundation; version 2 of the License
8  *
9  * This program is distributed in the hope that it will be useful,
10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
12  * GNU General Public License for more details.
13  *
14  * You should have received a copy of the GNU General Public License
15  * along with this program; if not, write to the Free Software
16  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
17  *)
18 
19 {$INCLUDE "options.inc"}
20 
21 unit uLandPainted;
22 
23 interface
24 
25 procedure Draw;
26 procedure initModule;
27 procedure freeModule;
28 
29 implementation
30 uses uLandGraphics, uConsts, uVariables, uUtils, SDLh, uCommands, uScript, uIO;
31 
32 type PointRec = packed record
33     X, Y: SmallInt;
34     flags: byte;
35     end;
36     PPointRec = ^PointRec;
37 
38 type
39     PPointEntry = ^PointEntry;
40     PointEntry = record
41         point: PointRec;
42         next: PPointEntry;
43         end;
44 
45 var pointsListHead, pointsListLast: PPointEntry;
46 
47 procedure chDraw(var s: shortstring);
48 var rec: PointRec;
49     prec: PPointRec;
50     pe: PPointEntry;
51     i, l: byte;
52 begin
53     i:= 1;
54     l:= length(s);
55     while i < l do
56         begin
57         prec:= PPointRec(@s[i]);
58         rec:= prec^;
59         rec.X:= SDLNet_Read16(@rec.X);
60         rec.Y:= SDLNet_Read16(@rec.Y);
61 
62         if rec.X < -318 then rec.X:= -318;
63         if rec.X > 4096+318 then rec.X:= 4096+318;
64         if rec.Y < -318 then rec.Y:= -318;
65         if rec.Y > 2048+318 then rec.Y:= 2048+318;
66 
67         new(pe);
68         if pointsListLast = nil then
69             pointsListHead:= pe
70         else
71             pointsListLast^.next:= pe;
72         pointsListLast:= pe;
73 
74         pe^.point:= rec;
75         pe^.next:= nil;
76 
77         inc(i, 5)
78         end;
79 end;
80 
81 procedure Draw;
82 var pe: PPointEntry;
83     prevPoint: PointRec;
84     radius: LongInt;
85     color, Xoffset, Yoffset: Longword;
86     lineNumber, linePoints: Longword;
87 begin
88     // shutup compiler
89     prevPoint.X:= 0;
90     prevPoint.Y:= 0;
91     radius:= 0;
92     linePoints:= 0;
93     Xoffset:= (LAND_WIDTH-(playWidth)) div 2;
94     Yoffset:= LAND_HEIGHT-(playHeight);
95 
96     pe:= pointsListHead;
97     while (pe <> nil) and (pe^.point.flags and $80 = 0) do
98         begin
99         ScriptCall('onSpecialPoint', pe^.point.X, pe^.point.Y, pe^.point.flags);
100         pe:= pe^.next;
101         end;
102 
103     lineNumber:= 0;
104 
105     while(pe <> nil) do
106         begin
107         pe^.point.X:= LongInt(pe^.point.X) * playWidth div 4096 + Xoffset;
108         pe^.point.Y:= LongInt(pe^.point.Y) * playHeight div 2048 + Yoffset;
109         if (pe^.point.flags and $80 <> 0) then
110             begin
111             if (lineNumber > 0) and (linePoints = 0) and cAdvancedMapGenMode then
112                     SendIPC('|' + inttostr(lineNumber - 1));
113 
114             inc(lineNumber);
115 
116             if (pe^.point.flags and $40 <> 0) then
117                 color:= 0
118                 else
119                 color:= lfBasic;
120             radius:= (pe^.point.flags and $3F) * 5 + 3;
121             radius:= (radius * playWidth div 4096);
122             linePoints:= FillRoundInLand(pe^.point.X, pe^.point.Y, radius, color);
123             end
124         else
125             begin
126             inc(linePoints, DrawThickLine(prevPoint.X, prevPoint.Y, pe^.point.X, pe^.point.Y, radius, color));
127             end;
128 
129         prevPoint:= pe^.point;
130         pe:= pe^.next;
131         end;
132 
133     if (topY > 0) then
134         EraseLandRectRaw(0, 0, LAND_WIDTH, topY);
135     if (leftX > 0) then
136         EraseLandRectRaw(0, topY, leftX, LAND_HEIGHT - topY);
137     if (rightX < (LAND_WIDTH - 1)) then
138         EraseLandRectRaw(rightX + 1, topY, LAND_WIDTH - (rightX + 1), LAND_HEIGHT - topY);
139 end;
140 
141 procedure initModule;
142 begin
143     pointsListHead:= nil;
144     pointsListLast:= nil;
145 
146     RegisterVariable('draw', @chDraw, false);
147 end;
148 
149 procedure freeModule;
150 var pe, pp: PPointEntry;
151 begin
152     pe:= pointsListHead;
153     while(pe <> nil) do
154         begin
155         pp:= pe;
156         pe:= pe^.next;
157         dispose(pp);
158         end;
159 end;
160 
161 end.
162