Partially implement grenades down chasms

2025-08-04 09:39:04 +01:00
parent 2a93b7f733
commit a68013b934
6 changed files with 103 additions and 79 deletions
@@ -22,12 +22,15 @@ import qualified IntMapHelp as IM
 import LensHelp
 import NewInt
 import RandomHelp
+import Linear.Metric

 updateProjectile :: Projectile -> World -> World
 updateProjectile pj w =
    (cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjTimer -~ 1)
        . shellExplosionCheck pj
        . moveProjectile pj
+        . tryThrust pj
+        . trySpin pj
        $ doGravityPU pj w

 doGravityPU :: Projectile -> World -> World
@@ -38,16 +41,18 @@ doGravityPU pj

 applyGravityPU :: Projectile -> World -> World
 applyGravityPU pj w
-    | newz <= 0 && abs (pj ^. pjZVel) < 1 =
-        w
-            & topj . pjVel %~ decvel
-            & topj . pjSpin %~ decspin
-    | newz < 0 =
-        w & topj . pjZ .~ 0
-            & topj . pjZVel %~ bouncez
-            & topj . pjVel %~ decvel
-            & topj . pjSpin %~ decspin
-            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
+--    | newz <= 0 && abs (pj ^. pjZVel) < 1 =
+--        w
+--            & topj . pjVel %~ decvel
+--            & topj . pjSpin %~ decspin
+--    | newz < 0 =
+--        w & topj . pjZ .~ 0
+--            & topj . pjZVel %~ bouncez
+--            & topj . pjVel %~ decvel
+--            & topj . pjSpin %~ decspin
+--            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
+    | _pjZ pj < 1 && abs (norm $ _pjVel pj `v2z` _pjZVel pj) < 1 = w 
+        & topj . pjVel .~ 0
    | otherwise =
        w & topj . pjZ .~ newz
            & topj . pjZVel -~ 0.5
@@ -76,40 +81,54 @@ shellExplosionCheck pj w
  where
    time = _pjTimer pj

+shellHitWall :: Point3 -> Point3 -> Wall -> Projectile -> World -> World
+shellHitWall p' n 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
+    | otherwise = w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjPos .~ p
+            &  cWorld . lWorld . projectiles . ix (_pjID pj) . pjTimer .~ 0
+  where
+    p = xyV3 p'
+    hitline = normalizeV $ uncurry (-) $ _wlLine wl
+
+shellHitFloor :: Point3 -> Point3 -> Projectile -> World -> World
+shellHitFloor p' n pj w 
+    | z < 1 && abs (norm $ _pjVel pj `v2z` zvel) < 1 = w 
+    | otherwise = 
+        w & topj . pjZ .~ 0.1
+            & topj . pjZVel %~ bouncez
+            & topj . pjVel %~ decvel
+            & topj . pjSpin %~ decspin
+            & soundStart (ShellSound (pj ^. pjID)) (pj ^. pjPos) click1S Nothing
+  where
+    bouncez x
+        | x < -1 = -0.5 * x
+        | otherwise = 0
+    topj = cWorld . lWorld . projectiles . ix (pj ^. pjID)
+    zvel = pj ^. pjZVel
+    z = pj ^. pjZ + zvel
+    decvel v
+        | magV v > 1 = rotateV (5 * pj ^. pjSpin) $ 0.8 * v
+        | otherwise = 0
+    decspin x
+        | abs x < 0.01 = 0
+        | otherwise = x * 0.9
+
 ---- 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
+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
@@ -126,21 +145,21 @@ tryShellBounce' p' (n, OWall wl) pj w
  where
    p = xyV3 p'
    hitline = normalizeV $ uncurry (-) $ _wlLine wl
-tryShellBounce' p' (n,OCreature cr) pj w
+tryShellBounce p' (n,OCreature 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))
+                        (rotate3z (- cr ^. crDir) (p' - ((cr ^. crPos)`v2z`0)))
                        (pj ^. pjDir - cr ^. crDir)
                    )
            & soundOriginIDsAt (ShellSound (pj ^. pjID)) [slapS, slap1S] (pj ^. pjPos)
  where
    p = xyV3 p'
-tryShellBounce' _ _ pj w = w
-tryShellBounce' _ _ pj w = explodeShell pj w
+tryShellBounce _ _ pj w = w
+tryShellBounce _ _ pj w = explodeShell pj w

 destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
 destroyProjectile mitid pjid w =
@@ -230,6 +249,9 @@ pjRemoteSetDirection ph pj w = case ph of
  where
    lw = w ^. cWorld . lWorld

+moveStuckGrenade :: Creature -> Point3 -> Float -> Projectile -> World -> World
+moveStuckGrenade cr p d pj w = w
+
 moveProjectile :: Projectile -> World -> World
 moveProjectile pj w
    | Just GStuckWall{} <- pj ^? pjType . gnHitEffect = w
@@ -240,21 +262,22 @@ moveProjectile pj w
            vel = cpos - cr ^. crOldPos
         in w
                & cWorld . lWorld . projectiles . ix (pj ^. pjID) . pjPos
-                    .~ cpos + rotateV cdir poff
+                    .~ xyV3 ((cpos `v2z` 0) + rotate3z 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 (n,OWall wl)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
+        = shellHitWall p n wl pj w
+    | (p,Just (n,OFloor)) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
+        = shellHitFloor p n pj w
    | (p,Just po) <- collide3 (p `v2z` (_pjZ pj)) ((p + _pjVel pj)`v2z` (_pjZ pj + _pjZVel pj) ) w 
-        = tryShellBounce' p po pj w
+        = tryShellBounce p po pj w
    | 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
-            & tryThrust pj
-            & trySpin pj
  where
    p = _pjPos pj