hedgewars: comparison hedgewars/uLandObjects.pas

equal deleted inserted replaced

-:0135e64c6c66
+:c4fd2813b127
 procedure FreeLandObjects();
 procedure LoadThemeConfig;
 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface); inline;
 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); inline;
 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
+procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
 procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
 procedure AddOnLandObjects(Surface: PSDL_Surface);
 procedure SetLand(var LandWord: Word; Pixel: LongWord); inline;
 implementation
 const MaxRects = 512;
 MAXOBJECTRECTS = 16;
 MAXTHEMEOBJECTS = 32;
 cThemeCFGFilename = 'theme.cfg';
-type TRectsArray = array[0..MaxRects] of TSDL_Rect;
+type PLongWord = ^LongWord;
+TRectsArray = array[0..MaxRects] of TSDL_Rect;
 PRectArray = ^TRectsArray;
+TThemeObjectOverlay = record
+Position: TPoint;
+Surf: PSDL_Surface;
+Width, Height: LongWord;
+end;
 TThemeObject = record
+Name: ShortString;
 Surf, Mask: PSDL_Surface;
 inland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
 outland: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
-inrectcnt: Longword;
+anchors: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
-outrectcnt: Longword;
+overlays: array[0..Pred(MAXOBJECTRECTS)] of TThemeObjectOverlay;
+inrectcnt: LongInt;
+outrectcnt: LongInt;
+anchorcnt: LongInt;
+overlaycnt: LongInt;
 Width, Height: Longword;
 Maxcnt: Longword;
 end;
 TThemeObjects = record
 Count: LongInt;
 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word); inline;
 begin
 BlitImageAndGenerateCollisionInfo(cpX, cpY, Width, Image, LandFlags, false);
 end;
+function LerpByte(src, dst: Byte; l: LongWord): LongWord; inline;
+begin
+LerpByte:= ((255 - l) * src + l * dst) div 255;
+end;
 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY, Width: Longword; Image: PSDL_Surface; LandFlags: Word; Flip: boolean);
 var p: PLongwordArray;
-px, x, y: Longword;
+pLandColor: PLongWord;
+alpha, color, landColor, x, y: LongWord;
 bpp: LongInt;
 begin
 WriteToConsole('Generating collision info... ');
 if SDL_MustLock(Image) then
 if Width = 0 then
 Width:= Image^.w;
 p:= Image^.pixels;
 for y:= 0 to Pred(Image^.h) do
 begin
 for x:= 0 to Pred(Width) do
 begin
 // map image pixels per line backwards if in flip mode
 if Flip then
-px:= Pred(Image^.w) - x
+color:= p^[Pred(Image^.w) - x]
 else
-px:= x;
+color:= p^[x];
-if (p^[px] and AMask) <> 0 then
+if (cReducedQuality and rqBlurryLand) = 0 then
-begin
+pLandColor:= @LandPixels[cpY + y, cpX + x]
-if (cReducedQuality and rqBlurryLand) = 0 then
+else
-begin
+pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
-if (LandPixels[cpY + y, cpX + x] = 0)
-or (((p^[px] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
+landColor:= pLandColor^;
-LandPixels[cpY + y, cpX + x]:= p^[px];
+alpha:= (landColor and AMask) shr AShift;
-end
+if ((color and AMask) <> 0) and (alpha <> 255)  then
+begin
+if alpha = 0 then
+pLandColor^:= color
 else
-if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
+pLandColor^:=
-LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[px];
+(LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)
+or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)
-if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[px] and AMask) <> 0) then
+or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)
-Land[cpY + y, cpX + x]:= lfObject or LandFlags
+or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);
-end;
+end;
+if ((color and AMask) <> 0) and (Land[cpY + y, cpX + x] <= lfAllObjMask) then
+Land[cpY + y, cpX + x]:= lfObject or LandFlags
 end;
 p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
 end;
 if SDL_MustLock(Image) then
 SDL_UnlockSurface(Image);
 WriteLnToConsole(msgOK)
 end;
