Cleanup projectile update

2025-10-12 18:47:10 +01:00
parent 675f8ade59
commit 3206cdebf6
2 changed files with 177 additions and 180 deletions
@@ -2,7 +2,6 @@
 --{-# OPTIONS_GHC -Wno-unused-imports #-}
 module Dodge.Projectile.Update (updateProjectile) where

-import Linear
 import Control.Monad
 import Data.List (delete)
 import Data.Maybe
@@ -19,6 +18,7 @@ import Dodge.WorldEvent.Sound
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
+import Linear
 import NewInt
 import RandomHelp

@@ -38,62 +38,57 @@ doGravityPU pj
    | otherwise = id

 applyGravityPU :: Projectile -> World -> World
-applyGravityPU pj w
-    | (pj ^. pjPos . _z) < 1 && norm (_pjVel pj) < 1 =
-        w
-            & topj . pjVel .~ 0
-    | otherwise =
-        w -- & topj . pjZ .~ newz
-            & topj . pjVel . _z -~ 0.5
+applyGravityPU pj
+    | (pj ^. pjPos . _z) < 1 && norm (_pjVel pj) < 1 = topj . pjVel .~ 0
+    | otherwise = topj . pjVel . _z -~ 0.5
  where
    topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)

--    newz = pj ^. pjZ + pj ^. pjZVel
-
 -- consider pushing any hit creature back
 shellExplosionCheck :: Projectile -> World -> World
-shellExplosionCheck pj w
+shellExplosionCheck pj
    | RetiredProjectile <- pj ^. pjType
-      , time <= 0 =
-        destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
-    | time <= 0 = explodeShell pj w
-    | RetiredProjectile <- pj ^. pjType = w
-    | otherwise = w
+      , timeout =
+        destroyProjectile pj
+    | timeout = explodeShell pj
+    | otherwise = id
  where
-    time = _pjTimer pj
+    timeout = pj ^. pjTimer <= 0

 shellHitWall :: Point3 -> Point3 -> Wall -> Projectile -> World -> World
-shellHitWall p n wl pj w
+shellHitWall p n wl pj
    | Just GStick <- pj ^? pjType . gnHitEffect =
-        w & topj . pjType .~ Grenade (GStuckWall (wl ^. wlStructure))
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
+        (topj . pjType .~ Grenade (GStuckWall (wl ^. wlStructure)))
+            . stickHitSound pj
    | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance
      , abs (dot (pj ^. pjVel) (normalize n)) < x =
-        w
-            & topj . pjVel %~ reflectInNormal n
-            & topj . pjPos .~ p + normalize n
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
-    | otherwise =
-        w & topj . pjPos .~ p
-            & topj . pjTimer .~ 0
+        (topj . pjVel %~ reflectInNormal n)
+            . (topj . pjPos .~ p + normalize n)
+            . bounceSound pj
+    | otherwise = topj %~ ((pjPos .~ p) . (pjTimer .~ 0))
  where
    topj = cWorld . lWorld . projectiles . ix (_pjID pj)

+bounceSound :: Projectile -> World -> World
+bounceSound pj = soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
+
+stickHitSound :: Projectile -> World -> World
+stickHitSound pj =
+    soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
+
 shellHitCreature :: Point3 -> Creature -> Projectile -> World -> World
-shellHitCreature p cr pj w
+shellHitCreature p cr pj
    | Just GStick <- pj ^? pjType . gnHitEffect =
-        w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjType
-                .~ Grenade
-                    ( GStuckCreature
-                        (cr ^. crID)
-                        (rotate3z (- cr ^. crDir) (p - ((cr ^. crPos . _xy) `v2z` 0)))
-                        (pj ^. pjDir - cr ^. crDir)
-                    )
-            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos . _xy)
-    | otherwise =
-        w
-            & cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
+        (pjlens . pjType .~ Grenade gren)
+            . stickHitSound pj
+    | otherwise = pjlens . pjTimer .~ 0
+  where
+    pjlens = cWorld . lWorld . projectiles . ix (_pjID pj)
+    gren =
+        GStuckCreature
+            (cr ^. crID)
+            (rotate3z (- cr ^. crDir) (p - cr ^. crPos))
+            (pj ^. pjDir - cr ^. crDir)

 shellHitFloor :: Point3 -> Projectile -> World -> World
 shellHitFloor p pj w
@@ -104,7 +99,7 @@ shellHitFloor p pj w
            & topj . pjVel . _z %~ bouncez
            & topj . pjVel . _xy %~ decvel
            & topj . pjSpin %~ decspin
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos . _xy) click1S Nothing
+            & bounceSound pj
  where
    bouncez x
        | x < -1 = -0.5 * x
