From 431e64fbfbabc659695d421d69f265ab6461be92 Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 13 Apr 2026 20:26:34 +0100 Subject: [PATCH] Improve bullet hit detection --- src/Dodge/Base/Collide.hs | 11 +++++++++++ src/Dodge/Bullet.hs | 2 +- src/Dodge/Creature/ChaseCrit.hs | 2 +- src/Dodge/Creature/Update.hs | 3 +-- src/Dodge/Data/Creature/Misc.hs | 1 + src/Dodge/Humanoid.hs | 16 ++++++++-------- src/Dodge/Room/Tutorial.hs | 12 +++++++----- src/Dodge/WorldEvent/ThingsHit.hs | 29 +++++++++++++++++++++++++++++ 8 files changed, 59 insertions(+), 17 deletions(-) diff --git a/src/Dodge/Base/Collide.hs b/src/Dodge/Base/Collide.hs index 288e1b2bd..7d787b652 100644 --- a/src/Dodge/Base/Collide.hs +++ b/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 diff --git a/src/Dodge/Bullet.hs b/src/Dodge/Bullet.hs index 44eb1ac4d..a2d286332 100644 --- a/src/Dodge/Bullet.hs +++ b/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 diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index c33648aec..d167b3541 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/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 diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index af8e085f4..63be55310 100644 --- a/src/Dodge/Creature/Update.hs +++ b/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) diff --git a/src/Dodge/Data/Creature/Misc.hs b/src/Dodge/Data/Creature/Misc.hs index 7fa92c980..8bfec4faf 100644 --- a/src/Dodge/Data/Creature/Misc.hs +++ b/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 diff --git a/src/Dodge/Humanoid.hs b/src/Dodge/Humanoid.hs index c59dd6a23..585bb74d6 100644 --- a/src/Dodge/Humanoid.hs +++ b/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 . meleeCooldownR %~ max 0 . subtract 1))) - . (tocr %~ ((crType . dodgeCooldown %~ max 0 . subtract 1))) - . (tocr %~ (searchIfDamaged)) - . (tocr %~ (targetYouWhenCognizant w)) - . (tocr %~ (perceptionUpdate [0] w)) + (tocr %~ (crType . meleeCooldownL %~ max 0 . subtract 1)) + . (tocr %~ (crType . meleeCooldownR %~ max 0 . subtract 1)) + . (tocr %~ (crType . dodgeCooldown %~ max 0 . subtract 1)) + . (tocr %~ searchIfDamaged) + . (tocr %~ targetYouWhenCognizant w) + . (tocr %~ perceptionUpdate [0] w) . crabActionUpdate cid - . (tocr %~ (setMvPosToTargetCr w)) - . (tocr %~ (setViewPos w)) + . (tocr %~ setMvPosToTargetCr w) + . (tocr %~ setViewPos w) -- . overrideMeleeCloseTarget w $ (tocr %~ doStrategyActions) w where diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index a830c5db3..8203801cb 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/src/Dodge/Room/Tutorial.hs @@ -57,12 +57,14 @@ tutAnoTree = do foldMTRS [ tToBTree "TutStartRez" . return . cleatOnward <$> tutRezBox , corDoor - , tToBTree "" . return . cleatOnward <$> (cChasm - <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20)) - , corDoor - , loadAmmoTut - , corDoor +-- , tToBTree "" . return . cleatOnward <$> (cChasm +-- <&> rmPmnts .:~ (sps0 (PutCrit slimeCrit) & plSpot . psPos .~ V2 100 20)) +-- , corDoor +-- , loadAmmoTut +-- , corDoor , chasmSpitTerminal + , corDoor + , tutHub --b , corDoor --b , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns --b , corDoor diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index b3f76a422..2e9cee3a1 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/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