author | unc0rr |
Mon, 05 Dec 2005 21:46:15 +0000 | |
changeset 24 | 79c411363184 |
parent 23 | 16322d14f068 |
child 27 | c374fe590272 |
permissions | -rw-r--r-- |
4 | 1 |
(* |
2 |
* Hedgewars, a worms-like game |
|
3 |
* Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com> |
|
4 |
* |
|
5 |
* Distributed under the terms of the BSD-modified licence: |
|
6 |
* |
|
7 |
* Permission is hereby granted, free of charge, to any person obtaining a copy |
|
8 |
* of this software and associated documentation files (the "Software"), to deal |
|
9 |
* with the Software without restriction, including without limitation the |
|
10 |
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or |
|
11 |
* sell copies of the Software, and to permit persons to whom the Software is |
|
12 |
* furnished to do so, subject to the following conditions: |
|
13 |
* |
|
14 |
* 1. Redistributions of source code must retain the above copyright notice, |
|
15 |
* this list of conditions and the following disclaimer. |
|
16 |
* 2. Redistributions in binary form must reproduce the above copyright notice, |
|
17 |
* this list of conditions and the following disclaimer in the documentation |
|
18 |
* and/or other materials provided with the distribution. |
|
19 |
* 3. The name of the author may not be used to endorse or promote products |
|
20 |
* derived from this software without specific prior written permission. |
|
21 |
* |
|
22 |
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED |
|
23 |
* WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
|
24 |
* MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO |
|
25 |
* EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
|
26 |
* SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
|
27 |
* PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; |
|
28 |
* OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, |
|
29 |
* WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR |
|
30 |
* OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF |
|
31 |
* ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
|
32 |
*) |
|
33 |
||
34 |
unit uLand; |
|
35 |
interface |
|
36 |
uses SDLh; |
|
37 |
{$include options.inc} |
|
38 |
type TLandArray = packed array[0..1023, 0..2047] of LongWord; |
|
39 |
||
40 |
var Land: TLandArray; |
|
41 |
LandSurface: PSDL_Surface; |
|
42 |
||
43 |
procedure GenLandSurface; |
|
44 |
procedure MakeFortsMap; |
|
45 |
procedure AddHHPoint(_x, _y: integer); |
|
46 |
procedure GetHHPoint(out _x, _y: integer); |
|
47 |
procedure RandomizeHHPoints; |
|
48 |
||
49 |
implementation |
|
24 | 50 |
uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects; |
4 | 51 |
|
52 |
type TPixAr = record |
|
53 |
Count: Longword; |
|
22 | 54 |
ar: array[0..Pred(cMaxEdgePoints)] of TPoint; |
4 | 55 |
end; |
56 |
||
57 |
var HHPoints: record |
|
58 |
First, Last: word; |
|
22 | 59 |
ar: array[1..Pred(cMaxSpawnPoints)] of TPoint |
4 | 60 |
end = (First: 1); |
61 |
||
22 | 62 |
procedure DrawBezierEdge(var pa: TPixAr); |
4 | 63 |
var x, y, i: integer; |
64 |
tx, ty, vx, vy, vlen, t: real; |
|
65 |
r1, r2, r3, r4: real; |
|
66 |
x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; |
|
67 |
begin |
|
68 |
vx:= 0; |
|
69 |
vy:= 0; |
|
70 |
with pa do |
|
71 |
for i:= 0 to Count-2 do |
|
72 |
begin |
|
73 |
vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); |
|
74 |
t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); |
|
75 |
if t<vlen then vlen:= t; |
|
76 |
vlen:= vlen/3; |
|
77 |
tx:= ar[i+2].X - ar[i].X; |
|
78 |
ty:= ar[i+2].y - ar[i].y; |
|
79 |
t:= sqrt(sqr(tx)+sqr(ty)); |
|
80 |
if t = 0 then |
|
81 |
begin |
|
82 |
tx:= -tx * 100000; |
|
83 |
ty:= -ty * 100000; |
|
84 |
end else |
|
85 |
begin |
|
86 |
tx:= -tx/t; |
|
87 |
ty:= -ty/t; |
|
88 |
end; |
|
89 |
t:= 1.0*vlen; |
|
90 |
tx:= tx*t; |
|
91 |
ty:= ty*t; |
|
92 |
x1:= ar[i].x; |
|
93 |
y1:= ar[i].y; |
|
94 |
x2:= ar[i + 1].x; |
|
95 |
y2:= ar[i + 1].y; |
|
96 |
cx1:= ar[i].X + trunc(vx); |
|
97 |
cy1:= ar[i].y + trunc(vy); |
|
98 |
cx2:= ar[i+1].X + trunc(tx); |
|
99 |
cy2:= ar[i+1].y + trunc(ty); |
|
100 |
vx:= -tx; |
|
101 |
vy:= -ty; |
|
102 |
t:= 0; |
|
103 |
while t <= 1.0 do |
|
104 |
begin |
|
105 |
tsq:= sqr(t); |
|
106 |
tcb:= tsq * t; |
|
107 |
r1:= (1 - 3*t + 3*tsq - tcb) * x1; |
|
108 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cx1; |
|
109 |
r3:= ( 3*tsq - 3*tcb) * cx2; |
|
110 |
r4:= ( tcb) * x2; |
|
111 |
X:= round(r1 + r2 + r3 + r4); |
|
112 |
r1:= (1 - 3*t + 3*tsq - tcb) * y1; |
|
113 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cy1; |
|
114 |
r3:= ( 3*tsq - 3*tcb) * cy2; |
|
115 |
r4:= ( tcb) * y2; |
|
116 |
Y:= round(r1 + r2 + r3 + r4); |
|
117 |
t:= t + 0.001; |
|
118 |
if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then |
|
119 |
Land[y, x]:= $FFFFFF; |
|
120 |
end; |
|
121 |
end; |
|
122 |
end; |
|
123 |
||
22 | 124 |
procedure BezierizeEdge(var pa: TPixAr; Delta: real); |
125 |
var x, y, i: integer; |
|
126 |
tx, ty, vx, vy, vlen, t: real; |
|
127 |
r1, r2, r3, r4: real; |
|
128 |
x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; |
|
129 |
opa: TPixAr; |
|
130 |
begin |
|
131 |
opa:= pa; |
|
132 |
pa.Count:= 0; |
|
133 |
vx:= 0; |
|
134 |
vy:= 0; |
|
135 |
with opa do |
|
136 |
for i:= 0 to Count-2 do |
|
137 |
begin |
|
138 |
vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); |
|
139 |
t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); |
|
140 |
if t<vlen then vlen:= t; |
|
141 |
vlen:= vlen/3; |
|
142 |
tx:= ar[i+2].X - ar[i].X; |
|
143 |
ty:= ar[i+2].y - ar[i].y; |
|
144 |
t:= sqrt(sqr(tx)+sqr(ty)); |
|
145 |
if t = 0 then |
|
146 |
begin |
|
147 |
tx:= -tx * 100000; |
|
148 |
ty:= -ty * 100000; |
|
149 |
end else |
|
150 |
begin |
|
151 |
tx:= -tx/t; |
|
152 |
ty:= -ty/t; |
|
153 |
end; |
|
154 |
t:= 1.0*vlen; |
|
155 |
tx:= tx*t; |
|
156 |
ty:= ty*t; |
|
157 |
x1:= ar[i].x; |
|
158 |
y1:= ar[i].y; |
|
159 |
x2:= ar[i + 1].x; |
|
160 |
y2:= ar[i + 1].y; |
|
161 |
cx1:= ar[i].X + trunc(vx); |
|
162 |
cy1:= ar[i].y + trunc(vy); |
|
163 |
cx2:= ar[i+1].X + trunc(tx); |
|
164 |
cy2:= ar[i+1].y + trunc(ty); |
|
165 |
vx:= -tx; |
|
166 |
vy:= -ty; |
|
167 |
t:= 0; |
|
168 |
while t <= 1.0 do |
|
169 |
begin |
|
170 |
tsq:= sqr(t); |
|
171 |
tcb:= tsq * t; |
|
172 |
r1:= (1 - 3*t + 3*tsq - tcb) * x1; |
|
173 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cx1; |
|
174 |
r3:= ( 3*tsq - 3*tcb) * cx2; |
|
175 |
r4:= ( tcb) * x2; |
|
176 |
X:= round(r1 + r2 + r3 + r4); |
|
177 |
r1:= (1 - 3*t + 3*tsq - tcb) * y1; |
|
178 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cy1; |
|
179 |
r3:= ( 3*tsq - 3*tcb) * cy2; |
|
180 |
r4:= ( tcb) * y2; |
|
181 |
Y:= round(r1 + r2 + r3 + r4); |
|
182 |
t:= t + Delta; |
|
183 |
pa.ar[pa.Count].x:= X; |
|
184 |
pa.ar[pa.Count].y:= Y; |
|
185 |
inc(pa.Count); |
|
186 |
TryDo(pa.Count < cMaxEdgePoints, 'Edge points overflow', true) |
|
187 |
end; |
|
188 |
end; |
|
189 |
end; |
|
190 |
||
4 | 191 |
procedure FillLand(x, y: integer); |
192 |
var Stack: record |
|
193 |
Count: Longword; |
|
194 |
points: array[0..8192] of record |
|
195 |
xl, xr, y, dir: integer; |
|
196 |
end |
|
197 |
end; |
|
198 |
||
199 |
procedure Push(_xl, _xr, _y, _dir: integer); |
|
200 |
begin |
|
201 |
_y:= _y + _dir; |
|
202 |
if (_y < 0) or (_y > 1023) then exit; |
|
203 |
with Stack.points[Stack.Count] do |
|
204 |
begin |
|
205 |
xl:= _xl; |
|
206 |
xr:= _xr; |
|
207 |
y:= _y; |
|
208 |
dir:= _dir |
|
209 |
end; |
|
210 |
inc(Stack.Count); |
|
211 |
TryDo(Stack.Count < 8192, 'stack overflow', true) |
|
212 |
end; |
|
213 |
||
214 |
procedure Pop(out _xl, _xr, _y, _dir: integer); |
|
215 |
begin |
|
216 |
dec(Stack.Count); |
|
217 |
with Stack.points[Stack.Count] do |
|
218 |
begin |
|
219 |
_xl:= xl; |
|
220 |
_xr:= xr; |
|
221 |
_y:= y; |
|
222 |
_dir:= dir |
|
223 |
end |
|
224 |
end; |
|
225 |
||
226 |
var xl, xr, dir: integer; |
|
227 |
begin |
|
228 |
Stack.Count:= 0; |
|
229 |
xl:= x - 1; |
|
230 |
xr:= x; |
|
23 | 231 |
Push(xl, xr, y, -1); |
232 |
Push(xl, xr, y, 1); |
|
4 | 233 |
while Stack.Count > 0 do |
234 |
begin |
|
235 |
Pop(xl, xr, y, dir); |
|
236 |
while (xl > 0) and (Land[y, xl] = 0) do dec(xl); |
|
237 |
while (xr < 2047) and (Land[y, xr] = 0) do inc(xr); |
|
238 |
while (xl < xr) do |
|
239 |
begin |
|
240 |
while (xl <= xr) and (Land[y, xl] <> 0) do inc(xl); |
|
241 |
x:= xl; |
|
242 |
while (xl <= xr) and (Land[y, xl] = 0) do |
|
243 |
begin |
|
244 |
Land[y, xl]:= $FFFFFF; |
|
245 |
inc(xl) |
|
246 |
end; |
|
22 | 247 |
if x < xl then |
248 |
begin |
|
249 |
Push(x, Pred(xl), y, dir); |
|
250 |
Push(x, Pred(xl), y,-dir); |
|
251 |
end; |
|
4 | 252 |
end; |
253 |
end; |
|
254 |
end; |
|
255 |
||
256 |
procedure ColorizeLand(Surface: PSDL_Surface); |
|
257 |
var tmpsurf: PSDL_Surface; |
|
258 |
r: TSDL_Rect; |
|
259 |
begin |
|
260 |
tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'LandTex.png'); |
|
261 |
r.y:= 0; |
|
262 |
while r.y < 1024 do |
|
263 |
begin |
|
264 |
r.x:= 0; |
|
265 |
while r.x < 2048 do |
|
266 |
begin |
|
267 |
SDL_UpperBlit(tmpsurf, nil, Surface, @r); |
|
268 |
inc(r.x, tmpsurf.w) |
|
269 |
end; |
|
270 |
inc(r.y, tmpsurf.h) |
|
271 |
end; |
|
272 |
SDL_FreeSurface(tmpsurf); |
|
273 |
||
274 |
tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0); |
|
275 |
SDLTry(tmpsurf <> nil, true); |
|
276 |
SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF)); |
|
22 | 277 |
SDL_UpperBlit(tmpsurf, nil, Surface, nil); |
278 |
SDL_FreeSurface(tmpsurf) |
|
4 | 279 |
end; |
280 |
||
281 |
procedure AddBorder(Surface: PSDL_Surface); |
|
282 |
var tmpsurf: PSDL_Surface; |
|
283 |
r, rr: TSDL_Rect; |
|
284 |
x, yd, yu: integer; |
|
285 |
begin |
|
286 |
tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'Border.png'); |
|
287 |
for x:= 0 to 2047 do |
|
288 |
begin |
|
289 |
yd:= 1023; |
|
290 |
repeat |
|
291 |
while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd); |
|
292 |
if (yd < 0) then yd:= 0; |
|
293 |
while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd); |
|
294 |
dec(yd); |
|
295 |
yu:= yd; |
|
296 |
while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); |
|
297 |
while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); |
|
298 |
if (yd < 1023) and ((yd - yu) >= 16) then |
|
299 |
begin |
|
300 |
rr.x:= x; |
|
301 |
rr.y:= yd - 15; |
|
302 |
r.x:= x mod tmpsurf.w; |
|
303 |
r.y:= 16; |
|
304 |
r.w:= 1; |
|
305 |
r.h:= 16; |
|
306 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
|
307 |
end; |
|
308 |
if (yu > 0) then |
|
309 |
begin |
|
310 |
rr.x:= x; |
|
311 |
rr.y:= yu; |
|
312 |
r.x:= x mod tmpsurf.w; |
|
313 |
r.y:= 0; |
|
314 |
r.w:= 1; |
|
315 |
r.h:= min(16, yd - yu + 1); |
|
316 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
|
317 |
end; |
|
318 |
yd:= yu - 1; |
|
319 |
until yd < 0; |
|
320 |
end; |
|
321 |
end; |
|
322 |
||
323 |
procedure AddHHPoints; |
|
10 | 324 |
var x, y, t: integer; |
8
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
325 |
|
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
326 |
function CountNonZeroz(x, y: integer): integer; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
327 |
var i: integer; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
328 |
begin |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
329 |
Result:= 0; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
330 |
if (y and $FFFFFC00) <> 0 then exit; |
23 | 331 |
for i:= max(x - 5, 0) to min(x + 5, 2043) do |
8
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
332 |
if Land[y, i] <> 0 then inc(Result) |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
333 |
end; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
334 |
|
4 | 335 |
begin |
10 | 336 |
x:= 40; |
337 |
while x < 2010 do |
|
4 | 338 |
begin |
8
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
339 |
y:= -24; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
340 |
while y < 1023 do |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
341 |
begin |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
342 |
repeat |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
343 |
inc(y, 2); |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
344 |
until (y > 1023) or (CountNonZeroz(x, y) = 0); |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
345 |
t:= 0; |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
346 |
repeat |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
347 |
inc(y, 2); |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
348 |
inc(t, 2) |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
349 |
until (y > 1023) or (CountNonZeroz(x, y) <> 0); |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
350 |
if (t > 22) and (y < 1023) then AddHHPoint(x, y - 12); |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
351 |
inc(y, 100) |
24048039955c
- Hedgehogs spawn points can be generated under the girder
unc0rr
parents:
4
diff
changeset
|
352 |
end; |
22 | 353 |
inc(x, 120) |
4 | 354 |
end; |
22 | 355 |
|
356 |
if HHPoints.Last < cMaxHHs then |
|
357 |
begin |
|
358 |
AddHHPoint(300, 800); |
|
359 |
AddHHPoint(400, 800); |
|
360 |
AddHHPoint(500, 800); |
|
361 |
AddHHPoint(600, 800); |
|
362 |
AddHHPoint(700, 800); |
|
363 |
AddHHPoint(800, 800); |
|
364 |
AddHHPoint(900, 800); |
|
365 |
AddHHPoint(1000, 800); |
|
366 |
AddHHPoint(1100, 800); |
|
367 |
AddHHPoint(1200, 800); |
|
368 |
AddHHPoint(1300, 800); |
|
369 |
AddHHPoint(1400, 800); |
|
370 |
end; |
|
371 |
end; |
|
372 |
||
23 | 373 |
procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr); |
374 |
const MAXPASSES = 16; |
|
24 | 375 |
var ar: array[1..MAXPASSES, 0..5] of real; |
22 | 376 |
i, k: integer; |
377 |
rx, ry, oy: real; |
|
23 | 378 |
PassesNum: Longword; |
22 | 379 |
begin |
23 | 380 |
with Template do |
381 |
begin |
|
382 |
PassesNum:= PassMin + getrandom(PassDelta); |
|
383 |
TryDo(PassesNum < MAXPASSES, 'Passes number too big', true); |
|
384 |
for i:= 1 to PassesNum do // initialize random parameters |
|
385 |
begin |
|
386 |
ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta; |
|
387 |
ar[i, 1]:= WaveFreqMin + getrandom * WaveFreqDelta; |
|
388 |
ar[i, 2]:= getrandom * pi * 2; |
|
389 |
ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta; |
|
390 |
ar[i, 4]:= WaveFreqMin + getrandom * WaveFreqDelta; |
|
391 |
ar[i, 5]:= getrandom * pi * 2; |
|
392 |
end; |
|
393 |
end; |
|
22 | 394 |
|
395 |
for k:= 0 to Pred(pa.Count) do // apply transformation |
|
396 |
begin |
|
397 |
rx:= pa.ar[k].x; |
|
398 |
ry:= pa.ar[k].y; |
|
24 | 399 |
for i:= 1 to PassesNum do |
22 | 400 |
begin |
401 |
oy:= ry; |
|
402 |
ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]); |
|
403 |
rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]); |
|
404 |
end; |
|
24 | 405 |
pa.ar[k].x:= round(rx); |
406 |
pa.ar[k].y:= round(ry); |
|
407 |
end; |
|
4 | 408 |
end; |
409 |
||
23 | 410 |
procedure GenBlank(var Template: TEdgeTemplate); |
4 | 411 |
var pa: TPixAr; |
23 | 412 |
i: Longword; |
4 | 413 |
begin |
23 | 414 |
with Template do |
415 |
begin |
|
416 |
pa.Count:= BasePointsCount; |
|
417 |
for i:= 0 to pred(pa.Count) do |
|
418 |
pa.ar[i]:= BasePoints^[i]; |
|
419 |
||
420 |
for i:= 1 to BezPassCnt do |
|
421 |
BezierizeEdge(pa, 0.33333334); |
|
422 |
||
423 |
PointWave(Template, pa); |
|
424 |
DrawBezierEdge(pa); |
|
425 |
||
426 |
for i:= 0 to pred(FillPointsCount) do |
|
427 |
with FillPoints^[i] do |
|
428 |
FillLand(x, y) |
|
429 |
end; |
|
430 |
end; |
|
431 |
||
432 |
procedure GenLandSurface; |
|
433 |
var tmpsurf: PSDL_Surface; |
|
434 |
begin |
|
435 |
GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]); |
|
22 | 436 |
|
4 | 437 |
AddProgress; |
438 |
with PixelFormat^ do |
|
439 |
tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); |
|
440 |
ColorizeLand(tmpsurf); |
|
441 |
AddProgress; |
|
442 |
AddBorder(tmpsurf); |
|
443 |
with PixelFormat^ do |
|
444 |
LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); |
|
445 |
SDL_FillRect(LandSurface, nil, 0); |
|
24 | 446 |
|
447 |
AddObjects(LandSurface); |
|
448 |
||
4 | 449 |
SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0); |
450 |
SDL_UpperBlit(tmpsurf, nil, LandSurface, nil); |
|
451 |
SDL_FreeSurface(tmpsurf); |
|
452 |
AddProgress; |
|
453 |
AddHHPoints; |
|
454 |
RandomizeHHPoints; |
|
455 |
end; |
|
456 |
||
457 |
procedure MakeFortsMap; |
|
458 |
var p: PTeam; |
|
459 |
tmpsurf: PSDL_Surface; |
|
460 |
begin |
|
461 |
p:= TeamsList; |
|
462 |
TryDo(p <> nil, 'No teams on map!', true); |
|
463 |
with PixelFormat^ do |
|
464 |
LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); |
|
465 |
tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'L.png'); |
|
466 |
BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface); |
|
467 |
SDL_FreeSurface(tmpsurf); |
|
468 |
LoadFortPoints(p.FortName, false, TeamSize(p)); |
|
469 |
p:= p.Next; |
|
470 |
TryDo(p <> nil, 'Only one team on map!', true); |
|
471 |
tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'R.png'); |
|
472 |
BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface); |
|
473 |
SDL_FreeSurface(tmpsurf); |
|
474 |
LoadFortPoints(p.FortName, true, TeamSize(p)); |
|
475 |
p:= p.Next; |
|
476 |
TryDo(p = nil, 'More than 2 teams on map in forts mode!', true); |
|
477 |
end; |
|
478 |
||
479 |
procedure AddHHPoint(_x, _y: integer); |
|
480 |
begin |
|
481 |
with HHPoints do |
|
482 |
begin |
|
483 |
inc(Last); |
|
22 | 484 |
TryDo(Last < cMaxSpawnPoints, 'HHs coords queue overflow', true); |
4 | 485 |
with ar[Last] do |
486 |
begin |
|
487 |
x:= _x; |
|
488 |
y:= _y |
|
489 |
end |
|
490 |
end |
|
491 |
end; |
|
492 |
||
493 |
procedure GetHHPoint(out _x, _y: integer); |
|
494 |
begin |
|
495 |
with HHPoints do |
|
496 |
begin |
|
497 |
TryDo(First <= Last, 'HHs coords queue underflow ' + inttostr(First), true); |
|
498 |
with ar[First] do |
|
499 |
begin |
|
500 |
_x:= x; |
|
501 |
_y:= y |
|
502 |
end; |
|
503 |
inc(First) |
|
504 |
end |
|
505 |
end; |
|
506 |
||
507 |
procedure RandomizeHHPoints; |
|
508 |
var i, t: integer; |
|
509 |
p: TPoint; |
|
510 |
begin |
|
511 |
with HHPoints do |
|
512 |
begin |
|
513 |
for i:= First to Last do |
|
514 |
begin |
|
515 |
t:= GetRandom(Last - First + 1) + First; |
|
516 |
if i <> t then |
|
517 |
begin |
|
518 |
p:= ar[i]; |
|
519 |
ar[i]:= ar[t]; |
|
520 |
ar[t]:= p |
|
521 |
end |
|
522 |
end |
|
523 |
end |
|
524 |
end; |
|
525 |
||
526 |
end. |