@@ -119,14 +114,13 @@ shellHitFloor p pj w
        | abs x < 0.01 = 0
        | otherwise = x * 0.9

-destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
-destroyProjectile mitid pjid w =
-    w & cWorld . lWorld . projectiles %~ IM.delete pjid
-        & removelink
+destroyProjectile :: Projectile -> World -> World
+destroyProjectile pj =
+    (cWorld . lWorld . projectiles %~ IM.delete pjid) . removelink
  where
+    pjid = pj ^. pjID
    removelink = fromMaybe id $ do
-        itid <- mitid
--        loc <- w ^? cWorld . lWorld . itemLocations . ix itid
+        itid <- pj ^. pjScreenID
        return $ pointerToItemID itid . itUse . uaParams . apProjectiles %~ delete pjid

 trySpin :: Projectile -> World -> World
@@ -139,37 +133,36 @@ tryThrust :: Projectile -> World -> World
 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
+    return $ doThrust pj x . pjRemoteSetDirection y pj

 doThrust :: Projectile -> Maybe RocketSmoke -> World -> World
 doThrust pj smoke w =
    w
        & randGen .~ g
-        & cWorld . lWorld . projectiles . ix i . pjVel . _xy %~ (\v -> accel +.+ frict *.* v)
-        & soundContinue (ShellSound i) newPos missileLaunchS (Just 1)
+        & cWorld . lWorld . projectiles . ix i . pjVel . _xy %~ (\v -> accel + frict *^ v)
+        & soundContinue (ShellSound i) (ep ^. _xy) missileLaunchS (Just 1)
        & makeFlamelet
-            ((oldPos -.- vel) `v2z` 20)
-            ((vel +.+ rotateV (pi + sparkD) accel) `v2z` 0)
+            (sp - 0.5 *^ vel)
+            (vel + rotateV (pi + sparkD) accel `v2z` 0)
            3
            10
        & makeCloudAt
            RocketSmoke
            lifetime
-            (addZ 20 (oldPos +.+ r1 +.+ 30 *.* normalizeV (oldPos -.- newPos)))
+            (sp + r1 + 30 *^ signorm (sp - ep))
  where
    lifetime = fst . randomR lt $ _randGen w
    lt
        | smoke == Just ReducedRocketSmoke = (50, 200)
        | otherwise = (300, 500)
-    --    trailfadetime = fst . randomR (100, 300) $ _randGen w
    accel = rotateV (pj ^. pjDir) (V2 3 0)
    i = _pjID pj
-    oldPos = pj ^. pjPos . _xy
-    vel = pj ^. pjVel . _xy
-    newPos = oldPos +.+ vel
+    sp = pj ^. pjPos
+    vel = pj ^. pjVel
+    ep = sp + vel
    (frict, g) = randomR (0.6, 0.9) $ _randGen w
    (sparkD, _) = randomR (-0.2, 0.2) $ _randGen w
-    r1 = randInCirc 10 & evalState $ _randGen w
+    r1 = addZ 0 $ randInCirc 10 & evalState $ _randGen w

 doBarrelSpin :: Int -> Float -> Projectile -> World -> World
 doBarrelSpin cid i pj w =
@@ -179,31 +172,36 @@ doBarrelSpin cid i pj w =
    pjid = _pjID pj
    dir = argV $ pj ^. pjVel . _xy
    newSpin = case w ^? cWorld . lWorld . creatures . ix cid of
-        Just cr -> negate $ min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
+        Just cr ->
+            negate $
+                min 0.2 $ max (-0.2) $ normalizeAnglePi (dir - _crDir cr) / spinFactor
        _ -> 0
    spinFactor = 5 * (6 - i)

 -- note this only allows YOU to remotely track projectiles
-pjRemoteSetDirection :: Maybe RocketHoming -> Projectile -> World -> World
+pjRemoteSetDirection :: RocketHoming -> Projectile -> World -> World
 pjRemoteSetDirection ph pj w = case ph of
-    Just (HomeUsingRemoteScreen screenid)
+    HomeUsingRemoteScreen screenid
        | lw ^? creatures . ix 0 . crManipulation . manObject . imSelectedItem
            == lw ^? items . ix (_unNInt screenid) . itLocation . ilInvID ->
            w
-                & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
-                    .~ (w ^. wCam . camRot) + argV (w ^. input . mousePos)
-                & cWorld . lWorld . projectiles . ix (_pjID pj) . pjSpin
-                    .~ 0.5 * diffAngles ((w ^. wCam . camRot) + argV (w ^. input . mousePos)) (_pjDir pj)
-    Just (HomeUsingTargeting itid)
+                & pjlens . pjDir .~ mousedir
+                & pjlens . pjSpin .~ 0.5 * diffAngles mousedir pjdir
+    HomeUsingTargeting itid
        | Just tp <- w ^? pointerToItemID itid . itTargeting . itTgPos . _Just ->
            w
