hedgewars/uLandObjects.pas
branchios-develop
changeset 13418 ba39a1d396c0
parent 13406 40235ccf8d6d
child 13489 480ea997036b
equal deleted inserted replaced
13416:6e8b807bda4b 13418:ba39a1d396c0
    26 procedure FreeLandObjects();
    26 procedure FreeLandObjects();
    27 procedure LoadThemeConfig;
    27 procedure LoadThemeConfig;
    28 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    28 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
    29 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); 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);
    30 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
       
    31 procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
    31 procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
    32 procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
    32 procedure AddOnLandObjects(Surface: PSDL_Surface);
    33 procedure AddOnLandObjects(Surface: PSDL_Surface);
    33 procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
    34 procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
    34 
    35 
    35 implementation
    36 implementation
    40 const MaxRects = 512;
    41 const MaxRects = 512;
    41       MAXOBJECTRECTS = 16;
    42       MAXOBJECTRECTS = 16;
    42       MAXTHEMEOBJECTS = 32;
    43       MAXTHEMEOBJECTS = 32;
    43       cThemeCFGFilename = 'theme.cfg';
    44       cThemeCFGFilename = 'theme.cfg';
    44 
    45 
    45 type TRectsArray = array[0..MaxRects] of TSDL_Rect;
    46 type PLongWord = ^LongWord;
       
    47      TRectsArray = array[0..MaxRects] of TSDL_Rect;
    46      PRectArray = ^TRectsArray;
    48      PRectArray = ^TRectsArray;
       
    49      TThemeObjectOverlay = record
       
    50                            Position: TPoint;
       
    51                            Surf: PSDL_Surface;
       
    52                            Width, Height: LongWord;
       
    53                            end;
    47      TThemeObject = record
    54      TThemeObject = record
       
    55                      Name: ShortString;
    48                      Surf, Mask: PSDL_Surface;
    56                      Surf, Mask: PSDL_Surface;
    49                      inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
    57                      inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
    50                      outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
    58                      outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
    51                      inrectcnt: Longword;
    59                      anchors: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
    52                      outrectcnt: Longword;
    60                      overlays: array[0..Pred(MAXOBJECTRECTS)] of TThemeObjectOverlay;
       
    61                      inrectcnt: LongInt;
       
    62                      outrectcnt: LongInt;
       
    63                      anchorcnt: LongInt;
       
    64                      overlaycnt: LongInt;
    53                      Width, Height: Longword;
    65                      Width, Height: Longword;
    54                      Maxcnt: Longword;
    66                      Maxcnt: Longword;
    55                      end;
    67                      end;
    56      TThemeObjects = record
    68      TThemeObjects = record
    57                      Count: LongInt;
    69                      Count: LongInt;
   121 
   133 
   122 if Width = 0 then
   134 if Width = 0 then
   123     Width:= Image^.w;
   135     Width:= Image^.w;
   124 
   136 
   125 p:= Image^.pixels;
   137 p:= Image^.pixels;
       
   138 
   126 for y:= 0 to Pred(Image^.h) do
   139 for y:= 0 to Pred(Image^.h) do
   127     begin
   140     begin
   128     for x:= 0 to Pred(Width) do
   141     for x:= 0 to Pred(Width) do
   129         begin
   142         begin
   130         // map image pixels per line backwards if in flip mode
   143         // map image pixels per line backwards if in flip mode
   136         if (p^[px] and AMask) <> 0 then
   149         if (p^[px] and AMask) <> 0 then
   137             begin
   150             begin
   138             if (cReducedQuality and rqBlurryLand) = 0 then
   151             if (cReducedQuality and rqBlurryLand) = 0 then
   139                 begin
   152                 begin
   140                 if (LandPixels[cpY + y, cpX + x] = 0)
   153                 if (LandPixels[cpY + y, cpX + x] = 0)
   141                 or (((p^[px] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
   154                 or (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255) then
   142                     LandPixels[cpY + y, cpX + x]:= p^[px];
   155                     LandPixels[cpY + y, cpX + x]:= p^[px];
   143                 end
   156                 end
   144             else
   157             else
   145                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
   158                 if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
   146                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[px];
   159                     LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[px];
   147 
   160 
   148             if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[px] and AMask) <> 0) then
   161             if Land[cpY + y, cpX + x] <= lfAllObjMask then
   149                 Land[cpY + y, cpX + x]:= lfObject or LandFlags
   162                 Land[cpY + y, cpX + x]:= lfObject or LandFlags
       
   163             end;
       
   164         end;
       
   165     p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
       
   166     end;
       
   167 
       
   168 if SDL_MustLock(Image) then
       
   169     SDL_UnlockSurface(Image);
       
   170 WriteLnToConsole(msgOK)
       
   171 end;
       
   172 
       
   173 function LerpByte(src, dst: Byte; l: LongWord): LongWord; inline;
       
   174 begin
       
   175     LerpByte:= ((255 - l) * src + l * dst) div 255;
       
   176 end;
       
   177 
       
   178 procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
       
   179 var p: PLongwordArray;
       
   180     pLandColor: PLongWord;
       
   181     x, y, alpha, color, landColor: LongWord;
       
   182 begin
       
   183 WriteToConsole('Generating overlay collision info... ');
       
   184 
       
   185 if SDL_MustLock(Image) then
       
   186     if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
       
   187 
       
   188 if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object overlay should be 32bit', true)
       
   189    and SDL_MustLock(Image) then
       
   190     SDL_UnlockSurface(Image);
       
   191 
       
   192 p:= Image^.pixels;
       
   193 
       
   194 for y:= 0 to Pred(Image^.h) do
       
   195     begin
       
   196     for x:= 0 to Pred(Image^.w) do
       
   197         begin
       
   198         color:= p^[x];
       
   199         if (color and AMask) <> 0 then
       
   200             begin
       
   201             if (cReducedQuality and rqBlurryLand) = 0 then
       
   202                 pLandColor:= @LandPixels[cpY + y, cpX + x]
       
   203             else
       
   204                 pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
       
   205 
       
   206             alpha:= (color and AMask) shr AShift;
       
   207             if (alpha <> $FF) and (pLandColor^ <> 0) then
       
   208                 begin
       
   209                 landColor:= pLandColor^;
       
   210                 color:=
       
   211                     (LerpByte((landColor and RMask) shr RShift, (color and RMask) shr RShift, alpha) shl RShift)
       
   212                  or (LerpByte((landColor and GMask) shr GShift, (color and GMask) shr GShift, alpha) shl GShift)
       
   213                  or (LerpByte((landColor and BMask) shr BShift, (color and BMask) shr BShift, alpha) shl BShift)
       
   214                  or (LerpByte(alpha, 255, (landColor and AMask) shr AShift) shl AShift)
       
   215                 end;
       
   216             pLandColor^:= color;
       
   217 
       
   218             if Land[cpY + y, cpX + x] <= lfAllObjMask then
       
   219                 Land[cpY + y, cpX + x]:= lfObject
   150             end;
   220             end;
   151         end;
   221         end;
   152     p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
   222     p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
   153     end;
   223     end;
   154 
   224 
   251         if Land[i, x] <> 0 then
   321         if Land[i, x] <> 0 then
   252             inc(lRes);
   322             inc(lRes);
   253     CountNonZeroz:= lRes;
   323     CountNonZeroz:= lRes;
   254 end;
   324 end;
   255 
   325 
       
   326 procedure ChecksumLandObjectImage(Image: PSDL_Surface);
       
   327 var y: LongInt;
       
   328 begin
       
   329     if Image = nil then exit;
       
   330 
       
   331     if SDL_MustLock(Image) then
       
   332         SDL_LockSurface(Image);
       
   333 
       
   334     if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object image should be 32bit', true) then
       
   335     begin
       
   336         if SDL_MustLock(Image) then
       
   337             SDL_UnlockSurface(Image);
       
   338         exit
       
   339     end;
       
   340 
       
   341     for y := 0 to Image^.h-1 do
       
   342         syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(Image^.pixels)^[y*Image^.pitch], Image^.w*4);
       
   343 
       
   344     if SDL_MustLock(Image) then
       
   345         SDL_UnlockSurface(Image);
       
   346 end;
       
   347 
   256 function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;
   348 function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;
   257 var x1, x2, y, k, i, girderHeight: LongInt;
   349 var x1, x2, y, k, i, girderHeight: LongInt;
   258     rr: TSDL_Rect;
   350     rr: TSDL_Rect;
   259     bRes: boolean;
   351     bRes: boolean;
   260 begin
   352 begin
   261 if girSurf = nil then
   353 if girSurf = nil then
   262     girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifColorKey or ifIgnoreCaps);
   354     girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifColorKey or ifIgnoreCaps);
   263 
   355 
   264 for y := 0 to girsurf^.h-1 do
   356 ChecksumLandObjectImage(girsurf);
   265     syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(girsurf^.pixels)^[y*girsurf^.pitch], girsurf^.w*4);
       
   266 
   357 
   267 girderHeight:= girSurf^.h;
   358 girderHeight:= girSurf^.h;
   268 
   359 
   269 y:= topY+150;
   360 y:= topY+150;
   270 repeat
   361 repeat
   353     end;
   444     end;
   354 {$WARNINGS ON}
   445 {$WARNINGS ON}
   355 CheckLand:= bRes;
   446 CheckLand:= bRes;
   356 end;
   447 end;
   357 
   448 
       
   449 function CheckLandAny(rect: TSDL_Rect; dX, dY, LandType: Longword): boolean;
       
   450 var tmpx, tmpy, bx, by: LongInt;
       
   451 begin
       
   452     inc(rect.x, dX);
       
   453     inc(rect.y, dY);
       
   454     bx:= rect.x + rect.w - 1;
       
   455     by:= rect.y + rect.h - 1;
       
   456     CheckLandAny:= false;
       
   457 
       
   458     if (((rect.x and LAND_WIDTH_MASK) or (bx and LAND_WIDTH_MASK) or
       
   459          (rect.y and LAND_HEIGHT_MASK) or (by and LAND_HEIGHT_MASK)) = 0) then
       
   460     begin
       
   461         for tmpx := rect.x to bx do
       
   462         begin
       
   463             if (((Land[rect.y, tmpx] and LandType) or (Land[by, tmpx] and LandType)) <> 0) then
       
   464             begin
       
   465                 CheckLandAny := true;
       
   466                 exit;
       
   467             end
       
   468         end;
       
   469         for tmpy := rect.y to by do
       
   470         begin
       
   471             if (((Land[tmpy, rect.x] and LandType) or (Land[tmpy, bx] and LandType)) <> 0) then
       
   472             begin
       
   473                 CheckLandAny := true;
       
   474                 exit;
       
   475             end
       
   476         end;
       
   477     end;
       
   478 end;
       
   479 
   358 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
   480 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
   359 var i: Longword;
   481 var i: Longword;
   360     bRes: boolean;
   482     bRes, anchored: boolean;
       
   483     overlayP1, overlayP2: TPoint;
   361 begin
   484 begin
   362     with Obj do begin
   485     with Obj do begin
   363         bRes:= true;
   486         bRes:= true;
   364         i:= 1;
   487         i:= 0;
   365         while bRes and (i <= inrectcnt) do
   488         while bRes and (i < overlaycnt) do
       
   489             begin
       
   490             overlayP1.x:= overlays[i].Position.x + x;
       
   491             overlayP1.y:= overlays[i].Position.y + y;
       
   492             overlayP2.x:= overlayP1.x + overlays[i].Width - 1;
       
   493             overlayP2.y:= overlayP1.y + overlays[i].Height - 1;
       
   494             bRes:= (((LAND_WIDTH_MASK and overlayP1.x) or (LAND_HEIGHT_MASK and overlayP1.y) or
       
   495                      (LAND_WIDTH_MASK and overlayP2.x) or (LAND_HEIGHT_MASK and overlayP2.y)) = 0)
       
   496                    and (not CheckIntersect(overlayP1.x, overlayP1.y, overlays[i].Width, overlays[i].Height));
       
   497             inc(i)
       
   498             end;
       
   499 
       
   500         i:= 0;
       
   501         while bRes and (i < inrectcnt) do
   366             begin
   502             begin
   367             bRes:= CheckLand(inland[i], x, y, lfBasic);
   503             bRes:= CheckLand(inland[i], x, y, lfBasic);
   368             inc(i)
   504             inc(i)
   369             end;
   505             end;
   370 
   506 
   371         i:= 1;
   507         i:= 0;
   372         while bRes and (i <= outrectcnt) do
   508         while bRes and (i < outrectcnt) do
   373             begin
   509             begin
   374             bRes:= CheckLand(outland[i], x, y, 0);
   510             bRes:= CheckLand(outland[i], x, y, 0);
   375             inc(i)
   511             inc(i)
       
   512             end;
       
   513 
       
   514         if bRes then
       
   515             begin
       
   516             anchored:= anchorcnt = 0;
       
   517             for i:= 1 to anchorcnt do
       
   518                 begin
       
   519                     anchored := CheckLandAny(anchors[i], x, y, lfLandMask);
       
   520                     if anchored then break;
       
   521                 end;
       
   522             bRes:= anchored;
   376             end;
   523             end;
   377 
   524 
   378         if bRes then
   525         if bRes then
   379             bRes:= not CheckIntersect(x, y, Width, Height);
   526             bRes:= not CheckIntersect(x, y, Width, Height);
   380 
   527 
   384 
   531 
   385 function TryPut(var Obj: TThemeObject): boolean;
   532 function TryPut(var Obj: TThemeObject): boolean;
   386 const MaxPointsIndex = 2047;
   533 const MaxPointsIndex = 2047;
   387 var x, y: Longword;
   534 var x, y: Longword;
   388     ar: array[0..MaxPointsIndex] of TPoint;
   535     ar: array[0..MaxPointsIndex] of TPoint;
   389     cnt, i: Longword;
   536     cnt, i, ii: Longword;
   390     bRes: boolean;
   537     bRes: boolean;
   391 begin
   538 begin
   392 TryPut:= false;
   539 TryPut:= false;
   393 cnt:= 0;
   540 cnt:= 0;
   394 with Obj do
   541 with Obj do
   398     x:= 0;
   545     x:= 0;
   399     repeat
   546     repeat
   400         y:= topY+32; // leave room for a hedgie to teleport in
   547         y:= topY+32; // leave room for a hedgie to teleport in
   401         repeat
   548         repeat
   402 
   549 
   403             if (inland[1].x = 0) and (inland[1].y = 0) and (inland[1].w = 0) and (inland[1].h = 0) then
   550             if (inrectcnt > 0) and (inland[0].x = 0) and (inland[0].y = 0) and (inland[0].w = 0) and (inland[0].h = 0) then
   404                 y := LAND_HEIGHT - Height;
   551                 y := LAND_HEIGHT - Height;
   405 
   552 
   406             if CheckCanPlace(x, y, Obj) then
   553             if CheckCanPlace(x, y, Obj) then
   407                 begin
   554                 begin
   408                 ar[cnt].x:= x;
   555                 ar[cnt].x:= x;
   424         i:= getrandom(cnt);
   571         i:= getrandom(cnt);
   425         if Obj.Mask <> nil then
   572         if Obj.Mask <> nil then
   426              BlitImageUsingMask(ar[i].x, ar[i].y, Obj.Surf, Obj.Mask)
   573              BlitImageUsingMask(ar[i].x, ar[i].y, Obj.Surf, Obj.Mask)
   427         else BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
   574         else BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
   428         AddRect(ar[i].x, ar[i].y, Width, Height);
   575         AddRect(ar[i].x, ar[i].y, Width, Height);
       
   576 
       
   577         ii:= 0;
       
   578         while ii < overlaycnt do
       
   579             begin
       
   580             BlitOverlayAndGenerateCollisionInfo(
       
   581                 ar[i].x + overlays[ii].Position.X,
       
   582                 ar[i].y + overlays[ii].Position.Y, overlays[ii].Surf);
       
   583             AddRect(ar[i].x + overlays[ii].Position.X,
       
   584                     ar[i].y + overlays[ii].Position.Y,
       
   585                     Width, Height);
       
   586             inc(ii);
       
   587             end;
   429         dec(Maxcnt)
   588         dec(Maxcnt)
   430         end
   589         end
   431     else Maxcnt:= 0
   590     else Maxcnt:= 0
   432     end;
   591     end;
   433 TryPut:= bRes;
   592 TryPut:= bRes;
   491         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   650         OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
   492     if (y + h > Height) then
   651     if (y + h > Height) then
   493         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   652         OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
   494 end;
   653 end;
   495 
   654 
       
   655 procedure ReadRect(var rect: TSDL_Rect; var s: ShortString);
       
   656 var i: LongInt;
       
   657 begin
       
   658 with rect do
       
   659     begin
       
   660     i:= Pos(',', s);
       
   661     x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   662     Delete(s, 1, i);
       
   663     i:= Pos(',', s);
       
   664     y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   665     Delete(s, 1, i);
       
   666     i:= Pos(',', s);
       
   667     w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   668     Delete(s, 1, i);
       
   669     i:= Pos(',', s);
       
   670     if i = 0 then i:= Succ(Length(S));
       
   671     h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   672     Delete(s, 1, i);
       
   673     end;
       
   674 end;
       
   675 
       
   676 
       
   677 
       
   678 procedure ReadOverlay(var overlay: TThemeObjectOverlay; var s: ShortString);
       
   679 var i: LongInt;
       
   680 begin
       
   681 with overlay do
       
   682     begin
       
   683     i:= Pos(',', s);
       
   684     Position.X:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   685     Delete(s, 1, i);
       
   686     i:= Pos(',', s);
       
   687     Position.Y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   688     Delete(s, 1, i);
       
   689     i:= Pos(',', s);
       
   690     if i = 0 then i:= Succ(Length(S));
       
   691     Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifColorKey or ifIgnoreCaps or ifCritical);
       
   692     Width:= Surf^.w;
       
   693     Height:= Surf^.h;
       
   694     Delete(s, 1, i);
       
   695     ChecksumLandObjectImage(Surf);
       
   696     end;
       
   697 end;
       
   698 
   496 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   699 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
   497 var s, key: shortstring;
   700 var s, key, nameRef: shortstring;
   498     f: PFSFile;
   701     f: PFSFile;
   499     i, y: LongInt;
   702     i: LongInt;
   500     ii, t: Longword;
   703     ii, t: Longword;
   501     c2: TSDL_Color;
   704     c2: TSDL_Color;
   502 begin
   705 begin
   503 
   706 
   504 AddProgress;
   707 AddProgress;
   670         end
   873         end
   671     else if key = 'music' then
   874     else if key = 'music' then
   672         MusicFN:= Trim(s)
   875         MusicFN:= Trim(s)
   673     else if key = 'sd-music' then
   876     else if key = 'sd-music' then
   674         SDMusicFN:= Trim(s)
   877         SDMusicFN:= Trim(s)
       
   878     else if key = 'fallback-music' then
       
   879         FallbackMusicFN:= Trim(s)
       
   880     else if key = 'fallback-sd-music' then
       
   881         FallbackSDMusicFN:= Trim(s)
   675     else if key = 'clouds' then
   882     else if key = 'clouds' then
   676         begin
   883         begin
   677         cCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096;
   884         cCloudsNumber:= Word(StrToInt(Trim(s))) * cScreenSpace div 4096;
   678         cSDCloudsNumber:= cCloudsNumber
   885         cSDCloudsNumber:= cCloudsNumber
   679         end
   886         end
   681         begin
   888         begin
   682         inc(ThemeObjects.Count);
   889         inc(ThemeObjects.Count);
   683         with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
   890         with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
   684             begin
   891             begin
   685             i:= Pos(',', s);
   892             i:= Pos(',', s);
   686             Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifColorKey or ifIgnoreCaps or ifCritical);
   893             Name:= Trim(Copy(s, 1, Pred(i)));
       
   894             Surf:= LoadDataImage(ptCurrTheme, Name, ifColorKey or ifIgnoreCaps or ifCritical);
   687             Width:= Surf^.w;
   895             Width:= Surf^.w;
   688             Height:= Surf^.h;
   896             Height:= Surf^.h;
   689             Mask:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i)))+'_mask', ifColorKey or ifIgnoreCaps);
   897             Mask:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i)))+'_mask', ifColorKey or ifIgnoreCaps);
   690             Delete(s, 1, i);
   898             Delete(s, 1, i);
   691             i:= Pos(',', s);
   899             i:= Pos(',', s);
   692             Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   900             Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   693             Delete(s, 1, i);
   901             Delete(s, 1, i);
   694             if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
   902             if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
   695                 OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
   903                 OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
   696             for y := 0 to Surf^.h-1 do
   904             ChecksumLandObjectImage(Surf);
   697                 syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(Surf^.pixels)^[y*Surf^.pitch], Surf^.w*4);
   905             ChecksumLandObjectImage(Mask);
   698 
   906 
   699             inrectcnt := 0;
   907             inrectcnt := 0;
   700 
   908 
   701             for ii := 1 to Length(S) do
   909             for ii := 1 to Length(S) do
   702               if S[ii] = ',' then
   910               if S[ii] = ',' then
   708               i:= Pos(',', s);
   916               i:= Pos(',', s);
   709               inrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   917               inrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   710               Delete(s, 1, i);
   918               Delete(s, 1, i);
   711             end;
   919             end;
   712 
   920 
   713             for ii:= 1 to inrectcnt do
   921             if inrectcnt > MAXOBJECTRECTS then
   714                 with inland[ii] do
   922                 OutError('Object''s inland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(inrectcnt) +').', true);
   715                     begin
   923 
   716                     i:= Pos(',', s);
   924             for ii:= 0 to Pred(inrectcnt) do
   717                     x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   925                 ReadRect(inland[ii], s);
   718                     Delete(s, 1, i);
       
   719                     i:= Pos(',', s);
       
   720                     y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   721                     Delete(s, 1, i);
       
   722                     i:= Pos(',', s);
       
   723                     w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   724                     Delete(s, 1, i);
       
   725                     i:= Pos(',', s);
       
   726                     h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   727                     Delete(s, 1, i);
       
   728                     CheckRect(Width, Height, x, y, w, h)
       
   729                     end;
       
   730 
   926 
   731             i:= Pos(',', s);
   927             i:= Pos(',', s);
   732             outrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   928             outrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   733             Delete(s, 1, i);
   929             Delete(s, 1, i);
   734             for ii:= 1 to outrectcnt do
   930 
   735                 with outland[ii] do
   931             if outrectcnt > MAXOBJECTRECTS then
   736                     begin
   932                 OutError('Object''s outland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(outrectcnt) +').', true);
   737                     i:= Pos(',', s);
   933 
   738                     x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   934             for ii:= 0 to Pred(outrectcnt) do
   739                     Delete(s, 1, i);
   935                 ReadRect(outland[ii], s);
   740                     i:= Pos(',', s);
   936             end;
   741                     y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   937         end
   742                     Delete(s, 1, i);
   938     else if key = 'anchors' then
   743                     i:= Pos(',', s);
   939         begin
   744                     w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   940         i:= Pos(',', s);
   745                     Delete(s, 1, i);
   941         nameRef:= Trim(Copy(s, 1, Pred(i)));
   746                     if ii = outrectcnt then
   942         for ii:= 0 to Pred(ThemeObjects.Count) do
   747                         h:= StrToInt(Trim(s))
   943             if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
   748                     else
   944                 begin
   749                         begin
   945                 if anchorcnt <> 0 then
   750                         i:= Pos(',', s);
   946                     OutError('Duplicate anchors declaration for ' + nameRef, true);
   751                         h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   947                 Delete(s, 1, i);
   752                         Delete(s, 1, i)
   948                 i:= Pos(',', s);
   753                         end;
   949                 anchorcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
   754                     CheckRect(Width, Height, x, y, w, h)
   950                 Delete(s, 1, i);
   755                     end;
   951                 if anchorcnt > MAXOBJECTRECTS then
   756 
   952                     OutError('Object''s anchor rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(anchorcnt) +').', true);
       
   953                 for t:= 0 to Pred(anchorcnt) do
       
   954                     ReadRect(anchors[t], s);
       
   955                 break
       
   956                 end;
       
   957         end
       
   958     else if key = 'overlays' then
       
   959         begin
       
   960         i:= Pos(',', s);
       
   961         nameRef:= Trim(Copy(s, 1, Pred(i)));
       
   962         for ii:= 0 to Pred(ThemeObjects.Count) do
       
   963             if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
       
   964             begin
       
   965                 if overlaycnt <> 0 then
       
   966                     OutError('Duplicate overlays declaration for ' + nameRef, true);
       
   967                 Delete(s, 1, i);
       
   968                 i:= Pos(',', s);
       
   969                 overlaycnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
       
   970                 Delete(s, 1, i);
       
   971                 if overlaycnt > MAXOBJECTRECTS then
       
   972                     OutError('Object''s overlay count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(overlaycnt) +').', true);
       
   973                 for t:= 0 to Pred(overlaycnt) do
       
   974                     ReadOverlay(overlays[t], s);
       
   975                 break
   757             end;
   976             end;
   758         end
   977         end
   759     else if key = 'spray' then
   978     else if key = 'spray' then
   760         begin
   979         begin
   761         inc(SprayObjects.Count);
   980         inc(SprayObjects.Count);
  1003 begin
  1222 begin
  1004     ReadThemeInfo(ThemeObjects, SprayObjects)
  1223     ReadThemeInfo(ThemeObjects, SprayObjects)
  1005 end;
  1224 end;
  1006 
  1225 
  1007 procedure FreeLandObjects();
  1226 procedure FreeLandObjects();
  1008 var i: Longword;
  1227 var i, ii: Longword;
  1009 begin
  1228 begin
  1010     for i:= 0 to Pred(MAXTHEMEOBJECTS) do
  1229     for i:= 0 to Pred(MAXTHEMEOBJECTS) do
  1011     begin
  1230     begin
  1012         if ThemeObjects.objs[i].Surf <> nil then
  1231         if ThemeObjects.objs[i].Surf <> nil then
  1013             SDL_FreeSurface(ThemeObjects.objs[i].Surf);
  1232             SDL_FreeSurface(ThemeObjects.objs[i].Surf);
  1014         if SprayObjects.objs[i].Surf <> nil then
  1233         if SprayObjects.objs[i].Surf <> nil then
  1015             SDL_FreeSurface(SprayObjects.objs[i].Surf);
  1234             SDL_FreeSurface(SprayObjects.objs[i].Surf);
  1016         ThemeObjects.objs[i].Surf:= nil;
  1235         ThemeObjects.objs[i].Surf:= nil;
  1017         SprayObjects.objs[i].Surf:= nil;
  1236         SprayObjects.objs[i].Surf:= nil;
       
  1237 
       
  1238         ii:= 0;
       
  1239         while ii < ThemeObjects.objs[i].overlaycnt do
       
  1240             begin
       
  1241             if ThemeObjects.objs[i].overlays[ii].Surf <> nil then
       
  1242                 begin
       
  1243                     SDL_FreeSurface(ThemeObjects.objs[i].overlays[ii].Surf);
       
  1244                     ThemeObjects.objs[i].overlays[ii].Surf:= nil;
       
  1245                 end;
       
  1246             inc(ii);
       
  1247             end;
  1018     end;
  1248     end;
  1019 end;
  1249 end;
  1020 
  1250 
  1021 end.
  1251 end.