Start implementing wider grenade movement

This commit is contained in:
2025-08-03 23:23:55 +01:00
parent ea2e67c9ab
commit 2a93b7f733
6 changed files with 200 additions and 146 deletions
+66 -41
View File
@@ -1,10 +1,9 @@
{-# LANGUAGE LambdaCase #-}
--{-# OPTIONS_GHC -Wno-unused-imports #-}
module Dodge.Projectile.Update (
updateProjectile,
) where
module Dodge.Projectile.Update (updateProjectile) where
import Dodge.Data.Object
import Control.Monad
import Data.List (delete)
import Data.Maybe
@@ -17,7 +16,7 @@ import Dodge.Payload
import Dodge.SoundLogic
import Dodge.WorldEvent.Cloud
import Dodge.WorldEvent.Sound
import Dodge.WorldEvent.ThingsHit
--import Dodge.WorldEvent.ThingsHit
import Geometry
import qualified IntMapHelp as IM
import LensHelp
@@ -27,7 +26,7 @@ import RandomHelp
updateProjectile :: Projectile -> World -> World
updateProjectile pj w =
(cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
. shellCollisionCheck pj
. shellExplosionCheck pj
. moveProjectile pj
$ doGravityPU pj w
@@ -66,25 +65,51 @@ applyGravityPU pj w
newz = pj ^. pjZ + pj ^. pjZVel
-- consider pushing any hit creature back
shellCollisionCheck :: Projectile -> World -> World
shellCollisionCheck pj w
shellExplosionCheck :: Projectile -> World -> World
shellExplosionCheck pj w
| RetiredProjectile <- pj ^. pjType
, time <= 0 =
destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
| time <= 0 = explodeShell pj w
| RetiredProjectile <- pj ^. pjType = w
| Just thit <- thingHit oldpos (oldpos + _pjVel pj) w = tryShellBounce thit pj w
| otherwise = w
where
time = _pjTimer pj
oldpos = _pjPos pj
-- note this doesn't take into account moving walls, which may break the
-- 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
---- note this doesn't take into account moving walls, which may break the
---- bouncing in some way
--tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
--tryShellBounce (p, Right wl) pj w
-- | Just GStick <- pj ^? pjType . gnHitEffect =
-- w
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-- .~ Grenade (GStuckWall (wl ^. wlStructure))
-- & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
-- | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
-- , abs (dotV (pj ^. pjVel) (vNormal hitline)) < x =
-- w
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel
-- %~ reflectIn hitline
-- & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
-- .~ p - normalizeV (pj ^. pjVel)
-- & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
-- where
-- hitline = normalizeV $ uncurry (-) $ _wlLine wl
--tryShellBounce (p, Left cr) pj 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)
-- )
-- & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
--tryShellBounce _ pj w = explodeShell pj w
tryShellBounce' :: Point3 -> (Point3, Object ) -> Projectile -> World -> World
tryShellBounce' p' (n, OWall wl) pj w
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
@@ -98,13 +123,10 @@ tryShellBounce (p, Right wl) pj w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos
.~ p - normalizeV (pj ^. pjVel)
& soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
| isJust $ pj ^? pjType . gnHitEffect . bounceTolerance =
explodeShell pj w
where
p = xyV3 p'
hitline = normalizeV $ uncurry (-) $ _wlLine wl
tryShellBounce (p, Left cr) pj w
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect = w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
tryShellBounce' p' (n,OCreature cr) pj w
| Just GStick <- pj ^? pjType . gnHitEffect =
w
& cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
@@ -115,7 +137,10 @@ tryShellBounce (p, Left cr) pj w
(pj ^. pjDir - cr ^. crDir)
)
& soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
tryShellBounce _ pj w = explodeShell pj w
where
p = xyV3 p'
tryShellBounce' _ _ pj w = w
tryShellBounce' _ _ pj w = explodeShell pj w
destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
destroyProjectile mitid pjid w =
@@ -130,11 +155,11 @@ destroyProjectile mitid pjid w =
trySpin :: Projectile -> World -> World
trySpin pj = fromMaybe id $ do
guard (pj ^. pjTimer == 335)
(cid,s) <- pj ^? pjBarrelSpin . _Just
(cid, s) <- pj ^? pjBarrelSpin . _Just
return $ doBarrelSpin cid s pj
tryThrust :: Projectile -> World -> World
tryThrust pj = fromMaybe id $ do
tryThrust pj = fromMaybe id $ do
Rocket y x <- pj ^? pjType
guard $ pj ^. pjTimer <= 330 && pj ^. pjTimer >= 0
return $ doThrust pj x . pjRemoteSetDirection (Just y) pj
@@ -145,9 +170,9 @@ doThrust pj smoke w =
& randGen .~ g
& cWorld . lWorld . projectiles . ix i . pjVel %~ (\v -> accel +.+ frict *.* v)
& soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
-- & makeFlamelet (oldPos -.- vel) (vel + 2 * rotateV (pi + sparkD) accel) 3 10
& makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
& makeCloudAt RocketSmoke
& makeCloudAt
RocketSmoke
lifetime
(addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
where
@@ -155,7 +180,7 @@ doThrust pj smoke w =
lt
| smoke == Just ReducedRocketSmoke = (50, 200)
| otherwise = (300, 500)
-- trailfadetime = fst . randomR (100, 300) $ _randGen w
-- trailfadetime = fst . randomR (100, 300) $ _randGen w
accel = rotateV (pj ^. pjDir) (V2 3 0)
i = _pjID pj
oldPos = _pjPos pj
@@ -170,11 +195,12 @@ doThrust pj smoke w =
doBarrelSpin :: Int -> Float -> Projectile -> World -> World
doBarrelSpin cid i pj w =
w & cWorld . lWorld . projectiles . ix pjid . pjSpin .~ newSpin
& cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
& cWorld . lWorld . projectiles . ix pjid . pjBarrelSpin .~ Nothing
where
-- f _ StartSpinPU{} = True
-- f _ _ = False
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates %~ deleteBy f (StartSpinPU 0 0 0)
-- f _ StartSpinPU{} = True
-- f _ _ = False
pjid = _pjID pj
dir = argV $ _pjVel pj
newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
@@ -207,20 +233,21 @@ pjRemoteSetDirection ph pj w = case ph of
moveProjectile :: Projectile -> World -> World
moveProjectile pj w
| Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
| Just (GStuckCreature crid p d) <- pj ^? pjType . gnHitEffect
| Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect
, Just cr <- w ^? cWorld . lWorld . creatures . ix crid =
let cpos = cr ^. crPos
cdir = cr ^. crDir
vel = cpos - cr ^. crOldPos
in w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
.~ cpos + rotateV cdir p
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir
.~ d + cdir
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel
.~ vel
.~ cpos + rotateV cdir poff
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir .~ d + cdir
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel .~ vel
| Just GStuckCreature{} <- pj ^? pjType . gnHitEffect =
w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
-- | Just thit <- thingHit p (p + _pjVel pj) w = tryShellBounce thit pj w
| (p,Just po) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w
= tryShellBounce' p po pj w
| otherwise =
w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjSpin *~ 0.99
@@ -228,14 +255,12 @@ moveProjectile pj w
& cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir +~ _pjSpin pj
& tryThrust pj
& trySpin pj
where
p = _pjPos pj
explodeShell ::
Projectile ->
World ->
World
explodeShell :: Projectile -> World -> World
explodeShell pj w =
w
-- & cWorld . lWorld . projectiles . ix pjid . pjUpdates .~ []
& cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
& cWorld . lWorld . projectiles . ix pjid . pjVel .~ 0
& cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 30