Partially implement grenades down chasms

src/Dodge/Creature/Update.hs

@@ -25,12 +25,12 @@ updateCreature cr = chasmTest cr . case _crType cr of
 
 chasmTest :: Creature -> World -> World
 chasmTest cr w
-    | _crZVel cr < 0 = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 1
+    | _crZVel cr < 0 = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
         & cWorld . lWorld . creatures . ix (_crID cr) . crZ +~ _crZVel cr
     | Just (x,y) <- List.find g (foldMap loopPairs $ w ^. cWorld . chasms) = w
         & soundContinue (CrChasm (_crID cr)) (_crPos cr) debrisS (Just 100)
         & cWorld . lWorld . creatures . ix (_crID cr) . crPos -~ normalizeV (vNormal (x-y))
-    | any f (w ^. cWorld . chasms) = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 1 
+    | any f (w ^. cWorld . chasms) = w & cWorld . lWorld . creatures . ix (_crID cr) . crZVel -~ 0.5
     | otherwise = w
   where
     g = uncurry $ circOnSeg (_crPos cr) (crRad $ cr ^. crType)

src/Dodge/Data/Projectile.hs

@@ -16,13 +16,13 @@ import Dodge.Data.Payload
 
 data Projectile = Shell
     { _pjPos :: Point2
+    , _pjZ :: Float
     , _pjVel :: Point2
     , _pjDir :: Float
     , _pjSpin :: Float
     , _pjID :: Int
     , _pjPayload :: Payload
     , _pjTimer :: Int
-    , _pjZ :: Float
     , _pjZVel :: Float
     , _pjBarrelSpin :: Maybe (Int, Float)
     , _pjType :: ProjectileType
@@ -49,7 +49,7 @@ data RocketHoming
 data GrenadeHitEffect
     = GBounce {_bounceTolerance :: Float}
     | GStick
-    | GStuckCreature {_stuckCrID :: Int, _stuckCrOffset :: Point2, _stuckCrRot :: Float}
+    | GStuckCreature {_stuckCrID :: Int, _stuckCrOffset :: Point3, _stuckCrRot :: Float}
     | GStuckWall {_stuckWlID :: WallStructure}
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 

src/Dodge/Projectile/Update.hs

@@ -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
 

src/Dodge/Prop/Moving.hs

@@ -24,10 +24,10 @@ updateDebrisChunk w db = (w, mdb)
     np = sp + sv
     cdb = case collide3WallsFloor sp np w of
         (p,Nothing) -> db & dbPos .~ p
-            & dbVel -~ V3 0 0 1
+            & dbVel -~ V3 0 0 0.5
             & dbRot %~ dospin
         (p,Just (n,_)) -> db & dbPos .~ p + (0.0001 * normalize n)
-            & dbVel .~ (0.7 * reflectInNormal n sv) - V3 0 0 1
+            & dbVel .~ (0.7 * reflectInNormal n sv) - V3 0 0 0.5
     dospin = (_dbSpin db *)
     mdb = do
         guard (np ^. _z > -1000)

src/Dodge/TestString.hs

@@ -28,9 +28,8 @@ import qualified IntMapHelp as IM
 import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
-testStringInit u = [show $ u ^. uvWorld . testFloat
-    , show . length $ u ^. uvWorld . cWorld . lWorld . debris
-    ]
+testStringInit u =
+    map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjZVel)
 -- map shortShow (u ^.. uvWorld . cWorld . lWorld . debris . each . to g)
 --  where
 --    g db = (pz,z,norm v)