Apply different damage amounts to different materials

src/Dodge/Creature/Damage.hs

@@ -1,36 +1,38 @@
 module Dodge.Creature.Damage (applyCreatureDamage) where
 
-import Linear
+--import Linear
 import Dodge.Material.Damage
 import Data.List
-import Dodge.Creature.Mass
+--import Dodge.Creature.Mass
 import Dodge.Creature.Material
-import Dodge.Creature.Test
+--import Dodge.Creature.Test
 import Dodge.Data.World
-import Dodge.Spark
+--import Dodge.Spark
-import Geometry
+--import Geometry
 import LensHelp
 
 applyCreatureDamage :: [Damage] -> Creature -> World -> World
 applyCreatureDamage dms cr w = foldl' (applyIndividualDamage cr) w dms
 
 applyIndividualDamage :: Creature -> World -> Damage -> World
-applyIndividualDamage cr w dm = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) $
+applyIndividualDamage cr w dm = 
-  case dm of
+    let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w
-    Piercing{} -> applyPiercingDamage cr dm w
+    in w' & damageHP cr i
-    _ -> w & damageHP cr (_dmAmount dm)
+--  case dm of
+--    Piercing{} -> applyPiercingDamage cr dm w
+--    _ -> w & damageHP cr (_dmAmount dm)
 
-applyPiercingDamage :: Creature -> Damage -> World -> World
+--applyPiercingDamage :: Creature -> Damage -> World -> World
-applyPiercingDamage cr dm w
+--applyPiercingDamage cr dm w
-    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
+--    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
-        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
+--        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
-    | otherwise = f . damageHP cr (_dmAmount dm) $ w
+--    | otherwise = f . damageHP cr (_dmAmount dm) $ w
-  where
+--  where
-    f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
+--    f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
-            / V2 x x
+--            / V2 x x
-    x = crMass (_crType cr)
+--    x = crMass (_crType cr)
-    p = _dmPos dm
+--    p = _dmPos dm
-    p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)
+--    p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)
 
 damageHP :: Creature -> Int -> World -> World
 damageHP cr x =

src/Dodge/Data/Material.hs

@@ -6,6 +6,7 @@ module Dodge.Data.Material where
 import Data.Aeson
 import Data.Aeson.TH
 
+-- consider having external and internal materials in some manner
 data Material
     = Wood
     | Dirt

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 :: Damage -> Material -> ECW -> World -> (Int,World)
-damMatSideEffect dm mt = case mt of
+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 :: Damage -> ECW -> World -> (Int,World)
-defDamageMaterial _ _ w = w
+defDamageMaterial dm _ = (dm ^. dmAmount,)
 
-damageStone :: Damage -> ECW -> World -> World
+damageStone :: Damage -> ECW -> World -> (Int,World)
-damageStone dm ecw w =
+damageStone dm ecw w = case dm of
-    w & case dm of
+        Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t)
-        Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
+        Piercing _ p t -> 
-        Piercing _ p t ->
+            f dmam $ makeSpark NormalSpark (outTo p t) (rdir p t)
-            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))
+        Blunt _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Shattering _ p t -> makeDustAt Stone 200 (addZ 20 (outTo p t))
+        Shattering _ p t -> f dmam $ makeDustAt Stone 200 (addZ 20 (outTo p t))
-        Crushing{} -> id
+        Crushing{} -> f dmam $ id
-        Explosive{} -> id
+        Explosive{} -> f dmam $ id
-        Sparking{} -> id
+        Sparking{} -> f 0 $ id
-        Flaming{} -> id
+        Flaming{} -> f 0 $ id
-        Electrical{} -> id
+        Electrical{} -> f 0 $ id
-        Poison{} -> id
+        Poison{} -> f 0 $ id
-        Enterrement{} -> id
+        Enterrement{} -> f 0 $ id
-        Flashing{} -> 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 :: Damage -> ECW -> World -> (Int,World)
-damageMetal dm ecw w =
+damageMetal dm ecw w = case dm of
-    w & case dm of
+        Lasering _ p t -> f 0 $ makeSpark FireSpark (outTo p t) (rdir p t)
-        Lasering _ p t -> makeSpark FireSpark (outTo p t) (rdir p t)
+        Piercing _ p t -> f dmam $
-        Piercing _ p t ->
             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
+        Shattering {} -> f dmam $ id
-        Crushing{} -> id
+        Crushing{} -> f dmam $ id
-        Explosive{} -> id
+        Explosive{} -> f dmam $ id
-        Sparking{} -> id
+        Sparking{} -> f 0 $ id
-        Flaming{} -> id
+        Flaming{} -> f 0 $ id
-        Electrical{} -> id
+        Electrical{} -> f 0 $ id
-        Poison{} -> id
+        Poison{} -> f 0 $ id
-        Enterrement{} -> id
+        Enterrement{} -> f 0 $ id
-        Flashing{} -> 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 :: Damage -> ECW -> World -> (Int,World)
-damageFlesh dm _ w = w & case dm of
+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 ->

src/Dodge/Wall/Damage.hs

@@ -13,17 +13,17 @@ damageWall :: Damage -> Wall -> World -> World
 damageWall dt wl w = case _wlStructure wl of
     MachinePart mcid -> w' & cWorld . lWorld . machines . ix mcid . mcDamage .:~ dt
     BlockPart blid ->
-        w' & cWorld . lWorld . blocks . ix blid . blHP -~ x
+        w' & cWorld . lWorld . blocks . ix blid . blHP -~ dmam
             & maybeDestroyBlock blid
     DoorPart drid ->
-        w' & cWorld . lWorld . doors . ix drid . drHP -~ x
+        w' & cWorld . lWorld . doors . ix drid . drHP -~ dmam
 --            & maybeDestroyDoor drid
     _ -> w'
   where
-    x = case dt of
+--    x = case dt of
-        Explosive y _ -> y * 100
+--        Explosive y _ -> y * 100
-        _ -> dt ^. dmAmount
+--        _ -> dt ^. dmAmount
-    w' = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
+    (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
 
 -- block destruction is convoluted...
 maybeDestroyBlock :: Int -> World -> World