Allow grenades to bounce

src/Dodge/Base/Collide.hs

@@ -70,7 +70,6 @@ doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2,
 {-# INLINE doBounce #-}
 doBounce x sp ep (p, mwl) =
     mwl <&> \wl ->
-        --( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
         ( p +.+ normalizeV (vNormal (uncurry (-.-) (_wlLine wl)))
         , reflVelWallDamp x wl (ep -.- sp)
         )

src/Dodge/Data/Item/Use/Consumption/Ammo.hs

@@ -19,7 +19,6 @@ data ProjectileUpdate
     = ThrustPU {_pjuStart :: Int, _pjuEnd :: Int}
     | StartSpinPU {_pjuTime :: Int, _pjuCID :: Int, _pjuSpinAmound :: Int}
     | RemoteDirectionPU {_pjuStart :: Int, _pjuEnd :: Int}
-    | ReduceSpinPU {_pjuReduceSpin :: Float}
     | ApplyGravityPU
     deriving (Show, Eq, Ord, Read) --Generic, Flat)
 

src/Dodge/Item/Display.hs

@@ -63,7 +63,6 @@ itemBaseName = \case
     ATTACH ait -> showAttachItem ait
     AMMOMAG ait -> show ait
     TARGETING tt -> show tt
---    BULLETMOD (BulletModTrajectory btt) -> show btt
     BULLETMOD (BulletModPayload btt) -> show btt
     BULLETMOD (BulletModEffect btt) -> show btt
 

src/Dodge/Projectile/Create.hs

@@ -35,7 +35,7 @@ createShell mdetonator mscreen pjtype payload muz cr w = w
                 [-- TimePU
                  StartSpinPU (lifespan - 15) (_crID cr) spinamount
                 , RemoteDirectionPU (lifespan - thrustdelay) 0
-                , ReduceSpinPU (1 - spindrag * 2 / 200)
+--                , ReduceSpinPU (1 - spindrag * 2 / 200)
                 ] <> thrustorgrav
             , _pjType = pjtype
             , _pjDetonatorID = mdetonator
@@ -51,7 +51,7 @@ createShell mdetonator mscreen pjtype payload muz cr w = w
         Grenade {}-> [ApplyGravityPU]
         Rocket{} -> [ThrustPU (lifespan - thrustdelay) 0]
         RetiredProjectile -> []
-    spindrag = 1
+--    spindrag = 1
     spinamount = 2
     thrustdelay = 20
     updatedetonator = fromMaybe id $ do

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

src/Dodge/TestString.hs

@@ -27,9 +27,9 @@ import qualified Data.Map.Strict as M
 
 testStringInit :: Universe -> [String]
 testStringInit u = 
-    [show (u ^?! uvWorld . cWorld . lWorld . creatures . ix 0 . crPos)]
-    <>
     map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjPos)
+    <>
+    map show (u ^.. uvWorld . cWorld . lWorld . projectiles . each . pjVel)
 --testStringInit u = foldMap prettyShort $ u ^. uvWorld . cWorld . lWorld . projectiles
 --    (map (show . _ebPos) $ u ^. uvWorld . cWorld . lWorld . energyBalls)
 --    <>