+procedure BlitOverlayAndGenerateCollisionInfo(cpX, cpY: Longword; Image: PSDL_Surface);
+var p: PLongwordArray;
+pLandColor: PLongWord;
+x, y, alpha, color, landColor: LongWord;
+begin
+WriteToConsole('Generating overlay collision info... ');
+if SDL_MustLock(Image) then
+if SDLCheck(SDL_LockSurface(Image) >= 0, 'SDL_LockSurface', true) then exit;
+if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object overlay should be 32bit', true)
+and SDL_MustLock(Image) then
+SDL_UnlockSurface(Image);
+p:= Image^.pixels;
+for y:= 0 to Pred(Image^.h) do
+begin
+for x:= 0 to Pred(Image^.w) do
+begin
+color:= p^[x];
+if (color and AMask) <> 0 then
+begin
+if (cReducedQuality and rqBlurryLand) = 0 then
+pLandColor:= @LandPixels[cpY + y, cpX + x]
+else
+pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
+alpha:= (color and AMask) shr AShift;
+if ((alpha <> $FF) and ((pLandColor^) <> 0)) then
+begin
+landColor:= pLandColor^;
+color:=
+(LerpByte((landColor and RMask) shr RShift, (color and RMask) shr RShift, alpha) shl RShift)
+or (LerpByte((landColor and GMask) shr GShift, (color and GMask) shr GShift, alpha) shl GShift)
+or (LerpByte((landColor and BMask) shr BShift, (color and BMask) shr BShift, alpha) shl BShift)
+or (LerpByte(alpha, 255, (landColor and AMask) shr AShift) shl AShift)
+end;
+pLandColor^:= color;
+if Land[cpY + y, cpX + x] <= lfAllObjMask then
+Land[cpY + y, cpX + x]:= lfObject
+end;
+end;
+p:= PLongwordArray(@(p^[Image^.pitch shr 2]))
+end;
+if SDL_MustLock(Image) then
+SDL_UnlockSurface(Image);
+WriteLnToConsole(msgOK)
+end;
 procedure BlitImageUsingMask(cpX, cpY: Longword;  Image, Mask: PSDL_Surface);
 var p, mp: PLongwordArray;
-x, y: Longword;
+pLandColor: PLongWord;
+alpha, color, landColor, x, y: Longword;
 bpp: LongInt;
 begin
 WriteToConsole('Generating collision info... ');
 if SDL_MustLock(Image) then
 mp:= Mask^.pixels;
 for y:= 0 to Pred(Image^.h) do
 begin
 for x:= 0 to Pred(Image^.w) do
 begin
+color:= p^[x];
 if (cReducedQuality and rqBlurryLand) = 0 then
-begin
+pLandColor:= @LandPixels[cpY + y, cpX + x]
-if (LandPixels[cpY + y, cpX + x] = 0)
-or (((p^[x] and AMask) <> 0) and (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255)) then
-LandPixels[cpY + y, cpX + x]:= p^[x];
-end
 else
-if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
+pLandColor:= @LandPixels[(cpY + y) div 2, (cpX + x) div 2];
-LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[x];
+landColor:= pLandColor^;
+alpha:= (landColor and AMask) shr AShift;
+if ((color and AMask) <> 0) and (alpha <> 255)  then
+begin
+if alpha = 0 then
+pLandColor^:= color
+else
+pLandColor^:=
+(LerpByte((color and RMask) shr RShift, (landColor and RMask) shr RShift, alpha) shl RShift)
+or (LerpByte((color and GMask) shr GShift, (landColor and GMask) shr GShift, alpha) shl GShift)
+or (LerpByte((color and BMask) shr BShift, (landColor and BMask) shr BShift, alpha) shl BShift)
+or (LerpByte(alpha, 255, (color and AMask) shr AShift) shl AShift);
+end;
 if (Land[cpY + y, cpX + x] <= lfAllObjMask) or (Land[cpY + y, cpX + x] and lfObject <> 0)  then
 SetLand(Land[cpY + y, cpX + x], mp^[x]);
 end;
 p:= PLongwordArray(@(p^[Image^.pitch shr 2]));
 mp:= PLongwordArray(@(mp^[Mask^.pitch shr 2]))
 end;
 if SDL_MustLock(Image) then
 if Land[i, x] <> 0 then
 inc(lRes);
 CountNonZeroz:= lRes;
 end;
