justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Allow grenades to stick to creatures

Browse Source
This commit is contained in:
justin
2025-01-01 17:44:00 +00:00
parent e8fe4c2d72
commit 511e765e3a
6 changed files with 178 additions and 163 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Block.hs
-2
View File
@@ -61,11 +61,9 @@ destroyBlock bl w =
& deleteWallIDs wlids
& maybeClearPaths (_blObstructs bl) -- must happen after the walls are deleted
& cWorld . lWorld . blocks %~ IM.delete (_blID bl)
-- & matDesSound (_blMaterial bl) pos
& flip (foldl' $ flip (wlDustAt awl)) (map (pos +.+) ps)
where
wlids = _blWallIDs bl
--awl = _walls (_cWorld w) IM.! IS.findMin wlids
awl = w ^?! cWorld . lWorld . walls . ix (IS.findMin wlids)
pos = fst . _wlLine $ awl
ps = replicateM 25 (randInCirc 20) & evalState $ _randGen w
src/Dodge/Data/Projectile.hs
+3 -2
View File
@@ -5,6 +5,7 @@
module Dodge.Data.Projectile where
import Dodge.Data.Wall.Structure
import Dodge.Data.Item.Location
import NewInt
import Control.Lens
@@ -51,8 +52,8 @@ data RocketHoming
data GrenadeHitEffect
= GBounce {_bounceTolerance :: Float}
| GStick
| GStuckCreature {_stuckCrID :: Int, _stuckCrOffset :: Point2}
| GStuckWall {_stuckWlID :: Int}
| GStuckCreature {_stuckCrID :: Int, _stuckCrOffset :: Point2, _stuckCrRot :: Float}
| GStuckWall {_stuckWlID :: WallStructure}
deriving (Show, Eq, Ord, Read) --Generic, Flat)
data RocketSmoke
src/Dodge/Data/Wall.hs
+3 -13
View File
@@ -1,10 +1,11 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TemplateHaskell #-}
module Dodge.Data.Wall (
module Dodge.Data.Wall,
module Dodge.Data.Wall.Structure,
module Dodge.Data.Material,
) where
@@ -13,6 +14,7 @@ import Control.Lens
import Data.Aeson
import Data.Aeson.TH
import Dodge.Data.Material
import Dodge.Data.Wall.Structure
import Geometry
data Wall = Wall
@@ -45,20 +47,8 @@ data Opacity
data WallDraw = DrawForceField
deriving (Eq, Ord, Show, Enum, Bounded, Read) --Generic, Flat)
data WallStructure
= StandaloneWall
| DoorPart {_wsDoor :: Int}
| MachinePart {_wsMachine :: Int}
| BlockPart {_wsBlock :: Int}
| CreaturePart
{ _wlStCreature :: Int
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Wall
makeLenses ''Opacity
makeLenses ''WallStructure
deriveJSON defaultOptions ''WallDraw
deriveJSON defaultOptions ''Opacity
deriveJSON defaultOptions ''WallStructure
deriveJSON defaultOptions ''Wall
src/Dodge/Debug/Picture.hs
+13 -7
View File
@@ -112,11 +112,13 @@ drawCircCollisionTest :: World -> Picture
drawCircCollisionTest w = concat $ do
a <- w ^. input . heldWorldPos . at ButtonLeft
b <- w ^. input . heldWorldPos . at ButtonRight
let col | anythingHitCirc 2 a b w = red
let col
| anythingHitCirc 2 a b w = red
| otherwise = green
return $
setLayer DebugLayer (color col $ line [a, b])
<> drawCoord a w <> drawCoord b w
<> drawCoord a w
<> drawCoord b w
drawWallsNearSegment :: World -> Picture
drawWallsNearSegment w = concat $ do
@@ -124,8 +126,10 @@ drawWallsNearSegment w = concat $ do
b <- w ^. input . heldWorldPos . at ButtonRight
return . foldMap f $ wlsNearSeg a b w
where
f wl = setLayer DebugLayer (color rose $ thickLine 3 [a, b])
<> drawCoord a w <> drawCoord b w
f wl =
setLayer DebugLayer (color rose $ thickLine 3 [a, b])
<> drawCoord a w
<> drawCoord b w
where
(a, b) = _wlLine wl
@@ -213,8 +217,10 @@ drawWallsNearCursor :: World -> Picture
drawWallsNearCursor w =
foldMap f $ wlsNearPoint (mouseWorldPos (_input w) (_wCam w)) w
where
f wl = setLayer DebugLayer (color rose $ thickLine 3 [a, b])
<> drawCoord a w <> drawCoord b w
f wl =
setLayer DebugLayer (color rose $ thickLine 3 [a, b])
<> drawCoord a w
<> drawCoord b w
where
(a, b) = _wlLine wl
@@ -351,7 +357,7 @@ drawMousePosition w =
mwp = mouseWorldPos (w ^. input) (w ^. wCam)
drawCoord :: Point2 -> World -> Picture
drawCoord p w =
drawCoord p w =
setLayer FixedCoordLayer
. uncurryV translate (worldPosToScreen (w ^. wCam) p)
. scale 0.1 0.1
src/Dodge/Projectile/Update.hs
+38 -20
View File
@@ -24,9 +24,8 @@ import RandomHelp
updateProjectile :: Projectile -> World -> World
updateProjectile pj w =
( cWorld . lWorld . projectiles . ix (pj ^. pjID)
%~ decTimMvVel
)
(cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
. pjMovement pj
. shellCollisionCheck
pj
$ foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
@@ -99,24 +98,36 @@ shellCollisionCheck pj w
-- bouncing in some way
tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
tryShellBounce (p, Right wl) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just GStick <- pj ^? pjType . gnHitEffect =
w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType .~ Grenade
(GStuckWall (wl ^. wlID))
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
| Just GStick <- pj ^? pjType . gnHitEffect = w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade (GStuckWall (wl ^. wlStructure))
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
| Just x <- pj ^? pjType . gnHitEffect . bounceTolerance =
if abs (dotV (pj ^. pjVel) (vNormal hitline)) < x
then
w
then w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
%~ reflectIn
hitline
%~ reflectIn hitline
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
else explodeShell pj w
where
hitline = normalizeV $ uncurry (-) $ _wlLine wl
tryShellBounce (p, Left cr) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just GStick <- pj ^? pjType . gnHitEffect = w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
.~ Grenade
(GStuckCreature
(cr ^. crID)
(rotateV (- cr ^. crDir) (p - cr ^. crPos))
(pj ^. pjDir - cr ^. crDir)
)
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates %~ delete ApplyGravityPU
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
tryShellBounce _ pj w = explodeShell pj w
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
@@ -189,15 +200,22 @@ pjRemoteSetDirection ph pj w = case ph of
where
lw = w ^. cWorld . lWorld
decTimMvVel :: Projectile -> Projectile
decTimMvVel pj
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = pj & pjTimer -~ 1
pjMovement :: Projectile -> World -> World
pjMovement pj w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect = fromMaybe w $ do
cpos <- w ^? cWorld . lWorld . creatures . ix crid . crPos
cdir <- w ^? cWorld . lWorld . creatures . ix crid . crDir
return $
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
.~ cpos + rotateV cdir p
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
.~ d + cdir
| otherwise =
pj
& pjSpin *~ 0.99
& pjTimer -~ 1
& pjPos +~ _pjVel pj
& pjDir +~ _pjSpin pj
w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos +~ _pjVel pj
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir +~ _pjSpin pj
explodeShell ::
Projectile ->