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 uLandObjects;
22 interface
23 uses SDLh;
24
25 procedure AddObjects();
26 procedure FreeLandObjects();
27 procedure LoadThemeConfig;
28 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
29 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); inline;
30 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
31 procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
32 procedure BlitImageUsingMask(cpX, cpY: Longword; Image, Mask: PSDL_Surface);
33 procedure AddOnLandObjects(Surface: PSDL_Surface);
34 procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
35
36 implementation
37 uses uStore, uConsts, uConsole, uRandom, uSound
38 , uTypes, uVariables, uDebug, uUtils
39 , uPhysFSLayer, uRenderUtils;
40
41 const MaxRects = 512;
42 MAXOBJECTRECTS = 16;
43 MAXTHEMEOBJECTS = 32;
44 cThemeCFGFilename = 'theme.cfg';
45
46 type PLongWord = ^LongWord;
47 TRectsArray = array[0..MaxRects] of TSDL_Rect;
48 PRectArray = ^TRectsArray;
49 TThemeObjectOverlay = record
50 Position: TPoint;
51 Surf: PSDL_Surface;
52 Width, Height: LongWord;
53 end;
54 TThemeObject = record
55 Name: ShortString;
56 Surf, Mask: PSDL_Surface;
57 inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
58 outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
59 anchors: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
60 overlays: array[0..Pred(MAXOBJECTRECTS)] of TThemeObjectOverlay;
61 inrectcnt: LongInt;
62 outrectcnt: LongInt;
63 anchorcnt: LongInt;
64 overlaycnt: LongInt;
65 Width, Height: Longword;
66 Maxcnt: Longword;
67 end;
68 TThemeObjects = record
69 Count: LongInt;
70 objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject;
71 end;
72 TSprayObject = record
73 Surf: PSDL_Surface;
74 Width, Height: Longword;
75 Maxcnt: Longword;
76 end;
77 TSprayObjects = record
78 Count: LongInt;
79 objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject
80 end;
81
82 var Rects: PRectArray;
83 RectCount: Longword;
84 ThemeObjects: TThemeObjects;
85 SprayObjects: TSprayObjects;
86
87 procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
88 begin
89 // this an if instead of masking colours to avoid confusing map creators
90 if ((AMask and Pixel) = 0) then
91 LandWord:= 0
92 else if (Pixel and AMask > 0) and (Pixel and RMask > 0) and (Pixel and GMask > 0) and (Pixel and BMask > 0) then // whiteish
93 LandWord:= lfObject
94 else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask = 0) and (Pixel and BMask = 0) then // blackish
95 begin
96 LandWord:= lfBasic;
97 disableLandBack:= false
98 end
99 else if (Pixel and AMask > 0) and (Pixel and RMask > 0) and (Pixel and GMask = 0) and (Pixel and BMask = 0) then // reddish
100 LandWord:= lfIndestructible
101 else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask = 0) and (Pixel and BMask > 0) then // blueish
102 LandWord:= lfObject or lfIce
103 else if (Pixel and AMask > 0) and (Pixel and RMask = 0) and (Pixel and GMask > 0) and (Pixel and BMask = 0) then // greenish
104 LandWord:= lfObject or lfBouncy
105 end;
106
107 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
108 begin
109 BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0, false);
110 end;
111
112 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); inline;
113 begin
114 BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, LandFlags, false);
115 end;
116
LerpBytenull117 function LerpByte(src, dst: Byte; l: LongWord): LongWord; inline;
118 begin
119 LerpByte:= ((255 - l) * src + l * dst) div 255;
120 end;
121
122 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
123 var p: PLongwordArray;
124 pLandColor: PLongWord;
125 alpha, color, landColor, x, y: LongWord;
126 bpp: LongInt;
127 begin
128 WriteToConsole('Generating collision info... ');
129
130 if SDL_MustLock(Image) then
131 if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
132
133 bpp:= Image^.format^.BytesPerPixel;
134 if checkFails(bpp = 4, 'Land object should be 32bit', true) then
135 begin
136 if SDL_MustLock(Image) then
137 SDL_UnlockSurface(Image);
138 end;
139
140 if Width = 0 then
141 Width:= Image^.w;
142
143 p:= Image^.pixels;
144
145 for y:= 0 to Pred(Image^.h) do
146 begin
147 for x:= 0 to Pred(Width) do
148 begin
149 // map image pixels per line backwards if in flip mode
150 if Flip then
151 color:= p^[Pred(Image^.w) - x]
152 else
153 color:= p^[x];
154
155 if (cReducedQuality and rqBlurryLand) = 0 then
156 pLandColor:= @LandPixels[cpY + y, cpX + x]
157 else
158 pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
159
160 landColor:= pLandColor^;
161 alpha:= (landColor and AMask) shr AShift;
162
163 if ((color and AMask) <> 0) and (alpha <> 255) then
164 begin
165 if alpha = 0 then
166 pLandColor^:= color
167 else
168 pLandColor^:=
169 (LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)
170 or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)
171 or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)
172 or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);
173
174 end;
175
176 if ((color and AMask) <> 0) and (Land[cpY + y, cpX + x] <= lfAllObjMask) then
177 Land[cpY + y, cpX + x]:= lfObject or LandFlags
178 end;
179 p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
180 end;
181
182 if SDL_MustLock(Image) then
183 SDL_UnlockSurface(Image);
184 WriteLnToConsole(msgOK)
185 end;
186
187 procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
188 var p: PLongwordArray;
189 pLandColor: PLongWord;
190 x, y, alpha, color, landColor: LongWord;
191 begin
192 WriteToConsole('Generating overlay collision info... ');
193
194 if SDL_MustLock(Image) then
195 if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
196
197 if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object overlay should be 32bit', true)
198 and SDL_MustLock(Image) then
199 SDL_UnlockSurface(Image);
200
201 p:= Image^.pixels;
202
203 for y:= 0 to Pred(Image^.h) do
204 begin
205 for x:= 0 to Pred(Image^.w) do
206 begin
207 color:= p^[x];
208 if (color and AMask) <> 0 then
209 begin
210 if (cReducedQuality and rqBlurryLand) = 0 then
211 pLandColor:= @LandPixels[cpY + y, cpX + x]
212 else
213 pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
214
215 alpha:= (color and AMask) shr AShift;
216 if ((alpha <> $FF) and ((pLandColor^) <> 0)) then
217 begin
218 landColor:= pLandColor^;
219 color:=
220 (LerpByte((landColor and RMask) shr RShift, (color and RMask) shr RShift, alpha) shl RShift)
221 or (LerpByte((landColor and GMask) shr GShift, (color and GMask) shr GShift, alpha) shl GShift)
222 or (LerpByte((landColor and BMask) shr BShift, (color and BMask) shr BShift, alpha) shl BShift)
223 or (LerpByte(alpha, 255, (landColor and AMask) shr AShift) shl AShift)
224 end;
225 pLandColor^:= color;
226
227 if Land[cpY + y, cpX + x] <= lfAllObjMask then
228 Land[cpY + y, cpX + x]:= lfObject
229 end;
230 end;
231 p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
232 end;
233
234 if SDL_MustLock(Image) then
235 SDL_UnlockSurface(Image);
236 WriteLnToConsole(msgOK)
237 end;
238
239 procedure BlitImageUsingMask(cpX, cpY: Longword; Image, Mask: PSDL_Surface);
240 var p, mp: PLongwordArray;
241 pLandColor: PLongWord;
242 alpha, color, landColor, x, y: Longword;
243 bpp: LongInt;
244 begin
245 WriteToConsole('Generating collision info... ');
246
247 if SDL_MustLock(Image) then
248 if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
249
250 bpp:= Image^.format^.BytesPerPixel;
251 if checkFails(bpp = 4, 'Land object should be 32bit', true) then
252 begin
253 if SDL_MustLock(Image) then
254 SDL_UnlockSurface(Image);
255 end;
256
257 p:= Image^.pixels;
258 mp:= Mask^.pixels;
259 for y:= 0 to Pred(Image^.h) do
260 begin
261 for x:= 0 to Pred(Image^.w) do
262 begin
263 color:= p^[x];
264
265 if (cReducedQuality and rqBlurryLand) = 0 then
266 pLandColor:= @LandPixels[cpY + y, cpX + x]
267 else
268 pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
269
270 landColor:= pLandColor^;
271 alpha:= (landColor and AMask) shr AShift;
272
273 if ((color and AMask) <> 0) and (alpha <> 255) then
274 begin
275 if alpha = 0 then
276 pLandColor^:= color
277 else
278 pLandColor^:=
279 (LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)
280 or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)
281 or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)
282 or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);
283 end;
284
285 if (Land[cpY + y, cpX + x] <= lfAllObjMask) or (Land[cpY + y, cpX + x] and lfObject <> 0) then
286 SetLand(Land[cpY + y, cpX + x], mp^[x]);
287 end;
288
289 p:= PLongwordArray(@(p^[Image^.pitch shr 2]));
290 mp:= PLongwordArray(@(mp^[Mask^.pitch shr 2]))
291 end;
292
293 if SDL_MustLock(Image) then
294 SDL_UnlockSurface(Image);
295 WriteLnToConsole(msgOK)
296 end;
297
298 procedure AddRect(x1, y1, w1, h1: LongInt);
299 begin
300 with Rects^[RectCount] do
301 begin
302 x:= x1;
303 y:= y1;
304 w:= w1;
305 h:= h1
306 end;
307 inc(RectCount);
308 checkFails(RectCount < MaxRects, 'AddRect: overflow', true)
309 end;
310
311 procedure InitRects;
312 begin
313 RectCount:= 0;
314 New(Rects)
315 end;
316
317 procedure FreeRects;
318 begin
319 Dispose(rects)
320 end;
321
CheckIntersectnull322 function CheckIntersect(x1, y1, w1, h1: LongInt): boolean;
323 var i: Longword;
324 res: boolean = false;
325 begin
326
327 i:= 0;
328 if RectCount > 0 then
329 repeat
330 with Rects^[i] do
331 res:= (x < x1 + w1) and (x1 < x + w) and (y < y1 + h1) and (y1 < y + h);
332 inc(i)
333 until (i = RectCount) or (res);
334 CheckIntersect:= res;
335 end;
336
337
CountNonZeroznull338 function CountNonZeroz(x, y, h: LongInt): Longword;
339 var i: LongInt;
340 lRes: Longword;
341 begin
342 lRes:= 0;
343 for i:= y to Pred(y + h) do
344 if Land[i, x] <> 0 then
345 inc(lRes);
346 CountNonZeroz:= lRes;
347 end;
348
AddGirdernull349 function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;
350 var x1, x2, y, k, i, girderHeight: LongInt;
351 rr: TSDL_Rect;
352 bRes: boolean;
353 begin
354 if girSurf = nil then
355 girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifColorKey or ifIgnoreCaps or ifDigestAlpha);
356
357 girderHeight:= girSurf^.h;
358
359 y:= topY+150;
360 repeat
361 inc(y, 24);
362 x1:= gX;
363 x2:= gX;
364
365 while (x1 > leftX+150) and (CountNonZeroz(x1, y, girderHeight) = 0) do
366 dec(x1, 2);
367
368 i:= x1 - 12;
369 repeat
370 k:= CountNonZeroz(x1, y, girderHeight);
371 dec(x1, 2)
372 until (x1 < leftX + 100) or (k = 0) or (k = girderHeight) or (x1 < i);
373
374 inc(x1, 2);
375 if k = girderHeight then
376 begin
377 while (x2 < (rightX - 100)) and (CountNonZeroz(x2, y, girderHeight) = 0) do
378 inc(x2, 2);
379 i:= x2 + 12;
380 repeat
381 inc(x2, 2);
382 k:= CountNonZeroz(x2, y, girderHeight)
383 until (x2 >= (rightX-150)) or (k = 0) or (k = girderHeight) or (x2 > i) or (x2 - x1 >= 900);
384
385 if (x2 < (rightX - 100)) and (k = girderHeight) and (x2 - x1 > 200) and (x2 - x1 < 900)
386 and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
387 break;
388 end;
389 x1:= 0;
390 until y > (LAND_HEIGHT-125);
391
392 if x1 > 0 then
393 begin
394 bRes:= true;
395
396 rr.x:= x1;
397 while rr.x < x2 do
398 begin
399 if cIce then
400 BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf, lfIce)
401 else
402 BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf);
403 inc(rr.x, girSurf^.w);
404 end;
405
406 AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80);
407 end
408 else bRes:= false;
409
410 AddGirder:= bRes;
411 end;
412
CheckLandnull413 function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;
414 var tmpx, tmpx2, tmpy, tmpy2, bx, by: LongInt;
415 bRes: boolean = true;
416 begin
417 inc(rect.x, dX);
418 inc(rect.y, dY);
419 bx:= rect.x + rect.w;
420 by:= rect.y + rect.h;
421 {$WARNINGS OFF}
422 tmpx:= rect.x;
423 tmpx2:= bx;
424 while (tmpx <= bx - rect.w div 2 - 1) and bRes do
425 begin
426 bRes:= ((rect.y and LAND_HEIGHT_MASK) = 0) and ((by and LAND_HEIGHT_MASK) = 0)
427 and ((tmpx and LAND_WIDTH_MASK) = 0) and ((tmpx2 and LAND_WIDTH_MASK) = 0)
428 and (Land[rect.y, tmpx] = Color) and (Land[by, tmpx] = Color)
429 and (Land[rect.y, tmpx2] = Color) and (Land[by, tmpx2] = Color);
430 inc(tmpx);
431 dec(tmpx2)
432 end;
433 tmpy:= rect.y+1;
434 tmpy2:= by-1;
435 while (tmpy <= by - rect.h div 2 - 1) and bRes do
436 begin
437 bRes:= ((tmpy and LAND_HEIGHT_MASK) = 0) and ((tmpy2 and LAND_HEIGHT_MASK) = 0)
438 and ((rect.x and LAND_WIDTH_MASK) = 0) and ((bx and LAND_WIDTH_MASK) = 0)
439 and (Land[tmpy, rect.x] = Color) and (Land[tmpy, bx] = Color)
440 and (Land[tmpy2, rect.x] = Color) and (Land[tmpy2, bx] = Color);
441 inc(tmpy);
442 dec(tmpy2)
443 end;
444 {$WARNINGS ON}
445 CheckLand:= bRes;
446 end;
447
CheckLandAnynull448 function CheckLandAny(rect: TSDL_Rect; dX, dY, LandType: Longword): boolean;
449 var tmpx, tmpy, bx, by: LongInt;
450 begin
451 inc(rect.x, dX);
452 inc(rect.y, dY);
453 bx:= rect.x + rect.w - 1;
454 by:= rect.y + rect.h - 1;
455 CheckLandAny:= false;
456
457 if (((rect.x and LAND_WIDTH_MASK) or (bx and LAND_WIDTH_MASK) or
458 (rect.y and LAND_HEIGHT_MASK) or (by and LAND_HEIGHT_MASK)) = 0) then
459 begin
460 for tmpx := rect.x to bx do
461 begin
462 if (((Land[rect.y, tmpx] and LandType) or (Land[by, tmpx] and LandType)) <> 0) then
463 begin
464 CheckLandAny := true;
465 exit;
466 end
467 end;
468 for tmpy := rect.y to by do
469 begin
470 if (((Land[tmpy, rect.x] and LandType) or (Land[tmpy, bx] and LandType)) <> 0) then
471 begin
472 CheckLandAny := true;
473 exit;
474 end
475 end;
476 end;
477 end;
478
CheckCanPlacenull479 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
480 var i: Longword;
481 bRes, anchored: boolean;
482 overlayP1, overlayP2: TPoint;
483 begin
484 with Obj do begin
485 bRes:= true;
486 i:= 0;
487 while bRes and (i < overlaycnt) do
488 begin
489 overlayP1.x:= overlays[i].Position.x + x;
490 overlayP1.y:= overlays[i].Position.y + y;
491 overlayP2.x:= overlayP1.x + overlays[i].Width - 1;
492 overlayP2.y:= overlayP1.y + overlays[i].Height - 1;
493 bRes:= (((LAND_WIDTH_MASK and overlayP1.x) or (LAND_HEIGHT_MASK and overlayP1.y) or
494 (LAND_WIDTH_MASK and overlayP2.x) or (LAND_HEIGHT_MASK and overlayP2.y)) = 0)
495 and (not CheckIntersect(overlayP1.x, overlayP1.y, overlays[i].Width, overlays[i].Height));
496 inc(i)
497 end;
498
499 i:= 0;
500 while bRes and (i < inrectcnt) do
501 begin
502 bRes:= CheckLand(inland[i], x, y, lfBasic);
503 inc(i)
504 end;
505
506 i:= 0;
507 while bRes and (i < outrectcnt) do
508 begin
509 bRes:= CheckLand(outland[i], x, y, 0);
510 inc(i)
511 end;
512
513 if bRes then
514 begin
515 anchored:= anchorcnt = 0;
516 i:= 0;
517 while i < anchorcnt do
518 begin
519 anchored := CheckLandAny(anchors[i], x, y, lfLandMask);
520 if anchored then break;
521 inc(i);
522 end;
523 bRes:= anchored;
524 end;
525
526 if bRes then
527 bRes:= not CheckIntersect(x, y, Width, Height);
528
529 CheckCanPlace:= bRes;
530 end
531 end;
532
TryPutnull533 function TryPut(var Obj: TThemeObject): boolean;
534 const MaxPointsIndex = 2047;
535 var x, y: Longword;
536 ar: array[0..MaxPointsIndex] of TPoint;
537 cnt, i, ii: Longword;
538 bRes: boolean;
539 begin
540 TryPut:= false;
541 cnt:= 0;
542 with Obj do
543 begin
544 if Maxcnt = 0 then
545 exit;
546 x:= leftX;
547 repeat
548 y:= topY+32; // leave room for a hedgie to teleport in
549 repeat
550
551 if (inrectcnt > 0) and (inland[0].x = 0) and (inland[0].y = 0) and (inland[0].w = 0) and (inland[0].h = 0) then
552 y := LAND_HEIGHT - Height;
553
554 if CheckCanPlace(x, y, Obj) then
555 begin
556 ar[cnt].x:= x;
557 ar[cnt].y:= y;
558 if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land
559 begin
560 y:= LAND_HEIGHT;
561 x:= LAND_WIDTH;
562 end
563 else inc(cnt);
564 end;
565 inc(y, 3);
566 until y >= LAND_HEIGHT - Height;
567 inc(x, getrandom(6) + 3)
568 until x >= rightX - Width;
569 bRes:= cnt <> 0;
570 if bRes then
571 begin
572 i:= getrandom(cnt);
573 if Obj.Mask <> nil then
574 BlitImageUsingMask(ar[i].x, ar[i].y, Obj.Surf, Obj.Mask)
575 else BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
576 AddRect(ar[i].x, ar[i].y, Width, Height);
577
578 ii:= 0;
579 while ii < overlaycnt do
580 begin
581 BlitOverlayAndGenerateCollisionInfo(
582 ar[i].x + overlays[ii].Position.X,
583 ar[i].y + overlays[ii].Position.Y, overlays[ii].Surf);
584 AddRect(ar[i].x + overlays[ii].Position.X,
585 ar[i].y + overlays[ii].Position.Y,
586 Width, Height);
587 inc(ii);
588 end;
589 dec(Maxcnt)
590 end
591 else Maxcnt:= 0
592 end;
593 TryPut:= bRes;
594 end;
595
TryPut2null596 function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
597 const MaxPointsIndex = 8095;
598 var x, y, xStart, yStart: Longword;
599 xWraps, yWraps: Byte;
600 ar: array[0..MaxPointsIndex] of TPoint;
601 cnt, i: Longword;
602 r: TSDL_Rect;
603 bRes: boolean;
604 begin
605 TryPut2:= false;
606 cnt:= 0;
607 with Obj do
608 begin
609 if Maxcnt = 0 then
610 exit;
611 xWraps:= 0;
612 yWraps:= 0;
613 // Start at random coordinates
614 xStart:= getrandom(LAND_WIDTH - Width);
615 yStart:= 8 + getrandom(LAND_HEIGHT - Height - 16);
616 x:= xStart;
617 y:= yStart;
618 r.x:= 0;
619 r.y:= 0;
620 r.w:= Width;
621 r.h:= Height + 16;
622 // Then iterate through the whole map; this requires we wrap one time per axis
623 repeat
624 yWraps:= 0;
625 repeat
626 if CheckLand(r, x, y - 8, lfBasic)
627 and (not CheckIntersect(x, y, Width, Height)) then
628 begin
629 ar[cnt].x:= x;
630 ar[cnt].y:= y;
631 if cnt >= MaxPointsIndex then // buffer is full, do not check the rest land
632 begin
633 y:= $FF000000;
634 x:= $FF000000;
635 end
636 else inc(cnt);
637 end;
638 inc(y, 12);
639 if (y >= LAND_HEIGHT - Height - 8) or ((yWraps > 0) and (y >= yStart)) then
640 begin
641 inc(yWraps);
642 y:= 8;
643 end;
644 until yWraps > 1;
645 inc(x, getrandom(12) + 12);
646 if (x >= LAND_WIDTH - Width) or ((xWraps > 0) and (x >= xStart)) then
647 begin
648 inc(xWraps);
649 x:= 0;
650 end;
651 until xWraps > 1;
652 bRes:= cnt <> 0;
653 if bRes then
654 begin
655 i:= getrandom(cnt);
656 copyToXY(Obj.Surf, Surface, ar[i].X, ar[i].Y);
657 AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64);
658 dec(Maxcnt)
659 end
660 else Maxcnt:= 0
661 end;
662 TryPut2:= bRes;
663 end;
664
665
666 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
667 begin
668 if (x + w > Width) then
669 OutError('Broken theme. Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
670 if (y + h > Height) then
671 OutError('Broken theme. Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
672 end;
673
674 procedure ReadRect(var rect: TSDL_Rect; var s: ShortString);
675 var i: LongInt;
676 begin
677 with rect do
678 begin
679 i:= Pos(',', s);
680 x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
681 Delete(s, 1, i);
682 i:= Pos(',', s);
683 y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
684 Delete(s, 1, i);
685 i:= Pos(',', s);
686 w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
687 Delete(s, 1, i);
688 i:= Pos(',', s);
689 if i = 0 then i:= Succ(Length(S));
690 h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
691 Delete(s, 1, i);
692 end;
693 end;
694
695
696
697 procedure ReadOverlay(var overlay: TThemeObjectOverlay; var s: ShortString);
698 var i: LongInt;
699 begin
700 with overlay do
701 begin
702 i:= Pos(',', s);
703 Position.X:= StrToInt(Trim(Copy(s, 1, Pred(i))));
704 Delete(s, 1, i);
705 i:= Pos(',', s);
706 Position.Y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
707 Delete(s, 1, i);
708 i:= Pos(',', s);
709 if i = 0 then i:= Succ(Length(S));
710 Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifColorKey or ifIgnoreCaps or ifCritical or ifDigestAlpha );
711 Width:= Surf^.w;
712 Height:= Surf^.h;
713 Delete(s, 1, i);
714 end;
715 end;
716
717 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
718 var s, key, nameRef: shortstring;
719 f: PFSFile;
720 i: LongInt;
721 ii, t: Longword;
722 c2: TSDL_Color;
723 begin
724
725 AddProgress;
726 // Set default water greyscale values
727 if GrayScale then
728 begin
729 for i:= Low(SDWaterColorArray) to High(SDWaterColorArray) do
730 begin
731 t:= round(SDWaterColorArray[i].r * RGB_LUMINANCE_RED + SDWaterColorArray[i].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[i].b * RGB_LUMINANCE_BLUE);
732 if t > 255 then
733 t:= 255;
734 SDWaterColorArray[i].r:= t;
735 SDWaterColorArray[i].g:= t;
736 SDWaterColorArray[i].b:= t
737 end;
738 for i:= Low(WaterColorArray) to High(WaterColorArray) do
739 begin
740 t:= round(WaterColorArray[i].r * RGB_LUMINANCE_RED + WaterColorArray[i].g * RGB_LUMINANCE_GREEN + WaterColorArray[i].b * RGB_LUMINANCE_BLUE);
741 if t > 255 then
742 t:= 255;
743 WaterColorArray[i].r:= t;
744 WaterColorArray[i].g:= t;
745 WaterColorArray[i].b:= t
746 end
747 end;
748
749 s:= cPathz[ptCurrTheme] + '/' + cThemeCFGFilename;
750 WriteLnToConsole('Reading objects info...');
751 f:= pfsOpenRead(s);
752 if (f = nil) then
753 OutError('Error loading theme. File could not be opened: ' + s, true);
754
755 ThemeObjects.Count:= 0;
756 SprayObjects.Count:= 0;
757
758 while (not pfsEOF(f)) and allOK do
759 begin
760 pfsReadLn(f, s);
761 if Length(s) = 0 then
762 continue;
763 if s[1] = ';' then
764 continue;
765
766 i:= Pos('=', s);
767 key:= Trim(Copy(s, 1, Pred(i)));
768 Delete(s, 1, i);
769
770 if key = 'sky' then
771 begin
772 i:= Pos(',', s);
773 SkyColor.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
774 Delete(s, 1, i);
775 i:= Pos(',', s);
776 SkyColor.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
777 Delete(s, 1, i);
778 SkyColor.b:= StrToInt(Trim(s));
779 if GrayScale
780 then
781 begin
782 t:= round(SkyColor.r * RGB_LUMINANCE_RED + SkyColor.g * RGB_LUMINANCE_GREEN + SkyColor.b * RGB_LUMINANCE_BLUE);
783 if t > 255 then
784 t:= 255;
785 SkyColor.r:= t;
786 SkyColor.g:= t;
787 SkyColor.b:= t
788 end;
789 SetSkyColor(SkyColor.r / 255, SkyColor.g / 255, SkyColor.b / 255);
790 SDSkyColor.r:= SkyColor.r;
791 SDSkyColor.g:= SkyColor.g;
792 SDSkyColor.b:= SkyColor.b;
793 end
794 else if key = 'sd-tint' then
795 begin
796 i:= Pos(',', s);
797 SDTint.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
798 Delete(s, 1, i);
799 i:= Pos(',', s);
800 SDTint.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
801 Delete(s, 1, i);
802 i:= Pos(',', s);
803 SDTint.b:= StrToInt(Trim(Copy(s, 1, Pred(i))));
804 Delete(s, 1, i);
805 SDTint.a:= StrToInt(Trim(s));
806 if GrayScale
807 then
808 begin
809 t:= round(SDTint.r * RGB_LUMINANCE_RED + SDTint.g * RGB_LUMINANCE_GREEN + SDTint.b * RGB_LUMINANCE_BLUE);
810 if t > 255 then
811 t:= 255;
812 SDTint.r:= t;
813 SDTint.g:= t;
814 SDTint.b:= t
815 end;
816 end
817 else if key = 'border' then
818 begin
819 i:= Pos(',', s);
820 c2.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
821 Delete(s, 1, i);
822 i:= Pos(',', s);
823 c2.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
824 Delete(s, 1, i);
825 c2.b:= StrToInt(Trim(s));
826 if GrayScale then
827 begin
828 t:= round(SkyColor.r * RGB_LUMINANCE_RED + SkyColor.g * RGB_LUMINANCE_GREEN + SkyColor.b * RGB_LUMINANCE_BLUE);
829 if t > 255 then
830 t:= 255;
831 c2.r:= t;
832 c2.g:= t;
833 c2.b:= t
834 end;
835 ExplosionBorderColorR:= c2.r;
836 ExplosionBorderColorG:= c2.g;
837 ExplosionBorderColorB:= c2.b;
838 ExplosionBorderColorNoA:=
839 (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift);
840 ExplosionBorderColor:= ExplosionBorderColorNoA or AMask;
841 end
842 else if key = 'water-top' then
843 begin
844 i:= Pos(',', s);
845 WaterColorArray[1].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
846 Delete(s, 1, i);
847 i:= Pos(',', s);
848 WaterColorArray[1].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
849 Delete(s, 1, i);
850 WaterColorArray[1].b:= StrToInt(Trim(s));
851 WaterColorArray[1].a := 255;
852 if GrayScale then
853 begin
854 t:= round(WaterColorArray[0].r * RGB_LUMINANCE_RED + WaterColorArray[0].g * RGB_LUMINANCE_GREEN + WaterColorArray[0].b * RGB_LUMINANCE_BLUE);
855 if t > 255 then
856 t:= 255;
857 WaterColorArray[1].r:= t;
858 WaterColorArray[1].g:= t;
859 WaterColorArray[1].b:= t
860 end;
861 WaterColorArray[3]:= WaterColorArray[1];
862 WaterColorArray[5]:= WaterColorArray[1];
863 WaterColorArray[7]:= WaterColorArray[1];
864 end
865 else if key = 'water-bottom' then
866 begin
867 i:= Pos(',', s);
868 WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
869 Delete(s, 1, i);
870 i:= Pos(',', s);
871 WaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
872 Delete(s, 1, i);
873 WaterColorArray[0].b:= StrToInt(Trim(s));
874 WaterColorArray[0].a := 255;
875 if GrayScale then
876 begin
877 t:= round(WaterColorArray[2].r * RGB_LUMINANCE_RED + WaterColorArray[2].g * RGB_LUMINANCE_GREEN + WaterColorArray[2].b * RGB_LUMINANCE_BLUE);
878 if t > 255 then
879 t:= 255;
880 WaterColorArray[0].r:= t;
881 WaterColorArray[0].g:= t;
882 WaterColorArray[0].b:= t
883 end;
884 WaterColorArray[2]:= WaterColorArray[0];
885 WaterColorArray[4]:= WaterColorArray[0];
886 WaterColorArray[6]:= WaterColorArray[0];
887 end
888 else if key = 'water-opacity' then
889 begin
890 WaterOpacity:= StrToInt(Trim(s));
891 SDWaterOpacity:= WaterOpacity
892 end
893 else if key = 'music' then
894 MusicFN:= Trim(s)
895 else if key = 'sd-music' then
896 SDMusicFN:= Trim(s)
897 else if key = 'fallback-music' then
898 FallbackMusicFN:= Trim(s)
899 else if key = 'fallback-sd-music' then
900 FallbackSDMusicFN:= Trim(s)
901 else if key = 'clouds' then
902 begin
903 cCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096;
904 cSDCloudsNumber:= cCloudsNumber
905 end
906 else if key = 'object' then
907 begin
908 inc(ThemeObjects.Count);
909 with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
910 begin
911 i:= Pos(',', s);
912 Name:= Trim(Copy(s, 1, Pred(i)));
913
914 Mask:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i)))+'_mask', ifColorKey or ifIgnoreCaps or ifDigestAll);
915 if Mask = nil then
916 Surf:= LoadDataImage(ptCurrTheme, Name, ifColorKey or ifIgnoreCaps or ifCritical or ifDigestAlpha)
917 else
918 Surf:= LoadDataImage(ptCurrTheme, Name, ifColorKey or ifIgnoreCaps or ifCritical);
919
920 Width:= Surf^.w;
921 Height:= Surf^.h;
922
923 Delete(s, 1, i);
924 i:= Pos(',', s);
925 Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
926 Delete(s, 1, i);
927 if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
928 OutError('Broken theme. Object''s max. count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
929
930 inrectcnt := 0;
931
932 for ii := 1 to Length(S) do
933 if S[ii] = ',' then
934 inc(inrectcnt);
935
936 if inrectcnt mod 2 = 0 then
937 inrectcnt := 1
938 else begin
939 i:= Pos(',', s);
940 inrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
941 Delete(s, 1, i);
942 end;
943
944 if inrectcnt > MAXOBJECTRECTS then
945 OutError('Broken theme. Object''s inland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(inrectcnt) +').', true);
946
947 for ii:= 0 to Pred(inrectcnt) do
948 ReadRect(inland[ii], s);
949
950 i:= Pos(',', s);
951 outrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
952 Delete(s, 1, i);
953
954 if outrectcnt > MAXOBJECTRECTS then
955 OutError('Broken theme. Object''s outland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(outrectcnt) +').', true);
956
957 for ii:= 0 to Pred(outrectcnt) do
958 ReadRect(outland[ii], s);
959 end;
960 end
961 else if key = 'anchors' then
962 begin
963 i:= Pos(',', s);
964 nameRef:= Trim(Copy(s, 1, Pred(i)));
965 for ii:= 0 to Pred(ThemeObjects.Count) do
966 if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
967 begin
968 if anchorcnt <> 0 then
969 OutError('Broken theme. Duplicate anchors declaration for object ' + nameRef, true);
970 Delete(s, 1, i);
971 i:= Pos(',', s);
972 anchorcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
973 Delete(s, 1, i);
974 if anchorcnt > MAXOBJECTRECTS then
975 OutError('Broken theme. Object''s anchor rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(anchorcnt) +').', true);
976 for t:= 0 to Pred(anchorcnt) do
977 ReadRect(anchors[t], s);
978 break
979 end;
980 end
981 else if key = 'overlays' then
982 begin
983 i:= Pos(',', s);
984 nameRef:= Trim(Copy(s, 1, Pred(i)));
985 for ii:= 0 to Pred(ThemeObjects.Count) do
986 if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
987 begin
988 if overlaycnt <> 0 then
989 OutError('Broken theme. Duplicate overlays declaration for object ' + nameRef, true);
990 Delete(s, 1, i);
991 i:= Pos(',', s);
992 overlaycnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
993 Delete(s, 1, i);
994 if overlaycnt > MAXOBJECTRECTS then
995 OutError('Broken theme. Object''s overlay count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(overlaycnt) +').', true);
996 for t:= 0 to Pred(overlaycnt) do
997 ReadOverlay(overlays[t], s);
998 break
999 end;
1000 end
1001 else if key = 'spray' then
1002 begin
1003 inc(SprayObjects.Count);
1004 with SprayObjects.objs[Pred(SprayObjects.Count)] do
1005 begin
1006 i:= Pos(',', s);
1007 Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifAlpha or ifIgnoreCaps);
1008 Width:= Surf^.w;
1009 Height:= Surf^.h;
1010 Delete(s, 1, i);
1011 Maxcnt:= StrToInt(Trim(s));
1012 end;
1013 end
1014 else if key = 'water-animation' then
1015 begin
1016 i:= Pos(',', s);
1017 watFrames:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1018 Delete(s, 1, i);
1019 i:= Pos(',', s);
1020 watFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1021 Delete(s, 1, i);
1022 watMove:= StrToInt(Trim(s));
1023 end
1024 else if key = 'sd-water-animation' then
1025 begin
1026 i:= Pos(',', s);
1027 watSDFrames:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1028 Delete(s, 1, i);
1029 i:= Pos(',', s);
1030 watSDFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1031 Delete(s, 1, i);
1032 watSDMove:= StrToInt(Trim(s));
1033 end
1034 else if key = 'flakes' then
1035 begin
1036 i:= Pos(',', s);
1037 vobCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1038 Delete(s, 1, i);
1039 if vobCount > 0 then
1040 begin
1041 i:= Pos(',', s);
1042 vobFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1043 Delete(s, 1, i);
1044 i:= Pos(',', s);
1045 vobFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1046 Delete(s, 1, i);
1047 i:= Pos(',', s);
1048 vobVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1049 Delete(s, 1, i);
1050 vobFallSpeed:= StrToInt(Trim(s));
1051 end;
1052 end
1053 else if key = 'flatten-flakes' then
1054 cFlattenFlakes:= true
1055 else if key = 'flatten-clouds' then
1056 cFlattenClouds:= true
1057 else if key = 'ice' then
1058 cIce:= true
1059 else if key = 'snow' then
1060 cSnow:= true
1061 else if key = 'rope-step' then
1062 cRopeNodeStep:= max(1, StrToInt(s))
1063 else if key = 'rope-layers' then
1064 cRopeLayers:= max(1, min(MAXROPELAYERS, StrToInt(s)))
1065 else if key = 'sd-water-top' then
1066 begin
1067 i:= Pos(',', s);
1068 SDWaterColorArray[1].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1069 Delete(s, 1, i);
1070 i:= Pos(',', s);
1071 SDWaterColorArray[1].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1072 Delete(s, 1, i);
1073 SDWaterColorArray[1].b:= StrToInt(Trim(s));
1074 SDWaterColorArray[1].a := 255;
1075 if GrayScale then
1076 begin
1077 t:= round(SDWaterColorArray[0].r * RGB_LUMINANCE_RED + SDWaterColorArray[0].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[0].b * RGB_LUMINANCE_BLUE);
1078 if t > 255 then
1079 t:= 255;
1080 SDWaterColorArray[1].r:= t;
1081 SDWaterColorArray[1].g:= t;
1082 SDWaterColorArray[1].b:= t
1083 end;
1084 SDWaterColorArray[3]:= SDWaterColorArray[1];
1085 SDWaterColorArray[5]:= SDWaterColorArray[1];
1086 SDWaterColorArray[7]:= SDWaterColorArray[1];
1087 end
1088 else if key = 'sd-water-bottom' then
1089 begin
1090 i:= Pos(',', s);
1091 SDWaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1092 Delete(s, 1, i);
1093 i:= Pos(',', s);
1094 SDWaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1095 Delete(s, 1, i);
1096 SDWaterColorArray[0].b:= StrToInt(Trim(s));
1097 SDWaterColorArray[0].a := 255;
1098 if GrayScale then
1099 begin
1100 t:= round(SDWaterColorArray[2].r * RGB_LUMINANCE_RED + SDWaterColorArray[2].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[2].b * RGB_LUMINANCE_BLUE);
1101 if t > 255 then
1102 t:= 255;
1103 SDWaterColorArray[0].r:= t;
1104 SDWaterColorArray[0].g:= t;
1105 SDWaterColorArray[0].b:= t
1106 end;
1107 SDWaterColorArray[2]:= SDWaterColorArray[0];
1108 SDWaterColorArray[4]:= SDWaterColorArray[0];
1109 SDWaterColorArray[6]:= SDWaterColorArray[0];
1110 end
1111 else if key = 'sd-water-opacity' then
1112 SDWaterOpacity:= StrToInt(Trim(s))
1113 else if key = 'sd-clouds' then
1114 cSDCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096
1115 else if key = 'sd-flakes' then
1116 begin
1117 i:= Pos(',', s);
1118 vobSDCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1119 Delete(s, 1, i);
1120 if vobSDCount > 0 then
1121 begin
1122 i:= Pos(',', s);
1123 vobSDFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1124 Delete(s, 1, i);
1125 i:= Pos(',', s);
1126 vobSDFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1127 Delete(s, 1, i);
1128 i:= Pos(',', s);
1129 vobSDVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1130 Delete(s, 1, i);
1131 vobSDFallSpeed:= StrToInt(Trim(s));
1132 end;
1133 end
1134 else if key = 'rq-sky' then
1135 begin
1136 if ((cReducedQuality and rqNoBackground) <> 0) then
1137 begin
1138 i:= Pos(',', s);
1139 RQSkyColor.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1140 Delete(s, 1, i);
1141 i:= Pos(',', s);
1142 RQSkyColor.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
1143 Delete(s, 1, i);
1144 RQSkyColor.b:= StrToInt(Trim(s));
1145 if GrayScale then
1146 begin
1147 t:= round(RQSkyColor.r * RGB_LUMINANCE_RED + RQSkyColor.g * RGB_LUMINANCE_GREEN + RQSkyColor.b * RGB_LUMINANCE_BLUE);
1148 if t > 255 then
1149 t:= 255;
1150 RQSkyColor.r:= t;
1151 RQSkyColor.g:= t;
1152 RQSkyColor.b:= t
1153 end;
1154 SetSkyColor(RQSkyColor.r / 255, RQSkyColor.g / 255, RQSkyColor.b / 255);
1155 SDSkyColor.r:= RQSkyColor.r;
1156 SDSkyColor.g:= RQSkyColor.g;
1157 SDSkyColor.b:= RQSkyColor.b;
1158 end
1159 end
1160 end;
1161
1162 pfsClose(f);
1163 AddProgress;
1164 end;
1165
1166 procedure AddThemeObjects(var ThemeObjects: TThemeObjects);
1167 var i, ii, t: LongInt;
1168 b: boolean;
1169 begin
1170 if ThemeObjects.Count = 0 then
1171 exit;
1172 WriteLnToConsole('Adding theme objects...');
1173
1174 for i:=0 to Pred(ThemeObjects.Count) do
1175 ThemeObjects.objs[i].Maxcnt := max(1, (ThemeObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map
1176
1177 repeat
1178 t := getrandom(ThemeObjects.Count);
1179 b := false;
1180 for i:= 0 to Pred(ThemeObjects.Count) do
1181 begin
1182 ii := (i+t) mod ThemeObjects.Count;
1183
1184 if ThemeObjects.objs[ii].Maxcnt <> 0 then
1185 b := b or TryPut(ThemeObjects.objs[ii])
1186 end;
1187 until not b;
1188 end;
1189
1190 procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects);
1191 var i, ii, t: LongInt;
1192 b: boolean;
1193 begin
1194 if SprayObjects.Count = 0 then
1195 exit;
1196 WriteLnToConsole('Adding spray objects...');
1197
1198 for i:= 0 to Pred(SprayObjects.Count) do
1199 SprayObjects.objs[i].Maxcnt := max(1, (SprayObjects.objs[i].Maxcnt * MaxHedgehogs) div 18); // Maxcnt is proportional to map size, but allow objects to span even if we're on a tiny map
1200
1201 repeat
1202 t := getrandom(SprayObjects.Count);
1203 b := false;
1204 for i:= 0 to Pred(SprayObjects.Count) do
1205 begin
1206 ii := (i+t) mod SprayObjects.Count;
1207
1208 if SprayObjects.objs[ii].Maxcnt <> 0 then
1209 b := b or TryPut2(SprayObjects.objs[ii], Surface)
1210 end;
1211 until not b;
1212 end;
1213
1214 procedure AddObjects();
1215 var girSurf: PSDL_Surface;
1216 i, g: Longword;
1217 begin
1218 InitRects;
1219 if hasGirders then
1220 begin
1221 g:= max(playWidth div 8, 256);
1222 i:= leftX + g;
1223 girSurf:= nil;
1224 repeat
1225 AddGirder(i, girSurf);
1226 i:=i + g;
1227 until (i > rightX - g);
1228 // free girder surface
1229 if girSurf <> nil then
1230 begin
1231 SDL_FreeSurface(girSurf);
1232 girSurf:= nil;
1233 end;
1234 end;
1235 if (GameFlags and gfDisableLandObjects) = 0 then
1236 AddThemeObjects(ThemeObjects);
1237 AddProgress();
1238 FreeRects();
1239 end;
1240
1241 procedure AddOnLandObjects(Surface: PSDL_Surface);
1242 begin
1243 InitRects;
1244 AddSprayObjects(Surface, SprayObjects);
1245 FreeRects
1246 end;
1247
1248 procedure LoadThemeConfig;
1249 begin
1250 ReadThemeInfo(ThemeObjects, SprayObjects)
1251 end;
1252
1253 procedure FreeLandObjects();
1254 var i, ii: Longword;
1255 begin
1256 for i:= 0 to Pred(MAXTHEMEOBJECTS) do
1257 begin
1258 if ThemeObjects.objs[i].Surf <> nil then
1259 SDL_FreeSurface(ThemeObjects.objs[i].Surf);
1260 if SprayObjects.objs[i].Surf <> nil then
1261 SDL_FreeSurface(SprayObjects.objs[i].Surf);
1262 ThemeObjects.objs[i].Surf:= nil;
1263 SprayObjects.objs[i].Surf:= nil;
1264
1265 ii:= 0;
1266 while ii < ThemeObjects.objs[i].overlaycnt do
1267 begin
1268 if ThemeObjects.objs[i].overlays[ii].Surf <> nil then
1269 begin
1270 SDL_FreeSurface(ThemeObjects.objs[i].overlays[ii].Surf);
1271 ThemeObjects.objs[i].overlays[ii].Surf:= nil;
1272 end;
1273 inc(ii);
1274 end;
1275 end;
1276 end;
1277
1278 end.
1279