Refactor damages to materials

src/Dodge/Damage.hs

@@ -6,18 +6,19 @@ module Dodge.Damage (
     damageDirection,
     damageCrWlID,
     maxDamageType,
+    damThingHitWith,
 ) where
 
-import Dodge.WorldEvent.ThingsHit
-import Geometry.Data
-import Dodge.Data.Damage.Type
-import Geometry.Vector
-import ListHelp
-import Dodge.Data.CrWlID
-import Dodge.Data.World
-import LensHelp
 import qualified Data.Map.Strict as M
+import Dodge.Data.CrWlID
+import Dodge.Data.Damage.Type
+import Dodge.Data.World
+import Dodge.WorldEvent.ThingsHit
 import FoldableHelp
+import Geometry.Data
+import Geometry.Vector
+import LensHelp
+import ListHelp
 
 damageCrWlID :: Damage -> CrWlID -> World -> World
 damageCrWlID dam = \case
@@ -35,19 +36,19 @@ damageDirection :: [Damage] -> Maybe Float
 damageDirection ds = safeArgV =<< safeHead (ds ^.. each . dmVector)
 
 dmType :: Damage -> DamageType
-dmType = \case 
-    Piercing {} -> PhysicalDamage
-    Blunt {} -> PhysicalDamage
-    Sparking {} -> CookingDamage
-    Crushing {} -> PhysicalDamage
-    Shattering {} -> PhysicalDamage
-    Flaming {} -> CookingDamage
-    Lasering {} -> CookingDamage
-    Flashing {} -> CookingDamage
-    Electrical {} -> CookingDamage
-    Explosive {} -> PhysicalDamage
-    Poison {} -> PoisonDamage
-    Enterrement {} -> PhysicalDamage
+dmType = \case
+    Piercing{} -> PhysicalDamage
+    Blunt{} -> PhysicalDamage
+    Sparking{} -> CookingDamage
+    Crushing{} -> PhysicalDamage
+    Shattering{} -> PhysicalDamage
+    Flaming{} -> CookingDamage
+    Lasering{} -> CookingDamage
+    Flashing{} -> CookingDamage
+    Electrical{} -> CookingDamage
+    Explosive{} -> PhysicalDamage
+    Poison{} -> PoisonDamage
+    Enterrement{} -> PhysicalDamage
 
 collectDamageTypes :: [Damage] -> M.Map DamageType Int
 collectDamageTypes = foldl' (flip f) M.empty
@@ -58,11 +59,24 @@ 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
+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
+
+damThingHitWith ::
+    (Point2 -> Damage) ->
+    Maybe (Point2, Either Creature Wall) ->
+    World ->
+    World
+damThingHitWith f = \case
+    Just (p, Left cr) ->
+        cWorld . lWorld . creatures . ix (_crID cr) . crDamage .:~ f p
+    Just (p, Right wl) ->
+        cWorld . lWorld . wallDamages . at (_wlID wl) . non mempty .:~ f p
+    Nothing -> id