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