Improve bullet hit detection

src/Dodge/Base/Collide.hs

@@ -18,6 +18,7 @@ module Dodge.Base.Collide (
     collideCircWalls,
     overlapSegWalls,
     overlapSegCrs,
+    overlapSegCrs',
     bouncePoint,
     circOnSomeWall,
     circOnAnyCr,
@@ -35,6 +36,7 @@ module Dodge.Base.Collide (
     crHeight,
 ) where
 
+import Control.Applicative
 import Data.Foldable
 import qualified Data.IntMap.Strict as IM
 import Control.Lens
@@ -66,6 +68,15 @@ overlapSegCrs sp ep = mapMaybe f
         (,cr)
             <$> fst (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep)
 
+overlapSegCrs' :: Point2 -> Point2 -> [Creature] -> [(Point2, Creature)]
+{-# INLINE overlapSegCrs' #-}
+overlapSegCrs' sp ep = mapMaybe f
+  where
+    f cr =
+        (,cr)
+            <$> g (intersectCircSeg (cr ^. crPos . _xy) (crRad $ cr ^. crType) sp ep)
+    g (a,b) = a <|> b
+
 doBounce :: Float -> Point2 -> Point2 -> (Point2, Maybe Wall) -> Maybe (Point2, Point2)
 {-# INLINE doBounce #-}
 doBounce x sp ep (p, mwl) = fmap f mwl

src/Dodge/Bullet.hs

@@ -168,7 +168,7 @@ hitEffFromBul w bu = case _buEffect bu of
     DestroyBullet -> expireAndDamage bu hitstream w
   where
     sp = _buPos bu
-    hitstream = thingsHitZ 20 sp (sp + _buVel bu) w
+    hitstream = thingsHitZ' 20 sp (sp + _buVel bu) w
 
 getBulHitDams :: Bullet -> Point2 -> [Damage]
 getBulHitDams bu p = case _buPayload bu of

src/Dodge/Creature/ChaseCrit.hs

@@ -66,7 +66,7 @@ slimeCrit :: Creature
 slimeCrit = defaultCreature
         & crName .~ "slimeCrit"
         & crHP .~ HP 1000
-        & crType .~ SlimeCrit 40 0 (V2 50 0) False True
+        & crType .~ SlimeCrit 40 0 0 (V2 50 0) False True
         & crFaction .~ ColorFaction (light green)
         & crPerception . cpVision . viFOV .~ FloatFOV pi
         & crActionPlan .~ SlimeIntelligence

src/Dodge/Creature/Update.hs

@@ -3,7 +3,6 @@
 module Dodge.Creature.Update (updateCreature) where
 
 import Dodge.WorldEvent.ThingsHit
-import Dodge.Creature.Radius
 import Color
 import Control.Monad
 import qualified IntMapHelp as IM
@@ -112,7 +111,7 @@ slimeCritUpdate cid w
       | otherwise = id
     v = (s * r) *^ unitVectorAtAngle (cr ^. crDir)
     --r = crRad (cr ^. crType)
-    r = (cr ^?! crType . slimeRad)
+    r = cr ^?! crType . slimeRad
     p = cr ^?! crType . slimeCompression
     (p',f')  
         | dot p v > 0 && dot p v > dot p (vNormal v) && dot p v > dot p (-vNormal v) = (p, id)

src/Dodge/Data/Creature/Misc.hs

@@ -73,6 +73,7 @@ data CreatureType
     | SlimeCrit
         { _slimeRad :: Float
         , _slimeRadWobble :: Float
+        , _slimeSplitTimer :: Int
         , _slimeCompression :: Point2
         , _slimeIsCompressing :: Bool
         , _slimeResetDir :: Bool

src/Dodge/Humanoid.hs

@@ -29,15 +29,15 @@ chaseCritInternal w cr =
 crabCritInternal :: Int -> World -> World
 crabCritInternal cid w =
 --    (crVocalization %~ updateVocTimer)
-        (tocr %~ ((crType . meleeCooldownL %~ max 0 . subtract 1)))
+        (tocr %~ (crType . meleeCooldownL %~ max 0 . subtract 1))
-        . (tocr %~ ((crType . meleeCooldownR %~ max 0 . subtract 1)))
+        . (tocr %~ (crType . meleeCooldownR %~ max 0 . subtract 1))
-        . (tocr %~ ((crType . dodgeCooldown %~ max 0 . subtract 1)))
+        . (tocr %~ (crType . dodgeCooldown %~ max 0 . subtract 1))
-        . (tocr %~ (searchIfDamaged))
+        . (tocr %~ searchIfDamaged)
-        . (tocr %~ (targetYouWhenCognizant w))
+        . (tocr %~ targetYouWhenCognizant w)
-        . (tocr %~ (perceptionUpdate [0] w))
+        . (tocr %~ perceptionUpdate [0] w)
         . crabActionUpdate cid
-        . (tocr %~ (setMvPosToTargetCr w))
+        . (tocr %~ setMvPosToTargetCr w)
-        . (tocr %~ (setViewPos w))
+        . (tocr %~ setViewPos w)
 --        . overrideMeleeCloseTarget w
         $ (tocr %~ doStrategyActions) w
   where

src/Dodge/Room/Tutorial.hs

@@ -57,12 +57,14 @@ tutAnoTree = do
     foldMTRS
         [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox
         , corDoor
-        , tToBTree "" . return . cleatOnward <$> (cChasm
+--        , tToBTree "" . return . cleatOnward <$> (cChasm
-            <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20))
+--            <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20))
-        , corDoor
+--        , corDoor
-        , loadAmmoTut
+--        , loadAmmoTut
-        , corDoor
+--        , corDoor
         , chasmSpitTerminal
+        , corDoor
+        , tutHub
 --b        , corDoor
 --b        , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
 --b        , corDoor

src/Dodge/WorldEvent/ThingsHit.hs

@@ -6,6 +6,7 @@ Find which objects lie upon a line.
 module Dodge.WorldEvent.ThingsHit (
     thingsHit,
     thingsHitZ,
+    thingsHitZ',
     thingHit,
     thingHitFilt,
     thingsHitExceptCr,
@@ -59,6 +60,14 @@ thingsHitZ z sp ep w =
         (map (second Left) (crsHitZ z sp ep w))
         (map (second Right) (wlsHit sp ep w))
 
+-- includes cr exit wounds
+thingsHitZ' :: Float -> Point2 -> Point2 -> World -> [(Point2, Either Creature Wall)]
+thingsHitZ' z sp ep w =
+    List.mergeOn
+        (dist sp . fst)
+        (map (second Left) (crsHitZ' z sp ep w))
+        (map (second Right) (wlsHit sp ep w))
+
 crWlPbHit :: Point2 -> Point2 -> World -> [(Point2, Object)]
 crWlPbHit sp ep w =
     List.mergeOn
@@ -104,6 +113,26 @@ crsHitZ z sp ep w
             . IS.toList
             . crixsNearSeg sp ep
             $ w
+  where
+    f cr
+--        | CrDestroyed{} <- cr ^. crHP = Nothing
+--        | otherwise = Just cr
+        | HP{} <- cr ^. crHP = Just cr
+        | CrIsCorpse{} <- cr ^. crHP
+            , z < 5 = Just cr
+        | otherwise = Nothing
+
+-- records exit wounds if there is no entry wound
+crsHitZ' :: Float -> Point2 -> Point2 -> World -> [(Point2, Creature)]
+crsHitZ' z sp ep w
+    | sp == ep = mempty
+    | otherwise =
+        sortOn (dist sp . fst)
+            . overlapSegCrs' sp ep
+            . mapMaybe (\cid -> f =<< w ^? cWorld . lWorld . creatures . ix cid)
+            . IS.toList
+            . crixsNearSeg sp ep
+            $ w
   where
     f cr
         | HP{} <- cr ^. crHP = Just cr