Allow grenades to bounce

src/Dodge/Projectile/Update.hs

@@ -15,6 +15,7 @@ import Dodge.Movement.Turn
 import Dodge.Payload
 import Dodge.SoundLogic
 import Dodge.WorldEvent.Cloud
+import Dodge.WorldEvent.ThingsHit
 import Geometry
 import qualified IntMapHelp as IM
 import LensHelp
@@ -22,15 +23,15 @@ import NewInt
 import RandomHelp
 
 updateProjectile :: Projectile -> World -> World
-updateProjectile pj w = 
-    decTimMvVel pj .
-        shellCollisionCheck
-            pj $
-    foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
+updateProjectile pj w =
+    (cWorld . lWorld . projectiles . ix (pj ^. pjID) %~ 
+         decTimMvVel)
+        . shellCollisionCheck
+            pj
+        $ foldl' (flip $ upProjectile pj) w (_pjUpdates pj)
 
 upProjectile :: Projectile -> ProjectileUpdate -> World -> World
 upProjectile pj pu = case pu of
---    TimePU -> decTimMvVel pj
     ThrustPU st et
         | act st et -> doThrust pj (pj ^? pjType . rkSmoke . _Just)
         | otherwise -> id
@@ -40,11 +41,7 @@ upProjectile pj pu = case pu of
     RemoteDirectionPU st et
         | act st et -> pjRemoteSetDirection (pj ^? pjType . rkHoming) pj
         | otherwise -> id
-    ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
---    DestroyPU mitid 0 -> destroyProjectile mitid (_pjID pj)
-    -- the following requires that this is at the top of the update list, which is
-    -- not ideal
---    DestroyPU _ _ -> cWorld . lWorld . projectiles . ix (_pjID pj) . pjUpdates . ix 0 . pjuTimer -~ 1
+    --    ReduceSpinPU x -> reduceSpinBy x (_pjID pj)
     ApplyGravityPU -> applyGravityPU pj
   where
     time = _pjTimer pj
@@ -84,11 +81,12 @@ shellCollisionCheck ::
     World ->
     World
 shellCollisionCheck pj w
-    | RetiredProjectile <- pj ^. pjType 
-    , time <= -30 
-        = destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
+    | RetiredProjectile <- pj ^. pjType
+      , time <= 0 =
+        destroyProjectile (pj ^. pjScreenID) (_pjID pj) w
     | RetiredProjectile <- pj ^. pjType = w
-    | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
+    | Just thit <- thingHit oldPos (oldPos + _pjVel pj) w = tryShellBounce thit pj w
+    --    | anythingHitCirc 2 oldPos (oldPos + _pjVel pj) w = g
     | time <= 0 = g
     | otherwise = w
   where
@@ -96,6 +94,19 @@ shellCollisionCheck pj w
     time = _pjTimer pj
     oldPos = _pjPos pj
 
+tryShellBounce :: (Point2, Either Creature Wall) -> Projectile -> World -> World
+tryShellBounce (p, Right wl) pj w
+    | Just x <- pj ^? pjType . gnHitEffect . bounceTolerance =
+        if abs (dotV (pj ^. pjVel) (vNormal hitline)) < x
+            then w & cWorld . lWorld . projectiles . ix (_pjID pj) . pjVel %~ 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 _ pj w = explodeShell pj w
+
 destroyProjectile :: Maybe (NewInt ItmInt) -> Int -> World -> World
 destroyProjectile mitid pjid w =
     w & cWorld . lWorld . projectiles %~ IM.delete pjid
@@ -114,7 +125,7 @@ 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 + 2 * rotateV (pi + sparkD) accel) 3 10
         & makeFlamelet (oldPos -.- vel) (vel +.+ rotateV (pi + sparkD) accel) 3 10
         & shellTrailCloud
             lifetime
@@ -168,16 +179,13 @@ pjRemoteSetDirection ph pj w = case ph of
   where
     lw = w ^. cWorld . lWorld
 
-reduceSpinBy :: Float -> Int -> World -> World
-reduceSpinBy x pjid = cWorld . lWorld . projectiles . ix pjid . pjSpin *~ x
-
-decTimMvVel :: Projectile -> World -> World
-decTimMvVel pj =
-    cWorld . lWorld . projectiles . ix (_pjID pj)
-        %~ ( (pjTimer -~ 1)
-                . (pjPos +~ _pjVel pj)
-                . (pjDir +~ _pjSpin pj)
-           )
+decTimMvVel :: Projectile -> Projectile
+decTimMvVel pj = pj
+    & pjSpin *~ 0.99
+    & pjTimer -~ 1
+    & pjPos +~ _pjVel pj
+    & pjDir +~ _pjSpin pj
+           
 
 explodeShell ::
     Projectile ->
@@ -187,6 +195,8 @@ 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
         & usePayload (_pjPayload pj) (_pjPos pj) (_pjVel pj)
         & stopSoundFrom (ShellSound pjid)
         & updatedetonator