--- a/hedgewars/uLandObjects.pas Mon May 07 23:43:01 2018 +0300
+++ b/hedgewars/uLandObjects.pas Wed May 16 18:37:17 2018 -0400
@@ -28,6 +28,7 @@
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;
@@ -42,14 +43,25 @@
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;
- outrectcnt: Longword;
+ anchors: array[0..Pred(MAXOBJECTRECTS)] of TSDL_Rect;
+ overlays: array[0..Pred(MAXOBJECTRECTS)] of TThemeObjectOverlay;
+ inrectcnt: LongInt;
+ outrectcnt: LongInt;
+ anchorcnt: LongInt;
+ overlaycnt: LongInt;
Width, Height: Longword;
Maxcnt: Longword;
end;
@@ -123,6 +135,7 @@
Width:= Image^.w;
p:= Image^.pixels;
+
for y:= 0 to Pred(Image^.h) do
begin
for x:= 0 to Pred(Width) do
@@ -138,14 +151,14 @@
if (cReducedQuality and rqBlurryLand) = 0 then
begin
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
+ or (((LandPixels[cpY + y, cpX + x] and AMask) shr AShift) < 255) then
LandPixels[cpY + y, cpX + x]:= p^[px];
end
else
if LandPixels[(cpY + y) div 2, (cpX + x) div 2] = 0 then
LandPixels[(cpY + y) div 2, (cpX + x) div 2]:= p^[px];
- if (Land[cpY + y, cpX + x] <= lfAllObjMask) and ((p^[px] and AMask) <> 0) then
+ if Land[cpY + y, cpX + x] <= lfAllObjMask then
Land[cpY + y, cpX + x]:= lfObject or LandFlags
end;
end;
@@ -157,6 +170,63 @@
WriteLnToConsole(msgOK)
end;
+function LerpByte(src, dst: Byte; l: LongWord): LongWord; inline;
+begin
+ LerpByte:= ((255 - l) * src + l * dst) div 255;
+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;
@@ -355,27 +425,83 @@
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;
- while bRes and (i <= inrectcnt) do
+ i:= 0;
+ 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;
- while bRes and (i <= outrectcnt) do
+ i:= 0;
+ while bRes and (i < outrectcnt) do
begin
bRes:= CheckLand(outland[i], x, y, 0);
inc(i)
end;
if bRes then
+ begin
+ anchored:= anchorcnt = 0;
+ for i:= 1 to anchorcnt do
+ begin
+ anchored := CheckLandAny(anchors[i], x, y, lfLandMask);
+ if anchored then break;
+ end;
+ bRes:= anchored;
+ end;
+
+ if bRes then
bRes:= not CheckIntersect(x, y, Width, Height);
CheckCanPlace:= bRes;
@@ -386,7 +512,7 @@
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;
@@ -400,7 +526,7 @@
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
@@ -426,6 +552,18 @@
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
@@ -493,8 +631,51 @@
OutError('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);
+ end;
+end;
+
procedure ReadThemeInfo(var ThemeObjects: TThemeObjects; var SprayObjects: TSprayObjects);
-var s, key: shortstring;
+var s, key, nameRef: shortstring;
f: PFSFile;
i, y: LongInt;
ii, t: Longword;
@@ -687,7 +868,8 @@
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);
@@ -714,50 +896,61 @@
Delete(s, 1, i);
end;
- for ii:= 1 to inrectcnt do
- with inland[ii] 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);
- h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
- Delete(s, 1, i);
- CheckRect(Width, Height, x, y, w, h)
- end;
+ if inrectcnt > MAXOBJECTRECTS then
+ OutError('Object''s inland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(inrectcnt) +').', true);
+
+ for ii:= 0 to Pred(inrectcnt) do
+ ReadRect(inland[ii], s);
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
- 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);
- if ii = outrectcnt then
- h:= StrToInt(Trim(s))
- else
- begin
- i:= Pos(',', s);
- h:= StrToInt(Trim(Copy(s, 1, Pred(i))));
- Delete(s, 1, i)
- end;
- CheckRect(Width, Height, x, y, w, h)
- end;
+
+ if outrectcnt > MAXOBJECTRECTS then
+ OutError('Object''s outland rectangle count should be no more than '+ inttostr(MAXOBJECTRECTS) +' (it was '+ inttostr(outrectcnt) +').', true);
+ for ii:= 0 to Pred(outrectcnt) do
+ ReadRect(outland[ii], s);
+ end;
+ end
+ else if key = 'anchors' 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 anchorcnt <> 0 then
+ OutError('Duplicate anchors declaration for ' + nameRef, true);
+ Delete(s, 1, i);
+ i:= Pos(',', s);
+ anchorcnt:= StrToInt(Trim(Copy(s, 1, Pred(i))));
+ Delete(s, 1, i);
+ if anchorcnt > MAXOBJECTRECTS then
+ OutError('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('Duplicate overlays declaration for ' + 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('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
@@ -1009,7 +1202,7 @@
end;
procedure FreeLandObjects();
-var i: Longword;
+var i, ii: Longword;
begin
for i:= 0 to Pred(MAXTHEMEOBJECTS) do
begin
@@ -1019,6 +1212,17 @@
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;