hedgewars/uLandObjects.pas
changeset 13391 04d1521cb7b8
parent 12915 4d3b52f1ba18
child 13397 166f8f31de3e
--- 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;