+procedure ChecksumLandObjectImage(Image: PSDL_Surface);
+var y: LongInt;
+begin
+if Image = nil then exit;
+if SDL_MustLock(Image) then
+SDL_LockSurface(Image);
+if checkFails(Image^.format^.BytesPerPixel = 4, 'Land object image should be 32bit', true) then
+begin
+if SDL_MustLock(Image) then
+SDL_UnlockSurface(Image);
+exit
+end;
+for y := 0 to Image^.h-1 do
+syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(Image^.pixels)^[y*Image^.pitch], Image^.w*4);
+if SDL_MustLock(Image) then
+SDL_UnlockSurface(Image);
+end;
 function AddGirder(gX: LongInt; var girSurf: PSDL_Surface): boolean;
 var x1, x2, y, k, i, girderHeight: LongInt;
 rr: TSDL_Rect;
 bRes: boolean;
 begin
 if girSurf = nil then
 girSurf:= LoadDataImageAltPath(ptCurrTheme, ptGraphics, 'Girder', ifCritical or ifColorKey or ifIgnoreCaps);
-for y := 0 to girsurf^.h-1 do
+ChecksumLandObjectImage(girsurf);
-syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(girsurf^.pixels)^[y*girsurf^.pitch], girsurf^.w*4);
 girderHeight:= girSurf^.h;
 y:= topY+150;
 repeat
 inc(y, 24);
 x1:= gX;
 x2:= gX;
-while (x1 > Longint(leftX)+150) and (CountNonZeroz(x1, y, girderHeight) = 0) do
+while (x1 > leftX+150) and (CountNonZeroz(x1, y, girderHeight) = 0) do
 dec(x1, 2);
 i:= x1 - 12;
 repeat
 k:= CountNonZeroz(x1, y, girderHeight);
 dec(x1, 2)
-until (x1 < Longint(leftX) + 100) or (k = 0) or (k = girderHeight) or (x1 < i);
+until (x1 < leftX + 100) or (k = 0) or (k = girderHeight) or (x1 < i);
 inc(x1, 2);
 if k = girderHeight then
 begin
-while (x2 < (LongInt(rightX) - 100)) and (CountNonZeroz(x2, y, girderHeight) = 0) do
+while (x2 < (rightX - 100)) and (CountNonZeroz(x2, y, girderHeight) = 0) do
 inc(x2, 2);
 i:= x2 + 12;
 repeat
 inc(x2, 2);
 k:= CountNonZeroz(x2, y, girderHeight)
-until (x2 >= (LongInt(rightX)-150)) or (k = 0) or (k = girderHeight) or (x2 > i) or (x2 - x1 >= 900);
+until (x2 >= (rightX-150)) or (k = 0) or (k = girderHeight) or (x2 > i) or (x2 - x1 >= 900);
-if (x2 < (LongInt(rightX) - 100)) and (k = girderHeight) and (x2 - x1 > 200) and (x2 - x1 < 900)
+if (x2 < (rightX - 100)) and (k = girderHeight) and (x2 - x1 > 200) and (x2 - x1 < 900)
 and (not CheckIntersect(x1 - 32, y - 64, x2 - x1 + 64, 144)) then
 break;
 end;
 x1:= 0;
 until y > (LAND_HEIGHT-125);
 end;
 {$WARNINGS ON}
 CheckLand:= bRes;
 end;