-                & cWorld . lWorld . projectiles . ix (_pjID pj) . pjDir
-                    %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
-                & cWorld . lWorld . projectiles . ix (_pjID pj) . pjSpin
-                    .~ 0.5 * diffAngles (turnTo 0.2 (pj ^. pjPos . _xy) tp (_pjDir pj)) (_pjDir pj)
+                & pjlens . pjDir %~ turnTo 0.2 (pj ^. pjPos . _xy) tp
+                & pjlens . pjSpin
+                    .~ 0.5
+                        * diffAngles
+                            (turnTo 0.2 (pj ^. pjPos . _xy) tp pjdir)
+                            pjdir
    _ -> w
  where
+    pjdir = pj ^. pjDir
+    mousedir = w ^. wCam . camRot + argV (w ^. input . mousePos)
    lw = w ^. cWorld . lWorld
+    pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)

 moveStuckGrenade :: Int -> Point3 -> Float -> Projectile -> World -> World
 moveStuckGrenade cid poff d pj w
@@ -212,45 +210,44 @@ moveStuckGrenade cid poff d pj w
            cdir = cr ^. crDir
            vel = cpos - cr ^. crOldPos
         in w
-                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos . _xy
-                    .~ xyV3 (cpos + rotate3z cdir poff)
-                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjDir .~ d + cdir
-                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjVel .~ vel
+                & pjlens . pjPos . _xy .~ xyV3 (cpos + rotate3z cdir poff)
+                & pjlens . pjDir .~ d + cdir
+                & pjlens . pjVel .~ vel
    | otherwise =
-        w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjType .~ Grenade GStick
+        w & pjlens . pjType .~ Grenade GStick
+  where
+    pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)

 moveProjectile :: Projectile -> World -> World
 moveProjectile pj w
    | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
    | Just (GStuckCreature crid poff d) <- pj ^? pjType . gnHitEffect =
        moveStuckGrenade crid poff d pj w
-    | (p, Just (n, OWall wl)) <- collide3 sp (sp + 2 *^ _pjVel pj) w =
-        shellHitWall p n wl pj w
-    | (p, Just (_, OFloor)) <- collide3 sp (sp + 2*^ _pjVel pj) w =
-        shellHitFloor p pj w
-    | (p, Just (_, OCreature cr)) <- collide3 sp (sp + 2 *^ _pjVel pj) w =
-        shellHitCreature p cr pj w
-    | (_, Just (_, OChasmWall)) <- collide3 sp (sp + 2 *^_pjVel pj) w =
-        -- no stick or bounce for now
-        w & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer .~ 0
-    | otherwise =
-        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
+    | otherwise = case collide3 sp (sp + _pjVel pj) w of
+        (p, Just (n, OWall wl)) -> shellHitWall p n wl pj w
+        (p, Just (_, OFloor)) -> shellHitFloor p pj w
+        (p, Just (_, OCreature cr)) -> shellHitCreature p cr pj w
+        (_, Just (_, OChasmWall)) -> w & pjlens . pjTimer .~ 0 -- no stick or bounce for now
+        _ ->
+            w
+                & pjlens . pjSpin *~ 0.99
+                & pjlens . pjPos +~ _pjVel pj
+                & pjlens . pjDir +~ _pjSpin pj
  where
+    pjlens = cWorld . lWorld . projectiles . ix (pj ^. pjID)
    sp = _pjPos pj

 explodeShell :: Projectile -> World -> World
 explodeShell pj w =
    w
-        & cWorld . lWorld . projectiles . ix pjid . pjType .~ RetiredProjectile
-        & cWorld . lWorld . projectiles . ix pjid . pjVel .~ 0
-        & cWorld . lWorld . projectiles . ix pjid . pjTimer .~ 30
+        & pjlens . pjType .~ RetiredProjectile
+        & pjlens . pjVel .~ 0
+        & pjlens . pjTimer .~ 30
        & usePayload (_pjPayload pj) (pj ^. pjPos) (pj ^. pjVel)
        & stopSoundFrom (ShellSound pjid)
        & updatedetonator
  where
+    pjlens = cWorld . lWorld . projectiles . ix pjid
    updatedetonator = fromMaybe id $ do
        detid <- pj ^. pjDetonatorID
        return $ pointerToItemID detid . itUse . uaParams . apProjectiles %~ delete pjid