diff -r a3823f0916b8 -r 361e79c6c428 hedgewars/uCollisions.pas --- a/hedgewars/uCollisions.pas Tue Aug 06 19:13:12 2019 +0200 +++ b/hedgewars/uCollisions.pas Tue Aug 06 23:28:14 2019 +0300 @@ -96,8 +96,10 @@ function CalcSlopeNearGear(Gear: PGear; dirX, dirY: LongInt): hwFloat; function CalcSlopeTangent(Gear: PGear; collisionX, collisionY: LongInt; var outDeltaX, outDeltaY: LongInt; TestWord: LongWord): boolean; +function CheckGearsUnderSprite(Sprite: TSprite; sprX, sprY, Frame: LongInt): boolean; + implementation -uses uConsts, uLandGraphics, uVariables; +uses uConsts, uLandGraphics, uVariables, SDLh, uLandTexture, uDebug; type TCollisionEntry = record X, Y, Radius: LongInt; @@ -1020,6 +1022,65 @@ CalcSlopeBelowGear := _0; end; +function CheckGearsUnderSprite(Sprite: TSprite; sprX, sprY, Frame: LongInt): boolean; +var x, y, bpp, h, w, row, col, gx, gy, r, numFramesFirstCol: LongInt; + p: PByteArray; + Image: PSDL_Surface; + Gear: PGear; +begin + CheckGearsUnderSprite := false; + if checkFails(SpritesData[Sprite].Surface <> nil, 'Assert SpritesData[Sprite].Surface failed', true) then exit; + + numFramesFirstCol:= SpritesData[Sprite].imageHeight div SpritesData[Sprite].Height; + Image:= SpritesData[Sprite].Surface; + + if SDL_MustLock(Image) then + if SDLCheck(SDL_LockSurface(Image) >= 0, 'CheckGearsUnderSprite', true) then exit; + + bpp:= Image^.format^.BytesPerPixel; + + if checkFails(bpp = 4, 'It should be 32 bpp sprite', true) then + begin + if SDL_MustLock(Image) then + SDL_UnlockSurface(Image); + exit + end; + + w:= SpritesData[Sprite].Width; + h:= SpritesData[Sprite].Height; + + row:= Frame mod numFramesFirstCol; + col:= Frame div numFramesFirstCol; + p:= PByteArray(@(PByteArray(Image^.pixels)^[ Image^.pitch * row * h + col * w * 4 ])); + Gear:= GearsList; + + while Gear <> nil do + begin + if (Gear^.Kind = gtAirMine) or ((Gear^.Kind = gtHedgehog) and (Gear^.CollisionIndex <> 0)) then + begin + gx:= hwRound(Gear^.X); + gy:= hwRound(Gear^.Y); + r:= Gear^.Radius; + if (gx + r >= sprX) and (gx - r < sprX + w) and (gy + r >= sprY) and (gy - r < sprY + h) then + for y := gy - r to gy + r do + for x := gx - r to gx + r do + begin + if (x >= sprX) and (x < sprX + w) and (y >= sprY) and (y < sprY + h) + and (Sqr(x - gx) + Sqr(y - gy) < Sqr(r)) + and (((PLongword(@(p^[Image^.pitch * y + x * 4]))^) and AMask) <> 0) then + begin + CheckGearsUnderSprite := true; + if SDL_MustLock(Image) then + SDL_UnlockSurface(Image); + exit + end + end + end; + + Gear := Gear^.NextGear + end; +end; + procedure initModule; begin Count:= 0;