+function CheckLandAny(rect: TSDL_Rect; dX, dY, LandType: Longword): boolean;
+var tmpx, tmpy, bx, by: LongInt;
+begin
+inc(rect.x, dX);
+inc(rect.y, dY);
+bx:= rect.x + rect.w - 1;
+by:= rect.y + rect.h - 1;
+CheckLandAny:= false;
+if (((rect.x and LAND_WIDTH_MASK) or (bx and LAND_WIDTH_MASK) or
+(rect.y and LAND_HEIGHT_MASK) or (by and LAND_HEIGHT_MASK)) = 0) then
+begin
+for tmpx := rect.x to bx do
+begin
+if (((Land[rect.y, tmpx] and LandType) or (Land[by, tmpx] and LandType)) <> 0) then
+begin
+CheckLandAny := true;
+exit;
+end
+end;
+for tmpy := rect.y to by do
+begin
+if (((Land[tmpy, rect.x] and LandType) or (Land[tmpy, bx] and LandType)) <> 0) then
+begin
+CheckLandAny := true;
+exit;
+end
+end;
+end;
+end;
 function CheckCanPlace(x, y: Longword; var Obj: TThemeObject): boolean;
 var i: Longword;
-bRes: boolean;
+bRes, anchored: boolean;
+overlayP1, overlayP2: TPoint;
 begin
 with Obj do begin
 bRes:= true;
-i:= 1;
+i:= 0;
-while bRes and (i <= inrectcnt) do
+while bRes and (i < overlaycnt) do
+begin
+overlayP1.x:= overlays[i].Position.x + x;
+overlayP1.y:= overlays[i].Position.y + y;
+overlayP2.x:= overlayP1.x + overlays[i].Width - 1;
+overlayP2.y:= overlayP1.y + overlays[i].Height - 1;
+bRes:= (((LAND_WIDTH_MASK and overlayP1.x) or (LAND_HEIGHT_MASK and overlayP1.y) or
+(LAND_WIDTH_MASK and overlayP2.x) or (LAND_HEIGHT_MASK and overlayP2.y)) = 0)
+and (not CheckIntersect(overlayP1.x, overlayP1.y, overlays[i].Width, overlays[i].Height));
+inc(i)
+end;
+i:= 0;
+while bRes and (i < inrectcnt) do
 begin
 bRes:= CheckLand(inland[i], x, y, lfBasic);
 inc(i)
 end;
-i:= 1;
+i:= 0;
-while bRes and (i <= outrectcnt) do
+while bRes and (i < outrectcnt) do
 begin
 bRes:= CheckLand(outland[i], x, y, 0);
 inc(i)
+end;
+if bRes then
+begin
+anchored:= anchorcnt = 0;
+i:= 0;
+while i < anchorcnt do
+begin
+anchored := CheckLandAny(anchors[i], x, y, lfLandMask);
+if anchored then break;
+inc(i);
+end;
+bRes:= anchored;
 end;
 if bRes then
 bRes:= not CheckIntersect(x, y, Width, Height);
 function TryPut(var Obj: TThemeObject): boolean;
 const MaxPointsIndex = 2047;
 var x, y: Longword;
 ar: array[0..MaxPointsIndex] of TPoint;
-cnt, i: Longword;
+cnt, i, ii: Longword;
 bRes: boolean;
 begin
 TryPut:= false;
 cnt:= 0;
 with Obj do
 begin
 if Maxcnt = 0 then
 exit;
-x:= 0;
+x:= leftX;
 repeat
 y:= topY+32; // leave room for a hedgie to teleport in
 repeat
-if (inland[1].x = 0) and (inland[1].y = 0) and (inland[1].w = 0) and (inland[1].h = 0) then
+if (inrectcnt > 0) and (inland[0].x = 0) and (inland[0].y = 0) and (inland[0].w = 0) and (inland[0].h = 0) then
 y := LAND_HEIGHT - Height;
 if CheckCanPlace(x, y, Obj) then
 begin
 ar[cnt].x:= x;
 else inc(cnt);
 end;
 inc(y, 3);
 until y >= LAND_HEIGHT - Height;
 inc(x, getrandom(6) + 3)
