|
1 unit uLandOutline; |
|
2 |
|
3 interface |
|
4 |
|
5 uses uConsts, SDLh, uFloat; |
|
6 |
|
7 type TPixAr = record |
|
8 Count: Longword; |
|
9 ar: array[0..Pred(cMaxEdgePoints)] of TPoint; |
|
10 end; |
|
11 |
|
12 procedure DrawEdge(var pa: TPixAr; Color: Longword); |
|
13 procedure FillLand(x, y: LongInt); |
|
14 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); |
|
15 procedure RandomizePoints(var pa: TPixAr); |
|
16 |
|
17 implementation |
|
18 |
|
19 uses uLandGraphics, uDebug, uVariables, uLandTemplates, uMisc, uRandom, uUtils; |
|
20 |
|
21 |
|
22 |
|
23 var Stack: record |
|
24 Count: Longword; |
|
25 points: array[0..8192] of record |
|
26 xl, xr, y, dir: LongInt; |
|
27 end |
|
28 end; |
|
29 |
|
30 procedure Push(_xl, _xr, _y, _dir: LongInt); |
|
31 begin |
|
32 TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true); |
|
33 _y:= _y + _dir; |
|
34 if (_y < 0) or (_y >= LAND_HEIGHT) then exit; |
|
35 with Stack.points[Stack.Count] do |
|
36 begin |
|
37 xl:= _xl; |
|
38 xr:= _xr; |
|
39 y:= _y; |
|
40 dir:= _dir |
|
41 end; |
|
42 inc(Stack.Count) |
|
43 end; |
|
44 |
|
45 procedure Pop(var _xl, _xr, _y, _dir: LongInt); |
|
46 begin |
|
47 dec(Stack.Count); |
|
48 with Stack.points[Stack.Count] do |
|
49 begin |
|
50 _xl:= xl; |
|
51 _xr:= xr; |
|
52 _y:= y; |
|
53 _dir:= dir |
|
54 end |
|
55 end; |
|
56 |
|
57 procedure FillLand(x, y: LongInt); |
|
58 var xl, xr, dir: LongInt; |
|
59 begin |
|
60 Stack.Count:= 0; |
|
61 xl:= x - 1; |
|
62 xr:= x; |
|
63 Push(xl, xr, y, -1); |
|
64 Push(xl, xr, y, 1); |
|
65 dir:= 0; |
|
66 while Stack.Count > 0 do |
|
67 begin |
|
68 Pop(xl, xr, y, dir); |
|
69 while (xl > 0) and (Land[y, xl] <> 0) do dec(xl); |
|
70 while (xr < LAND_WIDTH - 1) and (Land[y, xr] <> 0) do inc(xr); |
|
71 while (xl < xr) do |
|
72 begin |
|
73 while (xl <= xr) and (Land[y, xl] = 0) do inc(xl); |
|
74 x:= xl; |
|
75 while (xl <= xr) and (Land[y, xl] <> 0) do |
|
76 begin |
|
77 Land[y, xl]:= 0; |
|
78 inc(xl) |
|
79 end; |
|
80 if x < xl then |
|
81 begin |
|
82 Push(x, Pred(xl), y, dir); |
|
83 Push(x, Pred(xl), y,-dir); |
|
84 end; |
|
85 end; |
|
86 end; |
|
87 end; |
|
88 |
|
89 procedure DrawEdge(var pa: TPixAr; Color: Longword); |
|
90 var i: LongInt; |
|
91 begin |
|
92 i:= 0; |
|
93 with pa do |
|
94 while i < LongInt(Count) - 1 do |
|
95 if (ar[i + 1].X = NTPX) then |
|
96 inc(i, 2) |
|
97 else |
|
98 begin |
|
99 DrawLine(ar[i].x, ar[i].y, ar[i + 1].x, ar[i + 1].y, Color); |
|
100 inc(i) |
|
101 end |
|
102 end; |
|
103 |
|
104 |
|
105 procedure Vector(p1, p2, p3: TPoint; var Vx, Vy: hwFloat); |
|
106 var d1, d2, d: hwFloat; |
|
107 begin |
|
108 Vx:= int2hwFloat(p1.X - p3.X); |
|
109 Vy:= int2hwFloat(p1.Y - p3.Y); |
|
110 |
|
111 d:= DistanceI(p2.X - p1.X, p2.Y - p1.Y); |
|
112 d1:= DistanceI(p2.X - p3.X, p2.Y - p3.Y); |
|
113 d2:= Distance(Vx, Vy); |
|
114 |
|
115 if d1 < d then d:= d1; |
|
116 if d2 < d then d:= d2; |
|
117 |
|
118 d:= d * _1div3; |
|
119 |
|
120 if d2.QWordValue = 0 then |
|
121 begin |
|
122 Vx:= _0; |
|
123 Vy:= _0 |
|
124 end |
|
125 else |
|
126 begin |
|
127 d2:= _1 / d2; |
|
128 Vx:= Vx * d2; |
|
129 Vy:= Vy * d2; |
|
130 |
|
131 Vx:= Vx * d; |
|
132 Vy:= Vy * d |
|
133 end |
|
134 end; |
|
135 |
|
136 procedure AddLoopPoints(var pa, opa: TPixAr; StartI, EndI: LongInt; Delta: hwFloat); |
|
137 var i, pi, ni: LongInt; |
|
138 NVx, NVy, PVx, PVy: hwFloat; |
|
139 x1, x2, y1, y2: LongInt; |
|
140 tsq, tcb, t, r1, r2, r3, cx1, cx2, cy1, cy2: hwFloat; |
|
141 X, Y: LongInt; |
|
142 begin |
|
143 pi:= EndI; |
|
144 i:= StartI; |
|
145 ni:= Succ(StartI); |
|
146 {$HINTS OFF} |
|
147 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); |
|
148 {$HINTS ON} |
|
149 repeat |
|
150 inc(pi); |
|
151 if pi > EndI then pi:= StartI; |
|
152 inc(i); |
|
153 if i > EndI then i:= StartI; |
|
154 inc(ni); |
|
155 if ni > EndI then ni:= StartI; |
|
156 PVx:= NVx; |
|
157 PVy:= NVy; |
|
158 Vector(opa.ar[pi], opa.ar[i], opa.ar[ni], NVx, NVy); |
|
159 |
|
160 x1:= opa.ar[pi].x; |
|
161 y1:= opa.ar[pi].y; |
|
162 x2:= opa.ar[i].x; |
|
163 y2:= opa.ar[i].y; |
|
164 cx1:= int2hwFloat(x1) - PVx; |
|
165 cy1:= int2hwFloat(y1) - PVy; |
|
166 cx2:= int2hwFloat(x2) + NVx; |
|
167 cy2:= int2hwFloat(y2) + NVy; |
|
168 t:= _0; |
|
169 while t.Round = 0 do |
|
170 begin |
|
171 tsq:= t * t; |
|
172 tcb:= tsq * t; |
|
173 r1:= (_1 - t*3 + tsq*3 - tcb); |
|
174 r2:= ( t*3 - tsq*6 + tcb*3); |
|
175 r3:= ( tsq*3 - tcb*3); |
|
176 X:= hwRound(r1 * x1 + r2 * cx1 + r3 * cx2 + tcb * x2); |
|
177 Y:= hwRound(r1 * y1 + r2 * cy1 + r3 * cy2 + tcb * y2); |
|
178 t:= t + Delta; |
|
179 pa.ar[pa.Count].x:= X; |
|
180 pa.ar[pa.Count].y:= Y; |
|
181 inc(pa.Count); |
|
182 TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true) |
|
183 end; |
|
184 until i = StartI; |
|
185 pa.ar[pa.Count].x:= opa.ar[StartI].X; |
|
186 pa.ar[pa.Count].y:= opa.ar[StartI].Y; |
|
187 inc(pa.Count) |
|
188 end; |
|
189 |
|
190 procedure BezierizeEdge(var pa: TPixAr; Delta: hwFloat); |
|
191 var i, StartLoop: LongInt; |
|
192 opa: TPixAr; |
|
193 begin |
|
194 opa:= pa; |
|
195 pa.Count:= 0; |
|
196 i:= 0; |
|
197 StartLoop:= 0; |
|
198 while i < LongInt(opa.Count) do |
|
199 if (opa.ar[i + 1].X = NTPX) then |
|
200 begin |
|
201 AddLoopPoints(pa, opa, StartLoop, i, Delta); |
|
202 inc(i, 2); |
|
203 StartLoop:= i; |
|
204 pa.ar[pa.Count].X:= NTPX; |
|
205 pa.ar[pa.Count].Y:= 0; |
|
206 inc(pa.Count); |
|
207 end else inc(i) |
|
208 end; |
|
209 |
|
210 |
|
211 function CheckIntersect(V1, V2, V3, V4: TPoint): boolean; |
|
212 var c1, c2, dm: LongInt; |
|
213 begin |
|
214 dm:= (V4.y - V3.y) * (V2.x - V1.x) - (V4.x - V3.x) * (V2.y - V1.y); |
|
215 c1:= (V4.x - V3.x) * (V1.y - V3.y) - (V4.y - V3.y) * (V1.x - V3.x); |
|
216 if dm = 0 then exit(false); |
|
217 |
|
218 c2:= (V2.x - V3.x) * (V1.y - V3.y) - (V2.y - V3.y) * (V1.x - V3.x); |
|
219 if dm > 0 then |
|
220 begin |
|
221 if (c1 < 0) or (c1 > dm) then exit(false); |
|
222 if (c2 < 0) or (c2 > dm) then exit(false) |
|
223 end |
|
224 else |
|
225 begin |
|
226 if (c1 > 0) or (c1 < dm) then exit(false); |
|
227 if (c2 > 0) or (c2 < dm) then exit(false) |
|
228 end; |
|
229 |
|
230 //AddFileLog('1 (' + inttostr(V1.x) + ',' + inttostr(V1.y) + ')x(' + inttostr(V2.x) + ',' + inttostr(V2.y) + ')'); |
|
231 //AddFileLog('2 (' + inttostr(V3.x) + ',' + inttostr(V3.y) + ')x(' + inttostr(V4.x) + ',' + inttostr(V4.y) + ')'); |
|
232 CheckIntersect:= true |
|
233 end; |
|
234 |
|
235 |
|
236 function CheckSelfIntersect(var pa: TPixAr; ind: Longword): boolean; |
|
237 var i: Longword; |
|
238 begin |
|
239 if (ind <= 0) or (ind >= Pred(pa.Count)) then exit(false); |
|
240 for i:= 1 to pa.Count - 3 do |
|
241 if (i <= ind - 1) or (i >= ind + 2) then |
|
242 begin |
|
243 if (i <> ind - 1) and |
|
244 CheckIntersect(pa.ar[ind], pa.ar[ind - 1], pa.ar[i], pa.ar[i - 1]) then exit(true); |
|
245 if (i <> ind + 2) and |
|
246 CheckIntersect(pa.ar[ind], pa.ar[ind + 1], pa.ar[i], pa.ar[i - 1]) then exit(true); |
|
247 end; |
|
248 CheckSelfIntersect:= false |
|
249 end; |
|
250 |
|
251 procedure RandomizePoints(var pa: TPixAr); |
|
252 const cEdge = 55; |
|
253 cMinDist = 8; |
|
254 var radz: array[0..Pred(cMaxEdgePoints)] of LongInt; |
|
255 i, k, dist, px, py: LongInt; |
|
256 begin |
|
257 for i:= 0 to Pred(pa.Count) do |
|
258 begin |
|
259 radz[i]:= 0; |
|
260 with pa.ar[i] do |
|
261 if x <> NTPX then |
|
262 begin |
|
263 radz[i]:= Min(Max(x - cEdge, 0), Max(LAND_WIDTH - cEdge - x, 0)); |
|
264 radz[i]:= Min(radz[i], Min(Max(y - cEdge, 0), Max(LAND_HEIGHT - cEdge - y, 0))); |
|
265 if radz[i] > 0 then |
|
266 for k:= 0 to Pred(i) do |
|
267 begin |
|
268 dist:= Max(abs(x - pa.ar[k].x), abs(y - pa.ar[k].y)); |
|
269 radz[k]:= Max(0, Min((dist - cMinDist) div 2, radz[k])); |
|
270 radz[i]:= Max(0, Min(dist - radz[k] - cMinDist, radz[i])) |
|
271 end |
|
272 end; |
|
273 end; |
|
274 |
|
275 for i:= 0 to Pred(pa.Count) do |
|
276 with pa.ar[i] do |
|
277 if ((x and LAND_WIDTH_MASK) = 0) and ((y and LAND_HEIGHT_MASK) = 0) then |
|
278 begin |
|
279 px:= x; |
|
280 py:= y; |
|
281 x:= x + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; |
|
282 y:= y + LongInt(GetRandom(7) - 3) * (radz[i] * 5 div 7) div 3; |
|
283 if CheckSelfIntersect(pa, i) then |
|
284 begin |
|
285 x:= px; |
|
286 y:= py |
|
287 end; |
|
288 end |
|
289 end; |
|
290 |
|
291 |
|
292 end. |