From 3019d95520c25f3ad991377ec7b1d1c3bfbdedcf Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 20 Jun 2025 22:17:10 +0100 Subject: [PATCH] Fix crsHitRadial, unify some radial damages --- src/Dodge/Damage.hs | 6 +++--- src/Dodge/EnergyBall.hs | 2 +- src/Dodge/Flame.hs | 31 +++++++++---------------------- src/Dodge/Prop/Moving.hs | 2 +- src/Dodge/WorldEvent/ThingsHit.hs | 12 ++++++------ 5 files changed, 20 insertions(+), 33 deletions(-) diff --git a/src/Dodge/Damage.hs b/src/Dodge/Damage.hs index f1138a840..835a55660 100644 --- a/src/Dodge/Damage.hs +++ b/src/Dodge/Damage.hs @@ -57,12 +57,12 @@ collectDamageTypes = foldl' (flip f) M.empty maxDamageType :: [Damage] -> Maybe (DamageType, Int) maxDamageType = safeMinimumOn (negate . snd) . M.assocs . collectDamageTypes -damageInCircle :: (Point2 -> [Damage]) -> Point2 -> Float -> World -> World +damageInCircle :: (Point2 -> Damage) -> Point2 -> Float -> World -> World damageInCircle f p r w = w & cWorld . lWorld . wallDamages %~ dowldams & cWorld . lWorld . creatures %~ docrdams where dowldams wds = foldl' g wds (wlsHitRadial p r w) docrdams crs = foldl' h crs (crsHitRadial p r w) - g wds (x,wl) = wds & at (_wlID wl) . non mempty <>~ f x - h crs (x,cr) = crs & ix (_crID cr) . crDamage <>~ f x + g wds (x,wl) = wds & at (_wlID wl) . non mempty .:~ f x + h crs (x,cr) = crs & ix (_crID cr) . crDamage .:~ f x diff --git a/src/Dodge/EnergyBall.hs b/src/Dodge/EnergyBall.hs index 44296cfa4..875de0cbc 100644 --- a/src/Dodge/EnergyBall.hs +++ b/src/Dodge/EnergyBall.hs @@ -100,7 +100,7 @@ ebColor eb = case eb ^. ebEff of FlashBall -> white ebDamage :: Point2 -> EnergyBallType -> World -> World -ebDamage sp dt w = damageInCircle (return . (const $ ebtToDamage sp dt)) sp r w +ebDamage sp dt = damageInCircle (const $ ebtToDamage sp dt) sp r where r = fromMaybe 5 $ dt ^? fbSize diff --git a/src/Dodge/Flame.hs b/src/Dodge/Flame.hs index d2ca362b7..44aed3e2e 100644 --- a/src/Dodge/Flame.hs +++ b/src/Dodge/Flame.hs @@ -3,8 +3,8 @@ module Dodge.Flame ( updateFlame, ) where -import Data.Foldable import Dodge.Base.Wall +import Dodge.Damage import Dodge.Data.World import Dodge.Flame.Size import Dodge.SoundLogic @@ -18,34 +18,20 @@ import RandomHelp updateFlame :: World -> Flame -> (World, Maybe Flame) updateFlame w pt - | time <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) + | _flTimer pt <= 0 = (makeFlamerSmokeAt (addZ 20 ep) w, Nothing) | Just (_, Right wl) <- thit = (doupdate, Just $ reflame wl) -- might want to move differently if we hit a creature? | otherwise = (flFlicker pt doupdate, Just mvflame) where reflame wl = pt & flTimer -~ 1 & flVel %~ reflVelWallDamp 0.9 wl - doupdate = soundContinue FlameSound sp fireLoudS (Just 2) dodamage + doupdate = + soundContinue FlameSound sp fireLoudS (Just 2) $ + damageInCircle (const $ Flaming 1) ep r w thit = List.safeHead $ thingsHit sp ep w - time = _flTimer pt sp = _flPos pt ep = sp +.+ _flVel pt - mvflame = - pt - & flTimer -~ 1 - & flPos .~ ep - & flVel *~ 0.98 - dodamage = - foldl' - damcr - (foldl' damwl w (wlsHitRadial ep r w)) - (crsHitRadial ep r w) - r = flameSize pt - damcr w' (_, cr) = - w' & cWorld . lWorld . creatures . ix (_crID cr) . crDamage - .:~ Flaming 1 - damwl w' (_, wl) = - w' & cWorld . lWorld . wallDamages . at (_wlID wl) - . non [] <>~ [Flaming 1] + mvflame = pt & flTimer -~ 1 & flPos .~ ep & flVel *~ 0.98 + r = max 0 $ flameSize pt - 1 flFlicker :: Flame -> World -> World flFlicker pt @@ -55,7 +41,8 @@ flFlicker pt | otherwise = id makeFlame :: Point2 -> Point2 -> World -> World -makeFlame pos vel w = w +makeFlame pos vel w = + w & cWorld . lWorld . flames .:~ Flame t pos vel & randGen .~ g where diff --git a/src/Dodge/Prop/Moving.hs b/src/Dodge/Prop/Moving.hs index d07739183..974670447 100644 --- a/src/Dodge/Prop/Moving.hs +++ b/src/Dodge/Prop/Moving.hs @@ -18,7 +18,7 @@ fallSmallBounceDamage pr w = p = _prPos pr v = _prVel pr dodamage - | _prPosZ pr < 25 = damageInCircle (const [thedam]) p 5 + | _prPosZ pr < 25 = damageInCircle (const thedam) p 5 -- cWorld . lWorld . creatures . each %~ dodamage' | otherwise = id thedam = Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr) v diff --git a/src/Dodge/WorldEvent/ThingsHit.hs b/src/Dodge/WorldEvent/ThingsHit.hs index 428cffa00..a11416615 100644 --- a/src/Dodge/WorldEvent/ThingsHit.hs +++ b/src/Dodge/WorldEvent/ThingsHit.hs @@ -13,6 +13,8 @@ module Dodge.WorldEvent.ThingsHit ( crHit, ) where +import Dodge.Creature.Radius +import Control.Monad import Control.Lens import Data.Bifunctor import qualified Data.IntSet as IS @@ -103,9 +105,7 @@ wlsHitRadial p r = mapMaybe f . wlsNearCirc p r crsHitRadial :: Point2 -> Float -> World -> [(Point2, Creature)] crsHitRadial p r = mapMaybe f . crsNearCirc p r where - f cr - | dist hitpos p <= r = Just (hitpos, cr) - | otherwise = Nothing - where - hitpos = cpos +.+ r *.* normalizeV (p -.- cpos) - cpos = _crPos cr + f cr = do + let cp = _crPos cr + guard $ dist p cp < r + crRad (_crType cr) + return $ (cp + (1 + crRad (_crType cr)) *.* (cp - p), cr)