-until x >= LAND_WIDTH - Width;
+until x >= rightX - Width;
 bRes:= cnt <> 0;
 if bRes then
 begin
 i:= getrandom(cnt);
 if Obj.Mask <> nil then
 BlitImageUsingMask(ar[i].x, ar[i].y, Obj.Surf, Obj.Mask)
 else BlitImageAndGenerateCollisionInfo(ar[i].x, ar[i].y, 0, Obj.Surf);
 AddRect(ar[i].x, ar[i].y, Width, Height);
+ii:= 0;
+while ii < overlaycnt do
+begin
+BlitOverlayAndGenerateCollisionInfo(
+ar[i].x + overlays[ii].Position.X,
+ar[i].y + overlays[ii].Position.Y, overlays[ii].Surf);
+AddRect(ar[i].x + overlays[ii].Position.X,
+ar[i].y + overlays[ii].Position.Y,
+Width, Height);
+inc(ii);
+end;
 dec(Maxcnt)
 end
 else Maxcnt:= 0
 end;
 TryPut:= bRes;
 end;
 function TryPut2(var Obj: TSprayObject; Surface: PSDL_Surface): boolean;
 const MaxPointsIndex = 8095;
-var x, y: Longword;
+var x, y, xStart, yStart: Longword;
+xWraps, yWraps: Byte;
 ar: array[0..MaxPointsIndex] of TPoint;
 cnt, i: Longword;
 r: TSDL_Rect;
 bRes: boolean;
 begin
 cnt:= 0;
 with Obj do
 begin
 if Maxcnt = 0 then
 exit;
-x:= 0;
+xWraps:= 0;
+yWraps:= 0;
+// Start at random coordinates
+xStart:= getrandom(LAND_WIDTH - Width);
+yStart:= 8 + getrandom(LAND_HEIGHT - Height - 16);
+x:= xStart;
+y:= yStart;
 r.x:= 0;
 r.y:= 0;
 r.w:= Width;
 r.h:= Height + 16;
+// Then iterate through the whole map; this requires we wrap one time per axis
 repeat
-y:= 8;
+yWraps:= 0;
 repeat
 if CheckLand(r, x, y - 8, lfBasic)
 and (not CheckIntersect(x, y, Width, Height)) then
 begin
 ar[cnt].x:= x;
 x:= $FF000000;
 end
 else inc(cnt);
 end;
 inc(y, 12);
-until y >= LAND_HEIGHT - Height - 8;
+if (y >= LAND_HEIGHT - Height - 8) or ((yWraps > 0) and (y >= yStart)) then
-inc(x, getrandom(12) + 12)
+begin
-until x >= LAND_WIDTH - Width;
+inc(yWraps);
+y:= 8;
+end;
+until yWraps > 1;
+inc(x, getrandom(12) + 12);
+if (x >= LAND_WIDTH - Width) or ((xWraps > 0) and (x >= xStart)) then
+begin
+inc(xWraps);
+x:= 0;
+end;
+until xWraps > 1;
 bRes:= cnt <> 0;
 if bRes then
 begin
 i:= getrandom(cnt);
 copyToXY(Obj.Surf, Surface, ar[i].X, ar[i].Y);
 procedure CheckRect(Width, Height, x, y, w, h: LongWord);
 begin
 if (x + w > Width) then
