Apply different damage amounts to different materials

src/Dodge/Material/Damage.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 module Dodge.Material.Damage (damMatSideEffect) where
 
 import Linear
@@ -11,8 +13,8 @@ import RandomHelp
 
 type ECW = Either Creature Wall
 
-damMatSideEffect :: Damage -> Material -> ECW -> World -> World
-damMatSideEffect dm mt = case mt of
+damMatSideEffect :: Damage -> Material -> ECW -> World -> (Int,World)
+damMatSideEffect dm = \case
     Stone -> damageStone dm
     Metal -> damageMetal dm
     Flesh -> damageFlesh dm
@@ -20,28 +22,29 @@ damMatSideEffect dm mt = case mt of
     --    Glass -> damageGlass dm
     _ -> defDamageMaterial dm
 
-defDamageMaterial :: Damage -> ECW -> World -> World
-defDamageMaterial _ _ w = w
+defDamageMaterial :: Damage -> ECW -> World -> (Int,World)
+defDamageMaterial dm _ = (dm ^. dmAmount,)
 
-damageStone :: Damage -> ECW -> World -> World
-damageStone dm ecw w =
-    w & case dm of
-        Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
-        Piercing _ p t ->
-            makeSpark NormalSpark (outTo p t) (rdir p t)
+damageStone :: Damage -> ECW -> World -> (Int,World)
+damageStone dm ecw w = case dm of
+        Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t)
+        Piercing _ p t -> 
+            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
                 . makeDustAt Stone 200 (addZ 20 (outTo p t))
                 . randsound p [slapS, slap1S]
-        Blunt _ p t -> makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Crushing{} -> id
-        Explosive{} -> id
-        Sparking{} -> id
-        Flaming{} -> id
-        Electrical{} -> id
-        Poison{} -> id
-        Enterrement{} -> id
-        Flashing{} -> id
+        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Crushing{} -> f dmam $ id
+        Explosive{} -> f dmam $ id
+        Sparking{} -> f 0 $ id
+        Flaming{} -> f 0 $ id
+        Electrical{} -> f 0 $ id
+        Poison{} -> f 0 $ id
+        Enterrement{} -> f 0 $ id
+        Flashing{} -> f 0 $ id
   where
+    f x g = (x, g w)
+    dmam = dm ^. dmAmount
     rdir p t = argV $ reflectIn v t
       where
         v = case ecw of
@@ -53,26 +56,27 @@ damageStone dm ecw w =
     so = DamageHitSound (w ^. cWorld . lWorld . lClock)
     outTo x t = x -.- squashNormalizeV t
 
-damageMetal :: Damage -> ECW -> World -> World
-damageMetal dm ecw w =
-    w & case dm of
-        Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
-        Piercing _ p t ->
+damageMetal :: Damage -> ECW -> World -> (Int,World)
+damageMetal dm ecw w = case dm of
+        Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t)
+        Piercing _ p t -> f dmam $
             makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [tingS, ting1S, ting2S, ting3S, ting4S, ting5S]
-        Blunt _ p t ->
+        Blunt _ p t -> f dmam $
             makeSpark NormalSpark (outTo p t) (rdir p t)
                 . randsound p [clangS,clang1S,clang2S]
-        Shattering {} -> id
-        Crushing{} -> id
-        Explosive{} -> id
-        Sparking{} -> id
-        Flaming{} -> id
-        Electrical{} -> id
-        Poison{} -> id
-        Enterrement{} -> id
-        Flashing{} -> id
+        Shattering {} -> f dmam $ id
+        Crushing{} -> f dmam $ id
+        Explosive{} -> f dmam $ id
+        Sparking{} -> f 0 $ id
+        Flaming{} -> f 0 $ id
+        Electrical{} -> f 0 $ id
+        Poison{} -> f 0 $ id
+        Enterrement{} -> f 0 $ id
+        Flashing{} -> f 0 $ id
   where
+    f x g = (x, g w)
+    dmam = dm ^. dmAmount
     rdir p t = argV $ reflectIn v t
       where
         v = case ecw of
@@ -84,8 +88,8 @@ damageMetal dm ecw w =
          in soundStart so p x Nothing . set randGen g
     so = DamageHitSound (w ^. cWorld . lWorld . lClock)
 
-damageFlesh :: Damage -> ECW -> World -> World
-damageFlesh dm _ w = w & case dm of
+damageFlesh :: Damage -> ECW -> World -> (Int,World)
+damageFlesh dm _ w = (dm ^. dmAmount,) $ w & case dm of
     Lasering {} -> id
     Piercing _ p t ->
         randsound
@@ -117,9 +121,9 @@ damageFlesh dm _ w = w & case dm of
     so = DamageHitSound (w ^. cWorld . lWorld . lClock)
     outTo x t = x -.- squashNormalizeV t
 
-damageDirt :: Damage -> ECW -> World -> World
+damageDirt :: Damage -> ECW -> World -> (Int,World)
 damageDirt dm _ w =
-    w & case dm of
+    (dm^. dmAmount,) $ w & case dm of
         Lasering _ p t -> --  makeSpark FireSpark (outTo p t) (rdir p t)
             makeDustAt Dirt 200 (addZ 20 (outTo p t))
         Piercing _ p t ->