Refactor damages in circles

src/Dodge/Damage.hs

@@ -1,12 +1,15 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Dodge.Damage (
+    damageInCircle,
     damageCrWl,
     damageDirection,
     damageCrWlID,
     maxDamageType,
 ) where
 
+import Dodge.WorldEvent.ThingsHit
+import Geometry.Data
 import Dodge.Data.Damage.Type
 import Geometry.Vector
 import ListHelp
@@ -53,3 +56,13 @@ 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 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

src/Dodge/EnergyBall.hs

@@ -7,14 +7,12 @@ module Dodge.EnergyBall (
     makeMovingEB,
 ) where
 
-import qualified Data.IntMap.Strict as IM
-import Data.List (foldl')
+import Dodge.Damage
 import Data.Maybe
 import Dodge.Base.Collide
 import Dodge.Data.World
 import Dodge.SoundLogic
 import Dodge.Spark
-import Dodge.WorldEvent.ThingsHit
 import Geometry
 import LensHelp
 import Picture
@@ -38,7 +36,7 @@ updateEnergyBall :: World -> EnergyBall -> (World, Maybe EnergyBall)
 updateEnergyBall w eb
     | _ebTimer eb <= 0 = (w, Nothing)
     | otherwise =
-        ( ebEffect eb . ebFlicker eb $ damageCircle (_ebPos eb) (_ebEff eb) w
+        ( ebEffect eb . ebFlicker eb $ ebDamage (_ebPos eb) (_ebEff eb) w
         , Just $ eb & ebTimer -~ 1 & ebPos .~ bp & ebVel .~ drag * bv
         )
   where
@@ -101,18 +99,10 @@ ebColor eb = case eb ^. ebEff of
     ExplosiveBall -> white
     FlashBall -> white
 
-damageCircle :: Point2 -> EnergyBallType -> World -> World
-damageCircle sp dt w =
-    w
-        & cWorld . lWorld . wallDamages %~ addwalldamages
-        & cWorld . lWorld . creatures %~ addcreaturedamages
+ebDamage :: Point2 -> EnergyBallType -> World -> World
+ebDamage sp dt w = damageInCircle (return . (const $ ebtToDamage sp dt)) sp r w
   where
-    addwalldamages wlds = foldl' (damageWlCircle dam) wlds wlstodam
-    addcreaturedamages crs = foldl' (damageCrCircle dam) crs crstodam
-    wlstodam = wlsHitRadial sp r w
-    crstodam = crsHitRadial sp r w
     r = fromMaybe 5 $ dt ^? fbSize
-    dam = ebtToDamage sp dt
 
 ebtToDamage :: Point2 -> EnergyBallType -> Damage
 ebtToDamage p = \case
@@ -121,9 +111,3 @@ ebtToDamage p = \case
     ElectricalBall{} -> Electrical 10
     ExplosiveBall -> Explosive 10 p
     FlashBall -> Flashing 10 p
-
-damageWlCircle :: Damage -> IM.IntMap [Damage] -> (Point2, Wall) -> IM.IntMap [Damage]
-damageWlCircle dam wls (_, wl) = wls & at (_wlID wl) . non mempty .:~ dam
-
-damageCrCircle :: Damage -> IM.IntMap Creature -> (Point2, Creature) -> IM.IntMap Creature
-damageCrCircle dam crs (_, cr) = crs & ix (_crID cr) . crDamage .:~ dam

src/Dodge/Prop/Moving.hs

@@ -3,6 +3,7 @@ module Dodge.Prop.Moving (
     fallSmallBounce,
 ) where
 
+import Dodge.Damage
 import Dodge.Creature.Radius
 import Dodge.Base
 import Dodge.Data.World
@@ -18,8 +19,10 @@ fallSmallBounceDamage pr w =
     p = _prPos pr
     v = _prVel pr
     dodamage
-        | _prPosZ pr < 25 = cWorld . lWorld . creatures %~ fmap dodamage'
+        | _prPosZ pr < 25 = damageInCircle (return . const thedam) p 5
+                -- cWorld . lWorld . creatures . each %~ dodamage'
         | otherwise = id
+    thedam = Crushing (floor . (* 10) . max 0 . subtract 5 . abs $ _prVelZ pr)
     dodamage' cr
         | dist (_crPos cr) p < crRad (cr ^. crType) + 5 =
             cr & crDamage

src/Dodge/Update/Cloud.hs

@@ -1,17 +1,15 @@
-module Dodge.Update.Cloud where
+module Dodge.Update.Cloud (cloudPoisonDamage) where
 
-import Dodge.Creature.Radius
 import Data.Foldable
+import Dodge.Creature.Radius
 import Dodge.Data.World
 import Dodge.Zoning.Creature
 import Geometry.Vector3D
 import LensHelp
 
 cloudPoisonDamage :: Cloud -> World -> World
-cloudPoisonDamage c w = w & dodamagesto (filter f $ crsNearPoint clpos w)
+cloudPoisonDamage c w = foldl' (flip doDam) w (filter f $ crsNearPoint clpos w)
   where
-    dodamagesto :: [Creature] -> World -> World
-    dodamagesto scrs mcrs = foldl' (flip doDam) mcrs scrs
     doDam cr =
         cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ Poison 1
     f cr = dist3 (addZ 20 $ _crPos cr) (_clPos c) < crRad (cr ^. crType) + _clRad c + 10

src/Dodge/Zoning/Creature.hs

@@ -1,9 +1,9 @@
 module Dodge.Zoning.Creature where
 
-import Dodge.Creature.Radius
 import Control.Lens
 import qualified Data.IntSet as IS
 import Data.Maybe
+import Dodge.Creature.Radius
 import Dodge.Data.World
 import Dodge.Zoning.Base
 import Dodge.Zoning.Common
@@ -16,7 +16,10 @@ crIXsNearPoint :: Point2 -> World -> IS.IntSet
 crIXsNearPoint = nearPoint crZoneSize _crZoning
 
 crsNearPoint :: Point2 -> World -> [Creature]
-crsNearPoint p w = mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid) . IS.toList $ crIXsNearPoint p w
+crsNearPoint p w =
+    mapMaybe (\cid -> w ^? cWorld . lWorld . creatures . ix cid)
+        . IS.toList
+        $ crIXsNearPoint p w
 
 crsNearSeg :: Point2 -> Point2 -> World -> [Creature]
 crsNearSeg sp ep w =