-OutError('Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
+OutError('Broken theme. Object''s rectangle exceeds image: x + w (' + inttostr(x) + ' + ' + inttostr(w) + ') > Width (' + inttostr(Width) + ')', true);
 if (y + h > Height) then
-OutError('Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
+OutError('Broken theme. Object''s rectangle exceeds image: y + h (' + inttostr(y) + ' + ' + inttostr(h) + ') > Height (' + inttostr(Height) + ')', true);
+end;
+procedure ReadRect(var rect: TSDL_Rect; var s: ShortString);
+var i: LongInt;
+begin
+with rect do
+begin
+i:= Pos(',', s);
+x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+i:= Pos(',', s);
+y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+i:= Pos(',', s);
+w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+i:= Pos(',', s);
+if i = 0 then i:= Succ(Length(S));
+h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+end;
+end;
+procedure ReadOverlay(var overlay: TThemeObjectOverlay; var s: ShortString);
+var i: LongInt;
+begin
+with overlay do
+begin
+i:= Pos(',', s);
+Position.X:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+i:= Pos(',', s);
+Position.Y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+i:= Pos(',', s);
+if i = 0 then i:= Succ(Length(S));
+Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifColorKey or ifIgnoreCaps or ifCritical);
+Width:= Surf^.w;
+Height:= Surf^.h;
+Delete(s, 1, i);
+ChecksumLandObjectImage(Surf);
+end;
 end;
 procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
-var s, key: shortstring;
+var s, key, nameRef: shortstring;
 f: PFSFile;
-i, y: LongInt;
+i: LongInt;
 ii, t: Longword;
 c2: TSDL_Color;
 begin
 AddProgress;
 end;
 s:= cPathz[ptCurrTheme] + '/' + cThemeCFGFilename;
 WriteLnToConsole('Reading objects info...');
 f:= pfsOpenRead(s);
-if checkFails(f <> nil, 'Bad data or cannot access file ' + s, true) then exit;
+if (f = nil) then
+OutError('Error loading theme. File could not be opened: ' + s, true);
 ThemeObjects.Count:= 0;
 SprayObjects.Count:= 0;
 while (not pfsEOF(f)) and allOK do
 begin
 inc(ThemeObjects.Count);
 with ThemeObjects.objs[Pred(ThemeObjects.Count)] do
 begin
 i:= Pos(',', s);
-Surf:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i))), ifColorKey or ifIgnoreCaps or ifCritical);
+Name:= Trim(Copy(s, 1, Pred(i)));
+Surf:= LoadDataImage(ptCurrTheme, Name, ifColorKey or ifIgnoreCaps or ifCritical);
 Width:= Surf^.w;
 Height:= Surf^.h;
 Mask:= LoadDataImage(ptCurrTheme, Trim(Copy(s, 1, Pred(i)))+'_mask', ifColorKey or ifIgnoreCaps);
 Delete(s, 1, i);
 i:= Pos(',', s);
 Maxcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
 Delete(s, 1, i);
 if (Maxcnt < 1) or (Maxcnt > MAXTHEMEOBJECTS) then
