Advertisement
KoBeWi

Untitled

Sep 29th, 2016
52
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 31.34 KB | None | 0 0
  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 BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
  32. procedure AddOnLandObjects(Surface: PSDL_Surface);
  33. procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
  34.  
  35. implementation
  36. uses uStore, uConsts, uConsole, uRandom, uSound
  37.      , uTypes, uVariables, uUtils, uDebug, SysUtils
  38.      , uPhysFSLayer;
  39.  
  40. const MaxRects = 512;
  41.       MAXOBJECTRECTS = 16;
  42.       MAXTHEMEOBJECTS = 32;
  43.       cThemeCFGFilename = 'theme.cfg';
  44.  
  45. type TRectsArray = array[0..MaxRects] of TSDL_Rect;
  46.      PRectArray = ^TRectsArray;
  47.      TThemeObject = record
  48.                      Surf, Mask: PSDL_Surface;
  49.                      inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
  50.                      outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
  51.                      rectcnt: Longword;
  52.                      rectcnt2: Longword;
  53.                      Width, Height: Longword;
  54.                      Maxcnt: Longword;
  55.                      end;
  56.      TThemeObjects = record
  57.                      Count: LongInt;
  58.                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TThemeObject;
  59.                      end;
  60.      TSprayObject = record
  61.                      Surf: PSDL_Surface;
  62.                      Width, Height: Longword;
  63.                      Maxcnt: Longword;
  64.                      end;
  65.      TSprayObjects = record
  66.                      Count: LongInt;
  67.                      objs: array[0..Pred(MAXTHEMEOBJECTS)] of TSprayObject
  68.                      end;
  69.  
  70. var Rects: PRectArray;
  71.     RectCount: Longword;
  72.     ThemeObjects: TThemeObjects;
  73.     SprayObjects: TSprayObjects;
  74.  
  75. procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
  76. begin
  77.     // this an if instead of masking colours to avoid confusing map creators
  78.     if ((AMask and Pixel) = 0) then
  79.         LandWord:= 0
  80.     else if Pixel = $FFFFFFFF then                  // white
  81.         LandWord:= lfObject
  82.     else if Pixel = AMask then                      // black
  83.         begin
  84.         LandWord:= lfBasic;
  85.         disableLandBack:= false
  86.         end
  87.     else if Pixel = (AMask or RMask) then           // red
  88.         LandWord:= lfIndestructible
  89.     else if Pixel = (AMask or BMask) then           // blue
  90.         LandWord:= lfObject or lfIce
  91.     else if Pixel = (AMask or GMask) then           // green
  92.         LandWord:= lfObject or lfBouncy
  93. end;
  94.  
  95. procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
  96. begin
  97.     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, 0, false);
  98. end;
  99.  
  100. procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); inline;
  101. begin
  102.     BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, LandFlags, false);
  103. end;
  104.  
  105. procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
  106. var p: PLongwordArray;
  107.     px, x, y: Longword;
  108.     bpp: LongInt;
  109. begin
  110. WriteToConsole('Generating collision info... ');
  111.  
  112. if SDL_MustLock(Image) then
  113.     SDLTry(SDL_LockSurface(Image) >= 0, true);
  114.  
  115. bpp:= Image^.format^.BytesPerPixel;
  116. TryDo(bpp = 4, 'Land object should be 32bit', true);
  117.  
  118. if Width = 0 then
  119.     Width:= Image^.w;
  120.  
  121. p:= Image^.pixels;
  122. for y:= 0 to Pred(Image^.h) do
  123.     begin
  124.     for x:= 0 to Pred(Width) do
  125.         begin
  126.         // map image pixels per line backwards if in flip mode
  127.         if Flip then
  128.             px:= Pred(Image^.w) - x
  129.         else
  130.             px:= x;
  131.  
  132.         if (p^[px] and AMask) <> 0 then
  133.             begin
  134.             if (cReducedQuality and rqBlurryLand) = 0 then
  135.                 begin
  136.                 if (LandPixels[cpY + y, cpX + x] = 0)
  137.                 or (((p^[px] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
  138.                     LandPixels[cpY + y, cpX + x]:= p^[px];
  139.                 end
  140.             else
  141.                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
  142.                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[px];
  143.  
  144.             if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[px] and AMask) <> 0) then
  145.                 Land[cpY + y, cpX + x]:= lfObject or LandFlags
  146.             end;
  147.         end;
  148.     p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
  149.     end;
  150.  
  151. if SDL_MustLock(Image) then
  152.     SDL_UnlockSurface(Image);
  153. WriteLnToConsole(msgOK)
  154. end;
  155.  
  156. procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
  157. var p, mp: PLongwordArray;
  158.     x, y: Longword;
  159.     bpp: LongInt;
  160. begin
  161. WriteToConsole('Generating collision info... ');
  162.  
  163. if SDL_MustLock(Image) then
  164.     SDLTry(SDL_LockSurface(Image) >= 0, true);
  165.  
  166. bpp:= Image^.format^.BytesPerPixel;
  167. TryDo(bpp = 4, 'Land object should be 32bit', true);
  168.  
  169. p:= Image^.pixels;
  170. mp:= Mask^.pixels;
  171. for y:= 0 to Pred(Image^.h) do
  172.     begin
  173.     for x:= 0 to Pred(Image^.w) do
  174.         begin
  175.         if (cReducedQuality and rqBlurryLand) = 0 then
  176.             begin
  177.             if (LandPixels[cpY + y, cpX + x] = 0)
  178.             or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
  179.                 LandPixels[cpY + y, cpX + x]:= p^[x];
  180.             end
  181.         else
  182.             if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
  183.                 LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
  184.  
  185.         if (Land[cpY + y, cpX + x] <= lfAllObjMask) or (Land[cpY + y, cpX + x] and lfObject <> 0)  then
  186.             SetLand(Land[cpY + y, cpX + x], mp^[x]);
  187.         end;
  188.     p:= PLongwordArray(@(p^[Image^.pitch shr 2]));
  189.     mp:= PLongwordArray(@(mp^[Mask^.pitch shr 2]))
  190.     end;
  191.  
  192. if SDL_MustLock(Image) then
  193.     SDL_UnlockSurface(Image);
  194. WriteLnToConsole(msgOK)
  195. end;
  196.  
  197. procedure AddRect(x1, y1, w1, h1: LongInt);
  198. begin
  199. with Rects^[RectCount] do
  200.     begin
  201.     x:= x1;
  202.     y:= y1;
  203.     w:= w1;
  204.     h:= h1
  205.     end;
  206. inc(RectCount);
  207. TryDo(RectCount < MaxRects, 'AddRect: overflow', true)
  208. end;
  209.  
  210. procedure InitRects;
  211. begin
  212. RectCount:= 0;
  213. New(Rects)
  214. end;
  215.  
  216. procedure FreeRects;
  217. begin
  218.     Dispose(rects)
  219. end;
  220.  
  221. function CheckIntersect(x1, y1, w1, h1: LongInt): boolean;
  222. var i: Longword;
  223.     res: boolean = false;
  224. begin
  225.  
  226. i:= 0;
  227. if RectCount > 0 then
  228.     repeat
  229.     with Rects^[i] do
  230.         res:= (x < x1 + w1) and (x1 < x + w) and (y < y1 + h1) and (y1 < y + h);
  231.     inc(i)
  232.     until (i = RectCount) or (res);
  233. CheckIntersect:= res;
  234. end;
  235.  
  236.  
  237. function CountNonZeroz(x, y, h: LongInt): Longword;
  238. var i: LongInt;
  239.     lRes: Longword;
  240. begin
  241.     lRes:= 0;
  242.     for i:= y to Pred(y + h) do
  243.         if Land[i, x] <> 0 then
  244.             inc(lRes);
  245.     CountNonZeroz:= lRes;
  246. end;
  247.  
  248. function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;
  249. var x1, x2, y, k, i, girderHeight: LongInt;
  250.     rr: TSDL_Rect;
  251.     bRes: boolean;
  252. begin
  253. if girSurf = nil then
  254.     girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifTransparent or ifIgnoreCaps);
  255.  
  256. girderHeight:= girSurf^.h;
  257.  
  258. y:= topY+150;
  259. repeat
  260.     inc(y, 24);
  261.     x1:= gX;
  262.     x2:= gX;
  263.  
  264.     while (x1 > Longint(leftX)+150) and (CountNonZeroz(x1, y, girderHeight) = 0) do
  265.         dec(x1, 2);
  266.  
  267.     i:= x1 - 12;
  268.     repeat
  269.         k:= CountNonZeroz(x1, y, girderHeight);
  270.         dec(x1, 2)
  271.     until (x1 < Longint(leftX) + 100) or (k = 0) or (k = girderHeight) or (x1 < i);
  272.  
  273.     inc(x1, 2);
  274.     if k = girderHeight then
  275.         begin
  276.         while (x2 < (LongInt(rightX) - 100)) and (CountNonZeroz(x2, y, girderHeight) = 0) do
  277.             inc(x2, 2);
  278.         i:= x2 + 12;
  279.         repeat
  280.         inc(x2, 2);
  281.         k:= CountNonZeroz(x2, y, girderHeight)
  282.         until (x2 >= (LongInt(rightX)-150)) or (k = 0) or (k = girderHeight) or (x2 > i) or (x2 - x1 >= 900);
  283.  
  284.         if (x2 < (LongInt(rightX) - 100)) and (k = girderHeight) and (x2 - x1 > 200) and (x2 - x1 < 900)
  285.         and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
  286.                 break;
  287.         end;
  288. x1:= 0;
  289. until y > (LAND_HEIGHT-125);
  290.  
  291. if x1 > 0 then
  292. begin
  293.     bRes:= true;
  294.  
  295.     rr.x:= x1;
  296.     while rr.x < x2 do
  297.         begin
  298.         if cIce then
  299.             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf, lfIce)
  300.         else
  301.             BlitImageAndGenerateCollisionInfo(rr.x, y, min(x2 - rr.x, girSurf^.w), girSurf);
  302.         inc(rr.x, girSurf^.w);
  303.         end;
  304.  
  305.     AddRect(x1 - 8, y - 32, x2 - x1 + 16, 80);
  306. end
  307. else bRes:= false;
  308.  
  309. AddGirder:= bRes;
  310. end;
  311.  
  312. function CheckLand(rect: TSDL_Rect; dX, dY, Color: Longword): boolean;
  313. var tmpx, tmpx2, tmpy, tmpy2, bx, by: LongInt;
  314.     bRes: boolean = true;
  315. begin
  316. inc(rect.x, dX);
  317. inc(rect.y, dY);
  318. bx:= rect.x + rect.w;
  319. by:= rect.y + rect.h;
  320. {$WARNINGS OFF}
  321. tmpx:= rect.x;
  322. tmpx2:= bx;
  323. while (tmpx <= bx - rect.w div 2 - 1) and bRes do
  324.     begin
  325.     bRes:= ((rect.y and LAND_HEIGHT_MASK) = 0) and ((by and LAND_HEIGHT_MASK) = 0)
  326.     and ((tmpx and LAND_WIDTH_MASK) = 0) and ((tmpx2 and LAND_WIDTH_MASK) = 0)
  327.     and (Land[rect.y, tmpx] = Color) and (Land[by, tmpx] = Color)
  328.     and (Land[rect.y, tmpx2] = Color) and (Land[by, tmpx2] = Color);
  329.     inc(tmpx);
  330.     dec(tmpx2)
  331.     end;
  332. tmpy:= rect.y+1;
  333. tmpy2:= by-1;
  334. while (tmpy <= by - rect.h div 2 - 1) and bRes do
  335.     begin
  336.     bRes:= ((tmpy and LAND_HEIGHT_MASK) = 0) and ((tmpy2 and LAND_HEIGHT_MASK) = 0)
  337.     and ((rect.x and LAND_WIDTH_MASK) = 0) and ((bx and LAND_WIDTH_MASK) = 0)
  338.     and (Land[tmpy, rect.x] = Color) and (Land[tmpy, bx] = Color)
  339.     and (Land[tmpy2, rect.x] = Color) and (Land[tmpy2, bx] = Color);
  340.     inc(tmpy);
  341.     dec(tmpy2)
  342.     end;
  343. {$WARNINGS ON}
  344. CheckLand:= bRes;
  345. end;
  346.  
  347. function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
  348. var i: Longword;
  349.     bRes: boolean;
  350. begin
  351.         with Obj do begin
  352.                 bRes:= true;
  353.                 i:= 1;
  354.                 while bRes and (i <= rectcnt2) do
  355.                     begin
  356.                     bRes:= CheckLand(inland[i], x, y, lfBasic);
  357.                     inc(i)
  358.                     end;
  359.                    
  360.                 i:= 1;
  361.                 while bRes and (i <= rectcnt) do
  362.                     begin
  363.                     bRes:= CheckLand(outland[i], x, y, 0);
  364.                     inc(i)
  365.                     end;
  366.                
  367.                 if bRes then
  368.                     bRes:= not CheckIntersect(x, y, Width, Height);
  369.                
  370.                 CheckCanPlace:= bRes;
  371.         end
  372. end;
  373.  
  374. function TryPut(var Obj: TThemeObject): boolean; overload;
  375. const MaxPointsIndex = 2047;
  376. var x, y: Longword;
  377.     ar: array[0..MaxPointsIndex] of TPoint;
  378.     cnt, i: Longword;
  379.     bRes: boolean;
  380. begin
  381. TryPut:= false;
  382. cnt:= 0;
  383. with Obj do
  384.     begin
  385.     if Maxcnt = 0 then
  386.         exit;
  387.     x:= 0;
  388.     repeat
  389.         y:= topY+32; // leave room for a hedgie to teleport in
  390.         repeat
  391.             if CheckCanPlace(x, y, Obj) then
  392.                 begin
  393.                 ar[cnt].x:= x;
  394.                 ar[cnt].y:= y;
  395.                 inc(cnt);
  396.                 if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
  397.                     begin
  398.                     y:= LAND_HEIGHT;
  399.                     x:= LAND_WIDTH;
  400.                     end
  401.                 end;
  402.             inc(y, 3);
  403.         until y >= LAND_HEIGHT - Height;
  404.         inc(x, getrandom(6) + 3)
  405.     until x >= LAND_WIDTH - Width;
  406.     bRes:= cnt <> 0;
  407.     if bRes then
  408.         begin
  409.         i:= getrandom(cnt);
  410.         if Obj.Mask <> nil then
  411.              BlitImageUsingMask(ar[i].x, ar[i].y, Obj.Surf, Obj.Mask)
  412.         else BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
  413.         AddRect(ar[i].x, ar[i].y, Width, Height);
  414.         dec(Maxcnt)
  415.         end
  416.     else Maxcnt:= 0
  417.     end;
  418. TryPut:= bRes;
  419. end;
  420.  
  421. function TryPut(var Obj: TSprayObject; Surface: PSDL_Surface): boolean; overload;
  422. const MaxPointsIndex = 8095;
  423. var x, y: Longword;
  424.     ar: array[0..MaxPointsIndex] of TPoint;
  425.     cnt, i: Longword;
  426.     r: TSDL_Rect;
  427.     bRes: boolean;
  428. begin
  429. TryPut:= false;
  430. cnt:= 0;
  431. with Obj do
  432.     begin
  433.     if Maxcnt = 0 then
  434.         exit;
  435.     x:= 0;
  436.     r.x:= 0;
  437.     r.y:= 0;
  438.     r.w:= Width;
  439.     r.h:= Height + 16;
  440.     repeat
  441.         y:= 8;
  442.         repeat
  443.             if CheckLand(r, x, y - 8, lfBasic)
  444.             and (not CheckIntersect(x, y, Width, Height)) then
  445.                 begin
  446.                 ar[cnt].x:= x;
  447.                 ar[cnt].y:= y;
  448.                 inc(cnt);
  449.                 if cnt > MaxPointsIndex then // buffer is full, do not check the rest land
  450.                     begin
  451.                     y:= 5000;
  452.                     x:= 5000;
  453.                     end
  454.                 end;
  455.             inc(y, 12);
  456.         until y >= LAND_HEIGHT - Height - 8;
  457.         inc(x, getrandom(12) + 12)
  458.     until x >= LAND_WIDTH - Width;
  459.     bRes:= cnt <> 0;
  460.     if bRes then
  461.         begin
  462.         i:= getrandom(cnt);
  463.         r.x:= ar[i].X;
  464.         r.y:= ar[i].Y;
  465.         r.w:= Width;
  466.         r.h:= Height;
  467.         SDL_UpperBlit(Obj.Surf, nil, Surface, @r);
  468.         AddRect(ar[i].x - 32, ar[i].y - 32, Width + 64, Height + 64);
  469.         dec(Maxcnt)
  470.         end
  471.     else Maxcnt:= 0
  472.     end;
  473. TryPut:= bRes;
  474. end;
  475.  
  476.  
  477. procedure CheckRect(Width, Height, x, y, w, h: LongWord);
  478. begin
  479.     if (x + w > Width) then
  480.         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
  481.     if (y + h > Height) then
  482.         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
  483. end;
  484.  
  485. procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
  486. var s, key: shortstring;
  487.     f: PFSFile;
  488.     i: LongInt;
  489.     j: LongInt;
  490.     ii, t: Longword;
  491.     c2: TSDL_Color;
  492. begin
  493.  
  494. AddProgress;
  495. // Set default water greyscale values
  496. if GrayScale then
  497.     begin
  498.     for i:= Low(SDWaterColorArray) to High(SDWaterColorArray) do
  499.         begin
  500.         t:= round(SDWaterColorArray[i].r * RGB_LUMINANCE_RED + SDWaterColorArray[i].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[i].b * RGB_LUMINANCE_BLUE);
  501.         if t > 255 then
  502.             t:= 255;
  503.         SDWaterColorArray[i].r:= t;
  504.         SDWaterColorArray[i].g:= t;
  505.         SDWaterColorArray[i].b:= t
  506.         end;
  507.     for i:= Low(WaterColorArray) to High(WaterColorArray) do
  508.         begin
  509.         t:= round(WaterColorArray[i].r * RGB_LUMINANCE_RED + WaterColorArray[i].g * RGB_LUMINANCE_GREEN + WaterColorArray[i].b * RGB_LUMINANCE_BLUE);
  510.         if t > 255 then
  511.             t:= 255;
  512.         WaterColorArray[i].r:= t;
  513.         WaterColorArray[i].g:= t;
  514.         WaterColorArray[i].b:= t
  515.         end
  516.     end;
  517.  
  518. s:= cPathz[ptCurrTheme] + '/' + cThemeCFGFilename;
  519. WriteLnToConsole('Reading objects info...');
  520. f:= pfsOpenRead(s);
  521. TryDo(f <> nil, 'Bad data or cannot access file ' + s, true);
  522.  
  523. ThemeObjects.Count:= 0;
  524. SprayObjects.Count:= 0;
  525.  
  526. while not pfsEOF(f) do
  527.     begin
  528.     pfsReadLn(f, s);
  529.     if Length(s) = 0 then
  530.         continue;
  531.     if s[1] = ';' then
  532.         continue;
  533.  
  534.     i:= Pos('=', s);
  535.     key:= Trim(Copy(s, 1, Pred(i)));
  536.     Delete(s, 1, i);
  537.  
  538.     if key = 'sky' then
  539.         begin
  540.         i:= Pos(',', s);
  541.         SkyColor.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  542.         Delete(s, 1, i);
  543.         i:= Pos(',', s);
  544.         SkyColor.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  545.         Delete(s, 1, i);
  546.         SkyColor.b:= StrToInt(Trim(s));
  547.         if GrayScale
  548.             then
  549.             begin
  550.             t:= round(SkyColor.r * RGB_LUMINANCE_RED + SkyColor.g * RGB_LUMINANCE_GREEN + SkyColor.b * RGB_LUMINANCE_BLUE);
  551.             if t > 255 then
  552.                 t:= 255;
  553.             SkyColor.r:= t;
  554.             SkyColor.g:= t;
  555.             SkyColor.b:= t
  556.             end;
  557.         SetSkyColor(SkyColor.r / 255, SkyColor.g / 255, SkyColor.b / 255);
  558.         SDSkyColor.r:= SkyColor.r;
  559.         SDSkyColor.g:= SkyColor.g;
  560.         SDSkyColor.b:= SkyColor.b;
  561.         end
  562.     else if key = 'border' then
  563.         begin
  564.         i:= Pos(',', s);
  565.         c2.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  566.         Delete(s, 1, i);
  567.         i:= Pos(',', s);
  568.         c2.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  569.         Delete(s, 1, i);
  570.         c2.b:= StrToInt(Trim(s));
  571.         if GrayScale then
  572.             begin
  573.             t:= round(SkyColor.r * RGB_LUMINANCE_RED + SkyColor.g * RGB_LUMINANCE_GREEN + SkyColor.b * RGB_LUMINANCE_BLUE);
  574.             if t > 255 then
  575.                 t:= 255;
  576.             c2.r:= t;
  577.             c2.g:= t;
  578.             c2.b:= t
  579.             end;
  580.         ExplosionBorderColorR:= c2.r;
  581.         ExplosionBorderColorG:= c2.g;
  582.         ExplosionBorderColorB:= c2.b;
  583.         ExplosionBorderColorNoA:=
  584.             (c2.r shl RShift) or (c2.g shl GShift) or (c2.b shl BShift);
  585.         ExplosionBorderColor:= ExplosionBorderColorNoA or AMask;
  586.         end
  587.     else if key = 'water-top' then
  588.         begin
  589.         i:= Pos(',', s);
  590.         WaterColorArray[1].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  591.         Delete(s, 1, i);
  592.         i:= Pos(',', s);
  593.         WaterColorArray[1].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  594.         Delete(s, 1, i);
  595.         WaterColorArray[1].b:= StrToInt(Trim(s));
  596.         WaterColorArray[1].a := 255;
  597.         if GrayScale then
  598.             begin
  599.             t:= round(WaterColorArray[0].r * RGB_LUMINANCE_RED + WaterColorArray[0].g * RGB_LUMINANCE_GREEN + WaterColorArray[0].b * RGB_LUMINANCE_BLUE);
  600.             if t > 255 then
  601.                 t:= 255;
  602.             WaterColorArray[1].r:= t;
  603.             WaterColorArray[1].g:= t;
  604.             WaterColorArray[1].b:= t
  605.             end;
  606.         WaterColorArray[3]:= WaterColorArray[1];
  607.         WaterColorArray[5]:= WaterColorArray[1];
  608.         WaterColorArray[7]:= WaterColorArray[1];
  609.         end
  610.     else if key = 'water-bottom' then
  611.         begin
  612.         i:= Pos(',', s);
  613.         WaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  614.         Delete(s, 1, i);
  615.         i:= Pos(',', s);
  616.         WaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  617.         Delete(s, 1, i);
  618.         WaterColorArray[0].b:= StrToInt(Trim(s));
  619.         WaterColorArray[0].a := 255;
  620.         if GrayScale then
  621.             begin
  622.             t:= round(WaterColorArray[2].r * RGB_LUMINANCE_RED + WaterColorArray[2].g * RGB_LUMINANCE_GREEN + WaterColorArray[2].b * RGB_LUMINANCE_BLUE);
  623.             if t > 255 then
  624.                 t:= 255;
  625.             WaterColorArray[0].r:= t;
  626.             WaterColorArray[0].g:= t;
  627.             WaterColorArray[0].b:= t
  628.             end;
  629.         WaterColorArray[2]:= WaterColorArray[0];
  630.         WaterColorArray[4]:= WaterColorArray[0];
  631.         WaterColorArray[6]:= WaterColorArray[0];
  632.         end
  633.     else if key = 'water-opacity' then
  634.         begin
  635.         WaterOpacity:= StrToInt(Trim(s));
  636.         SDWaterOpacity:= WaterOpacity
  637.         end
  638.     else if key = 'music' then
  639.         MusicFN:= Trim(s)
  640.     else if key = 'sd-music' then
  641.         SDMusicFN:= Trim(s)
  642.     else if key = 'clouds' then
  643.         begin
  644.         cCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096;
  645.         cSDCloudsNumber:= cCloudsNumber
  646.         end
  647.     else if key = 'object' then
  648.         begin
  649.         inc(ThemeObjects.Count);
  650.         with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
  651.             begin
  652.             i:= Pos(',', s);
  653.             Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifTransparent or ifIgnoreCaps or ifCritical);
  654.             Width:= Surf^.w;
  655.             Height:= Surf^.h;
  656.             Mask:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i)))+'_mask', ifTransparent or ifIgnoreCaps);
  657.             Delete(s, 1, i);
  658.             i:= Pos(',', s);
  659.             Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  660.             Delete(s, 1, i);
  661.             if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
  662.                 OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
  663.            
  664.             rectcnt2 := 0;
  665.             for j := 1 to Length(S) do
  666.               if S[i] = ',' then
  667.                 inc(rectcnt2);
  668.        
  669.             if rectcnt2 mod 2 = 0 then
  670.               rectcnt2 := 1
  671.             else begin
  672.               i:= Pos(',', s);
  673.               rectcnt2:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  674.               Delete(s, 1, i);
  675.             end;
  676.            
  677.             for ii:= 1 to rectcnt2 do
  678.                     with inland[ii] do
  679.                         begin
  680.                         i:= Pos(',', s);
  681.                         x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  682.                         Delete(s, 1, i);
  683.                         i:= Pos(',', s);
  684.                         y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  685.                         Delete(s, 1, i);
  686.                         i:= Pos(',', s);
  687.                         w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  688.                         Delete(s, 1, i);
  689.                         i:= Pos(',', s);
  690.                         h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  691.                         Delete(s, 1, i);
  692.                         CheckRect(Width, Height, x, y, w, h)
  693.                         end;
  694.                
  695.             i:= Pos(',', s);
  696.             rectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  697.             Delete(s, 1, i);
  698.                
  699.             for ii:= 1 to rectcnt do
  700.                 with outland[ii] do
  701.                     begin
  702.                     i:= Pos(',', s);
  703.                     x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  704.                     Delete(s, 1, i);
  705.                     i:= Pos(',', s);
  706.                     y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  707.                     Delete(s, 1, i);
  708.                     i:= Pos(',', s);
  709.                     w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  710.                     Delete(s, 1, i);
  711.                     if ii = rectcnt then
  712.                         h:= StrToInt(Trim(s))
  713.                     else
  714.                         begin
  715.                         i:= Pos(',', s);
  716.                         h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  717.                         Delete(s, 1, i)
  718.                         end;
  719.                     CheckRect(Width, Height, x, y, w, h)
  720.                     end;
  721.             end;
  722.         end
  723.     else if key = 'spray' then
  724.         begin
  725.         inc(SprayObjects.Count);
  726.         with SprayObjects.objs[Pred(SprayObjects.Count)] do
  727.             begin
  728.             i:= Pos(',', s);
  729.             Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifTransparent or ifIgnoreCaps);
  730.             Width:= Surf^.w;
  731.             Height:= Surf^.h;
  732.             Delete(s, 1, i);
  733.             Maxcnt:= StrToInt(Trim(s));
  734.             end;
  735.         end
  736.     else if key = 'flakes' then
  737.         begin
  738.         i:= Pos(',', s);
  739.         vobCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  740.         Delete(s, 1, i);
  741.         if vobCount > 0 then
  742.             begin
  743.             i:= Pos(',', s);
  744.             vobFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  745.             Delete(s, 1, i);
  746.             i:= Pos(',', s);
  747.             vobFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  748.             Delete(s, 1, i);
  749.             i:= Pos(',', s);
  750.             vobVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  751.             Delete(s, 1, i);
  752.             vobFallSpeed:= StrToInt(Trim(s));
  753.             end;
  754.         end
  755.     else if key = 'flatten-flakes' then
  756.         cFlattenFlakes:= true
  757.     else if key = 'flatten-clouds' then
  758.         cFlattenClouds:= true
  759.     else if key = 'ice' then
  760.         cIce:= true
  761.     else if key = 'snow' then
  762.         cSnow:= true
  763.     else if key = 'sd-water-top' then
  764.         begin
  765.         i:= Pos(',', s);
  766.         SDWaterColorArray[1].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  767.         Delete(s, 1, i);
  768.         i:= Pos(',', s);
  769.         SDWaterColorArray[1].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  770.         Delete(s, 1, i);
  771.         SDWaterColorArray[1].b:= StrToInt(Trim(s));
  772.         SDWaterColorArray[1].a := 255;
  773.         if GrayScale then
  774.             begin
  775.             t:= round(SDWaterColorArray[0].r * RGB_LUMINANCE_RED + SDWaterColorArray[0].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[0].b * RGB_LUMINANCE_BLUE);
  776.             if t > 255 then
  777.                 t:= 255;
  778.             SDWaterColorArray[1].r:= t;
  779.             SDWaterColorArray[1].g:= t;
  780.             SDWaterColorArray[1].b:= t
  781.             end;
  782.         SDWaterColorArray[3]:= SDWaterColorArray[1];
  783.         SDWaterColorArray[5]:= SDWaterColorArray[1];
  784.         SDWaterColorArray[7]:= SDWaterColorArray[1];
  785.         end
  786.     else if key = 'sd-water-bottom' then
  787.         begin
  788.         i:= Pos(',', s);
  789.         SDWaterColorArray[0].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  790.         Delete(s, 1, i);
  791.         i:= Pos(',', s);
  792.         SDWaterColorArray[0].g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  793.         Delete(s, 1, i);
  794.         SDWaterColorArray[0].b:= StrToInt(Trim(s));
  795.         SDWaterColorArray[0].a := 255;
  796.         if GrayScale then
  797.             begin
  798.             t:= round(SDWaterColorArray[2].r * RGB_LUMINANCE_RED + SDWaterColorArray[2].g * RGB_LUMINANCE_GREEN + SDWaterColorArray[2].b * RGB_LUMINANCE_BLUE);
  799.             if t > 255 then
  800.                 t:= 255;
  801.             SDWaterColorArray[0].r:= t;
  802.             SDWaterColorArray[0].g:= t;
  803.             SDWaterColorArray[0].b:= t
  804.             end;
  805.         SDWaterColorArray[2]:= SDWaterColorArray[0];
  806.         SDWaterColorArray[4]:= SDWaterColorArray[0];
  807.         SDWaterColorArray[6]:= SDWaterColorArray[0];
  808.         end
  809.     else if key = 'sd-water-opacity' then
  810.         SDWaterOpacity:= StrToInt(Trim(s))
  811.     else if key = 'sd-clouds' then
  812.         cSDCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096
  813.     else if key = 'sd-flakes' then
  814.         begin
  815.         i:= Pos(',', s);
  816.         vobSDCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  817.         Delete(s, 1, i);
  818.         if vobSDCount > 0 then
  819.             begin
  820.             i:= Pos(',', s);
  821.             vobSDFramesCount:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  822.             Delete(s, 1, i);
  823.             i:= Pos(',', s);
  824.             vobSDFrameTicks:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  825.             Delete(s, 1, i);
  826.             i:= Pos(',', s);
  827.             vobSDVelocity:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  828.             Delete(s, 1, i);
  829.             vobSDFallSpeed:= StrToInt(Trim(s));
  830.             end;
  831.         end
  832.     else if key = 'rq-sky' then
  833.         begin
  834.         if ((cReducedQuality and rqNoBackground) <> 0) then
  835.             begin
  836.             i:= Pos(',', s);
  837.             RQSkyColor.r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  838.             Delete(s, 1, i);
  839.             i:= Pos(',', s);
  840.             RQSkyColor.g:= StrToInt(Trim(Copy(s, 1, Pred(i))));
  841.             Delete(s, 1, i);
  842.             RQSkyColor.b:= StrToInt(Trim(s));
  843.             if GrayScale then
  844.                 begin
  845.                 t:= round(RQSkyColor.r * RGB_LUMINANCE_RED + RQSkyColor.g * RGB_LUMINANCE_GREEN + RQSkyColor.b * RGB_LUMINANCE_BLUE);
  846.                 if t > 255 then
  847.                     t:= 255;
  848.                 RQSkyColor.r:= t;
  849.                 RQSkyColor.g:= t;
  850.                 RQSkyColor.b:= t
  851.                 end;
  852.             SetSkyColor(RQSkyColor.r / 255, RQSkyColor.g / 255, RQSkyColor.b / 255);
  853.             SDSkyColor.r:= RQSkyColor.r;
  854.             SDSkyColor.g:= RQSkyColor.g;
  855.             SDSkyColor.b:= RQSkyColor.b;
  856.             end
  857.         end
  858.     end;
  859.  
  860. pfsClose(f);
  861. AddProgress;
  862. end;
  863.  
  864. procedure AddThemeObjects(var ThemeObjects: TThemeObjects);
  865. var i, ii, t: LongInt;
  866.     b: boolean;
  867. begin
  868.     if ThemeObjects.Count = 0 then
  869.         exit;
  870.     WriteLnToConsole('Adding theme objects...');
  871.  
  872.     for i:=0 to ThemeObjects.Count do
  873.         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
  874.  
  875.     repeat
  876.         t := getrandom(ThemeObjects.Count);
  877.         b := false;
  878.         for i:=0 to ThemeObjects.Count do
  879.             begin
  880.             ii := (i+t) mod ThemeObjects.Count;
  881.  
  882.             if ThemeObjects.objs[ii].Maxcnt <> 0 then
  883.                 b := b or TryPut(ThemeObjects.objs[ii])
  884.             end;
  885.     until not b;
  886. end;
  887.  
  888. procedure AddSprayObjects(Surface: PSDL_Surface; var SprayObjects: TSprayObjects);
  889. var i, ii, t: LongInt;
  890.     b: boolean;
  891. begin
  892.     if SprayObjects.Count = 0 then
  893.         exit;
  894.     WriteLnToConsole('Adding spray objects...');
  895.  
  896.     for i:=0 to SprayObjects.Count do
  897.         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
  898.  
  899.     repeat
  900.         t := getrandom(SprayObjects.Count);
  901.         b := false;
  902.         for i:=0 to SprayObjects.Count do
  903.             begin
  904.             ii := (i+t) mod SprayObjects.Count;
  905.  
  906.             if SprayObjects.objs[ii].Maxcnt <> 0 then
  907.                 b := b or TryPut(SprayObjects.objs[ii], Surface)
  908.             end;
  909.     until not b;
  910. end;
  911.  
  912. procedure AddObjects();
  913. var girSurf: PSDL_Surface;
  914.     i, g: Longword;
  915. begin
  916. InitRects;
  917. if hasGirders then
  918.     begin
  919.     g:= max(playWidth div 8, 256);
  920.     i:= leftX + g;
  921.     girSurf:= nil;
  922.     repeat
  923.         AddGirder(i, girSurf);
  924.         i:=i + g;
  925.     until (i > rightX - g);
  926.     // free girder surface
  927.     if girSurf <> nil then
  928.         begin
  929.         SDL_FreeSurface(girSurf);
  930.         girSurf:= nil;
  931.         end;
  932.     end;
  933. if (GameFlags and gfDisableLandObjects) = 0 then
  934.     AddThemeObjects(ThemeObjects);
  935. AddProgress();
  936. FreeRects();
  937. end;
  938.  
  939. procedure AddOnLandObjects(Surface: PSDL_Surface);
  940. begin
  941. InitRects;
  942. //AddSprayObjects(Surface, SprayObjects, 12);
  943. AddSprayObjects(Surface, SprayObjects);
  944. FreeRects
  945. end;
  946.  
  947. procedure LoadThemeConfig;
  948. begin
  949.     ReadThemeInfo(ThemeObjects, SprayObjects)
  950. end;
  951.  
  952. procedure FreeLandObjects();
  953. var i: Longword;
  954. begin
  955.     for i:= 0 to Pred(MAXTHEMEOBJECTS) do
  956.     begin
  957.         if ThemeObjects.objs[i].Surf <> nil then
  958.             SDL_FreeSurface(ThemeObjects.objs[i].Surf);
  959.         if SprayObjects.objs[i].Surf <> nil then
  960.             SDL_FreeSurface(SprayObjects.objs[i].Surf);
  961.         ThemeObjects.objs[i].Surf:= nil;
  962.         SprayObjects.objs[i].Surf:= nil;
  963.     end;
  964. end;
  965.  
  966. end.
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement