author | displacer |
Sat, 13 Jan 2007 15:13:23 +0000 | |
changeset 322 | e7175ae57945 |
parent 316 | 57d50189ad86 |
child 351 | 29bc9c36ad5f |
permissions | -rw-r--r-- |
4 | 1 |
(* |
2 |
* Hedgewars, a worms-like game |
|
70 | 3 |
* Copyright (c) 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com> |
4 | 4 |
* |
183 | 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 |
|
4 | 8 |
* |
183 | 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. |
|
4 | 13 |
* |
183 | 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., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA |
|
4 | 17 |
*) |
18 |
||
19 |
unit uLand; |
|
20 |
interface |
|
196 | 21 |
uses SDLh, uLandTemplates; |
4 | 22 |
{$include options.inc} |
23 |
type TLandArray = packed array[0..1023, 0..2047] of LongWord; |
|
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
24 |
TPreview = packed array[0..127, 0..31] of byte; |
4 | 25 |
|
26 |
var Land: TLandArray; |
|
27 |
LandSurface: PSDL_Surface; |
|
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
28 |
Preview: TPreview; |
4 | 29 |
|
37 | 30 |
procedure GenMap; |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
31 |
procedure GenPreview; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
32 |
|
4 | 33 |
|
34 |
implementation |
|
316 | 35 |
uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uLandObjects, uSHA, uIO; |
4 | 36 |
|
37 |
type TPixAr = record |
|
38 |
Count: Longword; |
|
22 | 39 |
ar: array[0..Pred(cMaxEdgePoints)] of TPoint; |
4 | 40 |
end; |
41 |
||
37 | 42 |
procedure LogLandDigest; |
316 | 43 |
var ctx: TSHA1Context; |
44 |
dig: TSHA1Digest; |
|
45 |
s: shortstring; |
|
37 | 46 |
begin |
316 | 47 |
SHA1Init(ctx); |
48 |
SHA1Update(ctx, @Land, sizeof(Land)); |
|
49 |
dig:= SHA1Final(ctx); |
|
50 |
s:= '{'+inttostr(dig[0])+':' |
|
51 |
+inttostr(dig[1])+':' |
|
52 |
+inttostr(dig[2])+':' |
|
53 |
+inttostr(dig[3])+':' |
|
54 |
+inttostr(dig[4])+'}'; |
|
55 |
SendIPC('M' + s) |
|
37 | 56 |
end; |
57 |
||
89 | 58 |
procedure DrawBezierEdge(var pa: TPixAr; Color: Longword); |
4 | 59 |
var x, y, i: integer; |
107 | 60 |
tx, ty, vx, vy, vlen, t: Double; |
61 |
r1, r2, r3, r4: Double; |
|
62 |
x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double; |
|
4 | 63 |
begin |
64 |
vx:= 0; |
|
65 |
vy:= 0; |
|
66 |
with pa do |
|
67 |
for i:= 0 to Count-2 do |
|
68 |
begin |
|
69 |
vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); |
|
70 |
t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); |
|
71 |
if t<vlen then vlen:= t; |
|
72 |
vlen:= vlen/3; |
|
73 |
tx:= ar[i+2].X - ar[i].X; |
|
74 |
ty:= ar[i+2].y - ar[i].y; |
|
75 |
t:= sqrt(sqr(tx)+sqr(ty)); |
|
76 |
if t = 0 then |
|
77 |
begin |
|
78 |
tx:= -tx * 100000; |
|
79 |
ty:= -ty * 100000; |
|
80 |
end else |
|
81 |
begin |
|
82 |
tx:= -tx/t; |
|
83 |
ty:= -ty/t; |
|
84 |
end; |
|
85 |
t:= 1.0*vlen; |
|
86 |
tx:= tx*t; |
|
87 |
ty:= ty*t; |
|
88 |
x1:= ar[i].x; |
|
89 |
y1:= ar[i].y; |
|
90 |
x2:= ar[i + 1].x; |
|
91 |
y2:= ar[i + 1].y; |
|
92 |
cx1:= ar[i].X + trunc(vx); |
|
93 |
cy1:= ar[i].y + trunc(vy); |
|
94 |
cx2:= ar[i+1].X + trunc(tx); |
|
95 |
cy2:= ar[i+1].y + trunc(ty); |
|
96 |
vx:= -tx; |
|
97 |
vy:= -ty; |
|
98 |
t:= 0; |
|
99 |
while t <= 1.0 do |
|
100 |
begin |
|
101 |
tsq:= sqr(t); |
|
102 |
tcb:= tsq * t; |
|
103 |
r1:= (1 - 3*t + 3*tsq - tcb) * x1; |
|
104 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cx1; |
|
105 |
r3:= ( 3*tsq - 3*tcb) * cx2; |
|
106 |
r4:= ( tcb) * x2; |
|
107 |
X:= round(r1 + r2 + r3 + r4); |
|
108 |
r1:= (1 - 3*t + 3*tsq - tcb) * y1; |
|
109 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cy1; |
|
110 |
r3:= ( 3*tsq - 3*tcb) * cy2; |
|
111 |
r4:= ( tcb) * y2; |
|
112 |
Y:= round(r1 + r2 + r3 + r4); |
|
113 |
t:= t + 0.001; |
|
114 |
if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then |
|
89 | 115 |
Land[y, x]:= Color; |
4 | 116 |
end; |
117 |
end; |
|
118 |
end; |
|
119 |
||
107 | 120 |
procedure BezierizeEdge(var pa: TPixAr; Delta: Double); |
22 | 121 |
var x, y, i: integer; |
107 | 122 |
tx, ty, vx, vy, vlen, t: Double; |
123 |
r1, r2, r3, r4: Double; |
|
124 |
x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: Double; |
|
22 | 125 |
opa: TPixAr; |
126 |
begin |
|
127 |
opa:= pa; |
|
128 |
pa.Count:= 0; |
|
129 |
vx:= 0; |
|
130 |
vy:= 0; |
|
131 |
with opa do |
|
132 |
for i:= 0 to Count-2 do |
|
133 |
begin |
|
134 |
vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); |
|
135 |
t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); |
|
136 |
if t<vlen then vlen:= t; |
|
137 |
vlen:= vlen/3; |
|
138 |
tx:= ar[i+2].X - ar[i].X; |
|
139 |
ty:= ar[i+2].y - ar[i].y; |
|
140 |
t:= sqrt(sqr(tx)+sqr(ty)); |
|
141 |
if t = 0 then |
|
142 |
begin |
|
143 |
tx:= -tx * 100000; |
|
144 |
ty:= -ty * 100000; |
|
145 |
end else |
|
146 |
begin |
|
147 |
tx:= -tx/t; |
|
148 |
ty:= -ty/t; |
|
149 |
end; |
|
150 |
t:= 1.0*vlen; |
|
151 |
tx:= tx*t; |
|
152 |
ty:= ty*t; |
|
153 |
x1:= ar[i].x; |
|
154 |
y1:= ar[i].y; |
|
155 |
x2:= ar[i + 1].x; |
|
156 |
y2:= ar[i + 1].y; |
|
157 |
cx1:= ar[i].X + trunc(vx); |
|
158 |
cy1:= ar[i].y + trunc(vy); |
|
159 |
cx2:= ar[i+1].X + trunc(tx); |
|
160 |
cy2:= ar[i+1].y + trunc(ty); |
|
161 |
vx:= -tx; |
|
162 |
vy:= -ty; |
|
163 |
t:= 0; |
|
164 |
while t <= 1.0 do |
|
165 |
begin |
|
166 |
tsq:= sqr(t); |
|
167 |
tcb:= tsq * t; |
|
168 |
r1:= (1 - 3*t + 3*tsq - tcb) * x1; |
|
169 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cx1; |
|
170 |
r3:= ( 3*tsq - 3*tcb) * cx2; |
|
171 |
r4:= ( tcb) * x2; |
|
172 |
X:= round(r1 + r2 + r3 + r4); |
|
173 |
r1:= (1 - 3*t + 3*tsq - tcb) * y1; |
|
174 |
r2:= ( 3*t - 6*tsq + 3*tcb) * cy1; |
|
175 |
r3:= ( 3*tsq - 3*tcb) * cy2; |
|
176 |
r4:= ( tcb) * y2; |
|
177 |
Y:= round(r1 + r2 + r3 + r4); |
|
178 |
t:= t + Delta; |
|
179 |
pa.ar[pa.Count].x:= X; |
|
180 |
pa.ar[pa.Count].y:= Y; |
|
181 |
inc(pa.Count); |
|
160 | 182 |
TryDo(pa.Count <= cMaxEdgePoints, 'Edge points overflow', true) |
22 | 183 |
end; |
184 |
end; |
|
185 |
end; |
|
186 |
||
4 | 187 |
procedure FillLand(x, y: integer); |
188 |
var Stack: record |
|
189 |
Count: Longword; |
|
190 |
points: array[0..8192] of record |
|
191 |
xl, xr, y, dir: integer; |
|
192 |
end |
|
193 |
end; |
|
194 |
||
195 |
procedure Push(_xl, _xr, _y, _dir: integer); |
|
196 |
begin |
|
75 | 197 |
TryDo(Stack.Count <= 8192, 'FillLand: stack overflow', true); |
4 | 198 |
_y:= _y + _dir; |
199 |
if (_y < 0) or (_y > 1023) then exit; |
|
200 |
with Stack.points[Stack.Count] do |
|
201 |
begin |
|
202 |
xl:= _xl; |
|
203 |
xr:= _xr; |
|
204 |
y:= _y; |
|
205 |
dir:= _dir |
|
206 |
end; |
|
75 | 207 |
inc(Stack.Count) |
4 | 208 |
end; |
209 |
||
210 |
procedure Pop(out _xl, _xr, _y, _dir: integer); |
|
211 |
begin |
|
212 |
dec(Stack.Count); |
|
213 |
with Stack.points[Stack.Count] do |
|
214 |
begin |
|
215 |
_xl:= xl; |
|
216 |
_xr:= xr; |
|
217 |
_y:= y; |
|
218 |
_dir:= dir |
|
219 |
end |
|
220 |
end; |
|
221 |
||
222 |
var xl, xr, dir: integer; |
|
109 | 223 |
begin |
4 | 224 |
Stack.Count:= 0; |
225 |
xl:= x - 1; |
|
226 |
xr:= x; |
|
23 | 227 |
Push(xl, xr, y, -1); |
228 |
Push(xl, xr, y, 1); |
|
4 | 229 |
while Stack.Count > 0 do |
230 |
begin |
|
231 |
Pop(xl, xr, y, dir); |
|
51 | 232 |
while (xl > 0) and (Land[y, xl] <> 0) do dec(xl); |
233 |
while (xr < 2047) and (Land[y, xr] <> 0) do inc(xr); |
|
4 | 234 |
while (xl < xr) do |
235 |
begin |
|
51 | 236 |
while (xl <= xr) and (Land[y, xl] = 0) do inc(xl); |
4 | 237 |
x:= xl; |
51 | 238 |
while (xl <= xr) and (Land[y, xl] <> 0) do |
4 | 239 |
begin |
51 | 240 |
Land[y, xl]:= 0; |
4 | 241 |
inc(xl) |
242 |
end; |
|
22 | 243 |
if x < xl then |
244 |
begin |
|
245 |
Push(x, Pred(xl), y, dir); |
|
246 |
Push(x, Pred(xl), y,-dir); |
|
247 |
end; |
|
4 | 248 |
end; |
249 |
end; |
|
250 |
end; |
|
251 |
||
252 |
procedure ColorizeLand(Surface: PSDL_Surface); |
|
253 |
var tmpsurf: PSDL_Surface; |
|
254 |
r: TSDL_Rect; |
|
255 |
begin |
|
80 | 256 |
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/LandTex', false); |
4 | 257 |
r.y:= 0; |
258 |
while r.y < 1024 do |
|
259 |
begin |
|
260 |
r.x:= 0; |
|
261 |
while r.x < 2048 do |
|
262 |
begin |
|
263 |
SDL_UpperBlit(tmpsurf, nil, Surface, @r); |
|
264 |
inc(r.x, tmpsurf.w) |
|
265 |
end; |
|
266 |
inc(r.y, tmpsurf.h) |
|
267 |
end; |
|
268 |
SDL_FreeSurface(tmpsurf); |
|
269 |
||
270 |
tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0); |
|
271 |
SDLTry(tmpsurf <> nil, true); |
|
272 |
SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF)); |
|
22 | 273 |
SDL_UpperBlit(tmpsurf, nil, Surface, nil); |
274 |
SDL_FreeSurface(tmpsurf) |
|
4 | 275 |
end; |
276 |
||
277 |
procedure AddBorder(Surface: PSDL_Surface); |
|
278 |
var tmpsurf: PSDL_Surface; |
|
279 |
r, rr: TSDL_Rect; |
|
280 |
x, yd, yu: integer; |
|
281 |
begin |
|
80 | 282 |
tmpsurf:= LoadImage(Pathz[ptCurrTheme] + '/Border', false); |
4 | 283 |
for x:= 0 to 2047 do |
284 |
begin |
|
285 |
yd:= 1023; |
|
286 |
repeat |
|
287 |
while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd); |
|
288 |
if (yd < 0) then yd:= 0; |
|
289 |
while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd); |
|
290 |
dec(yd); |
|
291 |
yu:= yd; |
|
292 |
while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); |
|
293 |
while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); |
|
294 |
if (yd < 1023) and ((yd - yu) >= 16) then |
|
295 |
begin |
|
296 |
rr.x:= x; |
|
297 |
rr.y:= yd - 15; |
|
298 |
r.x:= x mod tmpsurf.w; |
|
299 |
r.y:= 16; |
|
300 |
r.w:= 1; |
|
301 |
r.h:= 16; |
|
302 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
|
303 |
end; |
|
304 |
if (yu > 0) then |
|
305 |
begin |
|
306 |
rr.x:= x; |
|
307 |
rr.y:= yu; |
|
308 |
r.x:= x mod tmpsurf.w; |
|
309 |
r.y:= 0; |
|
310 |
r.w:= 1; |
|
311 |
r.h:= min(16, yd - yu + 1); |
|
312 |
SDL_UpperBlit(tmpsurf, @r, Surface, @rr); |
|
313 |
end; |
|
314 |
yd:= yu - 1; |
|
315 |
until yd < 0; |
|
316 |
end; |
|
317 |
end; |
|
318 |
||
173 | 319 |
function rndSign(num: Double): Double; |
320 |
begin |
|
321 |
if getrandom(2) = 0 then Result:= num |
|
322 |
else Result:= - num |
|
323 |
end; |
|
324 |
||
325 |
||
23 | 326 |
procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr); |
27 | 327 |
const MAXPASSES = 32; |
173 | 328 |
var ar: array[0..MAXPASSES, 0..9] of Double; |
22 | 329 |
i, k: integer; |
173 | 330 |
rx, ry, ox, oy: Double; |
23 | 331 |
PassesNum: Longword; |
22 | 332 |
begin |
23 | 333 |
with Template do |
334 |
begin |
|
335 |
PassesNum:= PassMin + getrandom(PassDelta); |
|
336 |
TryDo(PassesNum < MAXPASSES, 'Passes number too big', true); |
|
27 | 337 |
ar[0, 1]:= WaveFreqMin; |
338 |
ar[0, 4]:= WaveFreqMin; |
|
23 | 339 |
for i:= 1 to PassesNum do // initialize random parameters |
340 |
begin |
|
341 |
ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta; |
|
27 | 342 |
ar[i, 1]:= ar[i - 1, 1] + (getrandom * 0.7 + 0.3) * WaveFreqDelta; |
23 | 343 |
ar[i, 2]:= getrandom * pi * 2; |
344 |
ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta; |
|
27 | 345 |
ar[i, 4]:= ar[i - 1, 4] + (getrandom * 0.7 + 0.3) * WaveFreqDelta; |
23 | 346 |
ar[i, 5]:= getrandom * pi * 2; |
173 | 347 |
ar[i, 6]:= ar[i, 1] * (getrandom * 2 - 1); |
348 |
ar[i, 7]:= ar[i, 1] * rndSign(sqrt(1 - sqr(ar[i, 6]))); |
|
349 |
ar[i, 8]:= ar[i, 4] * (getrandom * 2 - 1); |
|
350 |
ar[i, 9]:= ar[i, 4] * rndSign(sqrt(1 - sqr(ar[i, 8]))); |
|
23 | 351 |
end; |
352 |
end; |
|
22 | 353 |
|
354 |
for k:= 0 to Pred(pa.Count) do // apply transformation |
|
355 |
begin |
|
356 |
rx:= pa.ar[k].x; |
|
357 |
ry:= pa.ar[k].y; |
|
24 | 358 |
for i:= 1 to PassesNum do |
22 | 359 |
begin |
173 | 360 |
ox:= rx; |
22 | 361 |
oy:= ry; |
173 | 362 |
ry:= ry + ar[i, 0] * sin(ox * ar[i, 6] + oy * ar[i, 7] + ar[i, 2]); |
363 |
rx:= rx + ar[i, 3] * sin(ox * ar[i, 8] + oy * ar[i, 9] + ar[i, 5]); |
|
22 | 364 |
end; |
24 | 365 |
pa.ar[k].x:= round(rx); |
366 |
pa.ar[k].y:= round(ry); |
|
367 |
end; |
|
4 | 368 |
end; |
369 |
||
67 | 370 |
procedure NormalizePoints(var pa: TPixAr); |
371 |
const brd = 32; |
|
372 |
var isUP: boolean; // HACK: transform for Y should be exact as one for X |
|
373 |
Left, Right, Top, Bottom, |
|
374 |
OWidth, Width, OHeight, Height, |
|
375 |
OLeft: integer; |
|
376 |
i: integer; |
|
377 |
begin |
|
378 |
TryDo((pa.ar[0].y < 0) or (pa.ar[0].y > 1023), 'Bad land generated', true); |
|
160 | 379 |
TryDo((pa.ar[Pred(pa.Count)].y < 0) or (pa.ar[Pred(pa.Count)].y > 1023), 'Bad land generated', true); |
67 | 380 |
isUP:= pa.ar[0].y > 0; |
381 |
Left:= 1023; |
|
382 |
Right:= Left; |
|
383 |
Top:= pa.ar[0].y; |
|
384 |
Bottom:= Top; |
|
385 |
||
386 |
for i:= 1 to Pred(pa.Count) do |
|
387 |
with pa.ar[i] do |
|
388 |
begin |
|
389 |
if (y and $FFFFFC00) = 0 then |
|
390 |
if x < Left then Left:= x else |
|
391 |
if x > Right then Right:= x; |
|
392 |
if y < Top then Top:= y else |
|
393 |
if y > Bottom then Bottom:= y |
|
394 |
end; |
|
395 |
||
396 |
if (Left < brd) or (Right > 2047 - brd) then |
|
397 |
begin |
|
398 |
OLeft:= Left; |
|
399 |
OWidth:= Right - OLeft; |
|
400 |
if Left < brd then Left:= brd; |
|
401 |
if Right > 2047 - brd then Right:= 2047 - brd; |
|
402 |
Width:= Right - Left; |
|
403 |
for i:= 0 to Pred(pa.Count) do |
|
404 |
with pa.ar[i] do |
|
405 |
x:= round((x - OLeft) * Width div OWidth + Left) |
|
406 |
end; |
|
407 |
||
408 |
if isUp then // FIXME: remove hack |
|
409 |
if Top < brd then |
|
410 |
begin |
|
411 |
OHeight:= 1023 - Top; |
|
412 |
Height:= 1023 - brd; |
|
413 |
for i:= 0 to Pred(pa.Count) do |
|
414 |
with pa.ar[i] do |
|
415 |
y:= round((y - 1023) * Height div OHeight + 1023) |
|
416 |
end; |
|
417 |
end; |
|
418 |
||
23 | 419 |
procedure GenBlank(var Template: TEdgeTemplate); |
4 | 420 |
var pa: TPixAr; |
23 | 421 |
i: Longword; |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
422 |
y, x: Longword; |
4 | 423 |
begin |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
424 |
for y:= 0 to 1023 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
425 |
for x:= 0 to 2047 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
426 |
Land[y, x]:= COLOR_LAND; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
427 |
|
23 | 428 |
with Template do |
429 |
begin |
|
27 | 430 |
if canMirror then |
431 |
if getrandom(16) < 8 then |
|
432 |
begin |
|
433 |
for i:= 0 to pred(BasePointsCount) do |
|
434 |
BasePoints^[i].x:= 2047 - BasePoints^[i].x; |
|
435 |
for i:= 0 to pred(FillPointsCount) do |
|
436 |
FillPoints^[i].x:= 2047 - FillPoints^[i].x; |
|
437 |
end; |
|
438 |
||
439 |
if canFlip then |
|
440 |
if getrandom(16) < 8 then |
|
441 |
begin |
|
442 |
for i:= 0 to pred(BasePointsCount) do |
|
443 |
BasePoints^[i].y:= 1023 - BasePoints^[i].y; |
|
444 |
for i:= 0 to pred(FillPointsCount) do |
|
445 |
FillPoints^[i].y:= 1023 - FillPoints^[i].y; |
|
446 |
end; |
|
447 |
||
23 | 448 |
pa.Count:= BasePointsCount; |
449 |
for i:= 0 to pred(pa.Count) do |
|
450 |
pa.ar[i]:= BasePoints^[i]; |
|
451 |
||
452 |
for i:= 1 to BezPassCnt do |
|
453 |
BezierizeEdge(pa, 0.33333334); |
|
454 |
||
455 |
PointWave(Template, pa); |
|
67 | 456 |
NormalizePoints(pa); |
89 | 457 |
DrawBezierEdge(pa, 0); |
23 | 458 |
|
459 |
for i:= 0 to pred(FillPointsCount) do |
|
460 |
with FillPoints^[i] do |
|
89 | 461 |
FillLand(x, y); |
462 |
||
463 |
DrawBezierEdge(pa, COLOR_LAND); |
|
23 | 464 |
end; |
465 |
end; |
|
466 |
||
161 | 467 |
function SelectTemplate: integer; |
468 |
begin |
|
469 |
Result:= getrandom(Succ(High(EdgeTemplates))) |
|
470 |
end; |
|
471 |
||
23 | 472 |
procedure GenLandSurface; |
473 |
var tmpsurf: PSDL_Surface; |
|
474 |
begin |
|
53 | 475 |
WriteLnToConsole('Generating land...'); |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
476 |
|
161 | 477 |
GenBlank(EdgeTemplates[SelectTemplate]); |
22 | 478 |
|
4 | 479 |
AddProgress; |
480 |
with PixelFormat^ do |
|
191
a03c2d037e24
Bots are in the same thread as game. Fixes FreePascal issues.
unc0rr
parents:
183
diff
changeset
|
481 |
tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, AMask); |
67 | 482 |
TryDo(tmpsurf <> nil, 'Error creating pre-land surface', true); |
4 | 483 |
ColorizeLand(tmpsurf); |
484 |
AddProgress; |
|
485 |
AddBorder(tmpsurf); |
|
486 |
with PixelFormat^ do |
|
191
a03c2d037e24
Bots are in the same thread as game. Fixes FreePascal issues.
unc0rr
parents:
183
diff
changeset
|
487 |
LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, AMask); |
67 | 488 |
TryDo(LandSurface <> nil, 'Error creating land surface', true); |
4 | 489 |
SDL_FillRect(LandSurface, nil, 0); |
27 | 490 |
AddProgress; |
24 | 491 |
|
70 | 492 |
SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0); |
493 |
AddObjects(tmpsurf, LandSurface); |
|
494 |
SDL_FreeSurface(tmpsurf); |
|
24 | 495 |
|
70 | 496 |
AddProgress |
4 | 497 |
end; |
498 |
||
499 |
procedure MakeFortsMap; |
|
500 |
var p: PTeam; |
|
501 |
tmpsurf: PSDL_Surface; |
|
502 |
begin |
|
53 | 503 |
WriteLnToConsole('Generating forts land...'); |
4 | 504 |
p:= TeamsList; |
505 |
TryDo(p <> nil, 'No teams on map!', true); |
|
506 |
with PixelFormat^ do |
|
191
a03c2d037e24
Bots are in the same thread as game. Fixes FreePascal issues.
unc0rr
parents:
183
diff
changeset
|
507 |
LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, AMask); |
37 | 508 |
SDL_FillRect(LandSurface, nil, 0); |
74 | 509 |
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'L', false); |
4 | 510 |
BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface); |
511 |
SDL_FreeSurface(tmpsurf); |
|
512 |
p:= p.Next; |
|
513 |
TryDo(p <> nil, 'Only one team on map!', true); |
|
74 | 514 |
tmpsurf:= LoadImage(Pathz[ptForts] + '/' + p.FortName + 'R', false); |
4 | 515 |
BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface); |
516 |
SDL_FreeSurface(tmpsurf); |
|
517 |
p:= p.Next; |
|
518 |
TryDo(p = nil, 'More than 2 teams on map in forts mode!', true); |
|
519 |
end; |
|
520 |
||
53 | 521 |
procedure LoadMap; |
107 | 522 |
var x, y: Longword; |
523 |
p: PByteArray; |
|
53 | 524 |
begin |
525 |
WriteLnToConsole('Loading land from file...'); |
|
526 |
AddProgress; |
|
74 | 527 |
LandSurface:= LoadImage(Pathz[ptMapCurrent] + '/map', false); |
53 | 528 |
TryDo((LandSurface.w = 2048) and (LandSurface.h = 1024), 'Map dimensions should be 2048x1024!', true); |
529 |
||
530 |
if SDL_MustLock(LandSurface) then |
|
531 |
SDLTry(SDL_LockSurface(LandSurface) >= 0, true); |
|
532 |
||
107 | 533 |
p:= LandSurface.pixels; |
53 | 534 |
case LandSurface.format.BytesPerPixel of |
535 |
1: OutError('We don''t work with 8 bit surfaces', true); |
|
536 |
2: for y:= 0 to 1023 do |
|
537 |
begin |
|
538 |
for x:= 0 to 2047 do |
|
107 | 539 |
if PWord(@p[x * 2])^ <> 0 then Land[y, x]:= COLOR_LAND; |
540 |
p:= @p[LandSurface.pitch]; |
|
53 | 541 |
end; |
542 |
3: for y:= 0 to 1023 do |
|
543 |
begin |
|
544 |
for x:= 0 to 2047 do |
|
107 | 545 |
if (p[x * 3 + 0] <> 0) |
546 |
or (p[x * 3 + 1] <> 0) |
|
547 |
or (p[x * 3 + 2] <> 0) then Land[y, x]:= COLOR_LAND; |
|
548 |
p:= @p[LandSurface.pitch]; |
|
53 | 549 |
end; |
550 |
4: for y:= 0 to 1023 do |
|
551 |
begin |
|
552 |
for x:= 0 to 2047 do |
|
107 | 553 |
if PLongword(@p[x * 4])^ <> 0 then Land[y, x]:= COLOR_LAND; |
554 |
p:= @p[LandSurface.pitch]; |
|
53 | 555 |
end; |
556 |
end; |
|
557 |
if SDL_MustLock(LandSurface) then |
|
558 |
SDL_UnlockSurface(LandSurface); |
|
559 |
end; |
|
560 |
||
37 | 561 |
procedure GenMap; |
562 |
begin |
|
53 | 563 |
if (GameFlags and gfForts) = 0 then |
564 |
if Pathz[ptMapCurrent] <> '' then LoadMap |
|
565 |
else GenLandSurface |
|
37 | 566 |
else MakeFortsMap; |
567 |
AddProgress; |
|
568 |
{$IFDEF DEBUGFILE}LogLandDigest{$ENDIF} |
|
569 |
end; |
|
570 |
||
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
571 |
procedure GenPreview; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
572 |
var x, y, xx, yy, t, bit: integer; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
573 |
begin |
160 | 574 |
WriteLnToConsole('Generating preview...'); |
161 | 575 |
GenBlank(EdgeTemplates[SelectTemplate]); |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
576 |
|
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
577 |
for y:= 0 to 127 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
578 |
for x:= 0 to 31 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
579 |
begin |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
580 |
Preview[y, x]:= 0; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
581 |
for bit:= 0 to 7 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
582 |
begin |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
583 |
t:= 0; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
584 |
for yy:= y * 8 to y * 8 + 7 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
585 |
for xx:= x * 64 + bit * 8 to x * 64 + bit * 8 + 7 do |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
586 |
if Land[yy, xx] <> 0 then inc(t); |
160 | 587 |
if t > 8 then Preview[y, x]:= Preview[y, x] or ($80 shr bit) |
155
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
588 |
end |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
589 |
end |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
590 |
end; |
401f4ea24715
Engine can generate land preview and send it via IPC
unc0rr
parents:
109
diff
changeset
|
591 |
|
51 | 592 |
initialization |
593 |
||
4 | 594 |
end. |