Fix crsHitRadial, unify some radial damages

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

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
 

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

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

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)