# HG changeset patch # User alfadur # Date 1526510237 14400 # Node ID 04d1521cb7b86a9389d71e5be7ffbca76cbeb36d # Parent cf8abedaa878511c38eb7bbe94c5008252f31f85 new theme object features diff -r cf8abedaa878 -r 04d1521cb7b8 hedgewars/uLandObjects.pas --- 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;