-OutError('Object''s max count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
+OutError('Broken theme. Object''s max. count should be between 1 and '+ inttostr(MAXTHEMEOBJECTS) +' (it was '+ inttostr(Maxcnt) +').', true);
-for y := 0 to Surf^.h-1 do
+ChecksumLandObjectImage(Surf);
-syncedPixelDigest:= Adler32Update(syncedPixelDigest, @PByteArray(Surf^.pixels)^[y*Surf^.pitch], Surf^.w*4);
+ChecksumLandObjectImage(Mask);
 inrectcnt := 0;
 for ii := 1 to Length(S) do
 if S[ii] = ',' then
 i:= Pos(',', s);
 inrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
 Delete(s, 1, i);
 end;
-for ii:= 1 to inrectcnt do
+if inrectcnt > MAXOBJECTRECTS then
-with inland[ii] do
+OutError('Broken theme. Object''s inland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(inrectcnt) +').', true);
-begin
-i:= Pos(',', s);
+for ii:= 0 to Pred(inrectcnt) do
-x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+ReadRect(inland[ii], s);
-Delete(s, 1, i);
-i:= Pos(',', s);
-y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
-Delete(s, 1, i);
-i:= Pos(',', s);
-w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
-Delete(s, 1, i);
-i:= Pos(',', s);
-h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
-Delete(s, 1, i);
-CheckRect(Width, Height, x, y, w, h)
-end;
 i:= Pos(',', s);
 outrectcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
 Delete(s, 1, i);
-for ii:= 1 to outrectcnt do
-with outland[ii] do
+if outrectcnt > MAXOBJECTRECTS then
-begin
+OutError('Broken theme. Object''s outland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(outrectcnt) +').', true);
-i:= Pos(',', s);
-x:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+for ii:= 0 to Pred(outrectcnt) do
-Delete(s, 1, i);
+ReadRect(outland[ii], s);
-i:= Pos(',', s);
+end;
-y:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+end
-Delete(s, 1, i);
+else if key = 'anchors' then
-i:= Pos(',', s);
+begin
-w:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+i:= Pos(',', s);
-Delete(s, 1, i);
+nameRef:= Trim(Copy(s, 1, Pred(i)));
-if ii = outrectcnt then
+for ii:= 0 to Pred(ThemeObjects.Count) do
-h:= StrToInt(Trim(s))
+if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
-else
+begin
-begin
+if anchorcnt <> 0 then
-i:= Pos(',', s);
+OutError('Broken theme. Duplicate anchors declaration for object ' + nameRef, true);
-h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
-Delete(s, 1, i)
+i:= Pos(',', s);
-end;
+anchorcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
-CheckRect(Width, Height, x, y, w, h)
+Delete(s, 1, i);
-end;
+if anchorcnt > MAXOBJECTRECTS then
+OutError('Broken theme. Object''s anchor rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(anchorcnt) +').', true);
+for t:= 0 to Pred(anchorcnt) do
+ReadRect(anchors[t], s);
+break
+end;
+end
+else if key = 'overlays' then
+begin
+i:= Pos(',', s);
+nameRef:= Trim(Copy(s, 1, Pred(i)));
+for ii:= 0 to Pred(ThemeObjects.Count) do
+if ThemeObjects.objs[ii].Name = nameRef then with ThemeObjects.objs[ii] do
+begin
+if overlaycnt <> 0 then
+OutError('Broken theme. Duplicate overlays declaration for object ' + nameRef, true);
+Delete(s, 1, i);
+i:= Pos(',', s);
+overlaycnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+Delete(s, 1, i);
+if overlaycnt > MAXOBJECTRECTS then
+OutError('Broken theme. Object''s overlay count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(overlaycnt) +').', true);
+for t:= 0 to Pred(overlaycnt) do
+ReadOverlay(overlays[t], s);
+break
 end;
 end
 else if key = 'spray' then
 begin
 inc(SprayObjects.Count);
 cFlattenClouds:= true
 else if key = 'ice' then
 cIce:= true
 else if key = 'snow' then
 cSnow:= true
+else if key = 'rope-step' then
+cRopeNodeStep:= max(1, StrToInt(s))
+else if key = 'rope-layers' then
+cRopeLayers:= max(1, min(MAXROPELAYERS, StrToInt(s)))
 else if key = 'sd-water-top' then
 begin
 i:= Pos(',', s);
 SDWaterColorArray[1].r:= StrToInt(Trim(Copy(s, 1, Pred(i))));
 Delete(s, 1, i);
 begin
 ReadThemeInfo(ThemeObjects, SprayObjects)
 end;
 procedure FreeLandObjects();
-var i: Longword;
+var i, ii: Longword;
 begin
 for i:= 0 to Pred(MAXTHEMEOBJECTS) do
 begin
 if ThemeObjects.objs[i].Surf <> nil then
 SDL_FreeSurface(ThemeObjects.objs[i].Surf);
 if SprayObjects.objs[i].Surf <> nil then
 SDL_FreeSurface(SprayObjects.objs[i].Surf);
 ThemeObjects.objs[i].Surf:= nil;
 SprayObjects.objs[i].Surf:= nil;
+ii:= 0;
+while ii < ThemeObjects.objs[i].overlaycnt do
+begin
+if ThemeObjects.objs[i].overlays[ii].Surf <> nil then
+begin
+SDL_FreeSurface(ThemeObjects.objs[i].overlays[ii].Surf);
+ThemeObjects.objs[i].overlays[ii].Surf:= nil;
+end;
+inc(ii);
+end;
 end;
 end;
 end.

branch	ui-scaling
changeset 15283	c4fd2813b127
parent 15156	84e98f0f7f7b
child 15340	4e91a7050add