Refactor damages to materials

src/Dodge/Wall/Damage.hs

@@ -6,21 +6,26 @@ module Dodge.Wall.Damage (
     damageWall,
 ) where
 
+import Geometry.Vector
+import Dodge.Material.Damage
 import Dodge.Block
 import Dodge.Data.World
-import Dodge.Wall.DamageEffect
 import LensHelp
 
 -- maybeDestroyDoor should rather happen during the door mechanism update
 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 & maybeDestroyBlock blid
-    DoorPart drid -> w' & cWorld . lWorld . doors . ix drid . drHP -~ x & maybeDestroyDoor drid
+    BlockPart blid ->
+        w' & cWorld . lWorld . blocks . ix blid . blHP -~ x
+            & maybeDestroyBlock blid
+    DoorPart drid ->
+        w' & cWorld . lWorld . doors . ix drid . drHP -~ x
+            & maybeDestroyDoor drid
     _ -> w'
   where
-    x = dt' ^. dmAmount
-    (w', dt') = damageWallEffect dt wl w
+    x = dt ^. dmAmount
+    w' = damageMaterial dt (_wlMaterial wl) (argV $ uncurry (-) (_wlLine wl)) w
 
 -- block destruction is convoluted...
 maybeDestroyBlock :: Int -> World -> World

src/Dodge/Wall/DamageEffect.hs

@@ -1,116 +0,0 @@
-{-# LANGUAGE TupleSections #-}
-module Dodge.Wall.DamageEffect where
-
-import Dodge.Base.Wall
-import Dodge.Block
-import Dodge.Data.World
-import Dodge.Spark
-import Dodge.Wall.Dust
-import Geometry
-import LensHelp
-
-damageWallEffect :: Damage -> Wall -> World -> (World, Damage)
-damageWallEffect dm wl = (,dm) . case _wlMaterial wl of
-    Stone -> stoneWallDamage dm wl
-    Glass -> glassWallDamage dm wl
-    Dirt -> dirtWallDamage dm wl
-    Crystal -> crystalWallDamage dm wl
-    Metal -> stoneWallDamage dm wl
-    Wood -> stoneWallDamage dm wl
-    Electronics -> stoneWallDamage dm wl
-    Flesh -> stoneWallDamage dm wl
-
--- there is quite a lot of duplication here, should be sorted out
-
-stoneWallDamage :: Damage -> Wall -> World -> World
-stoneWallDamage dm wl = case dm of
-    Piercing _ p t -> makeSpark NormalSpark (outTo p t) 
-        (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
-    Lasering _ p t ->  makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
-    Blunt _ p t -> wlDustAt wl (outTo p t)
-    Shattering _ p t -> muchWlDustAt wl (outTo p t)
-    Crushing {} -> id
-    Explosive {} -> id
-    Sparking {} -> id
-    Flaming {} -> id
-    Electrical {} -> id
-    Poison {} -> id
-    Enterrement {} -> id
-    Flashing {} -> id
-  where
-    outTo x y = x -.- squashNormalizeV y
---    d = _dmAmount dm
---    sp = _dmFrom dm
---    p = _dmAt dm
---    outTo = p +.+ squashNormalizeV (sp -.- p)
-
-glassWallDamage :: Damage -> Wall -> World -> World
-glassWallDamage dm wl w =
-    w & case dm of
-        Lasering _ p t ->  makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
-        Piercing _ p t -> dosplint . makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
-        Blunt _ p t -> dosplint . wlDustAt wl (outTo p t)
-        Shattering _ p t -> dosplint . muchWlDustAt wl (outTo p t)
-        Crushing {} -> dosplint
-        Explosive {} -> dosplint
-        Sparking {} -> id
-        Flaming {} -> id
-        Electrical {} -> id
-        Poison {} -> id
-        Enterrement {} -> id
-        Flashing {} -> id
-  where
-    mbl = do
-        blid <- wl ^? wlStructure . wsBlock
-        w ^? cWorld . lWorld . blocks . ix blid
---    d :: Int
---    d = max 1 $ maybe 1 (subtract 1 . _blHP) mbl
-    dosplint = maybe id splinterBlock mbl
---    sp = _dmFrom dm
---    p = _dmAt dm
-    --outTo = p +.+ squashNormalizeV (sp -.- p)
-    outTo p t = p -.- squashNormalizeV t
-
-crystalWallDamage :: Damage -> Wall -> World -> World
-crystalWallDamage dm wl = case dm of
-    Lasering _ p t ->  makeSpark FireSpark (outTo p t) (reflDirWall p (p+t) wl)
-    Piercing _ p t -> makeSpark NormalSpark (outTo p t) (reflDirWall p (p+t) wl) . wlDustAt wl (outTo p t)
-    Blunt _ p t -> wlDustAt wl (outTo p t)
-    Shattering _ p t -> muchWlDustAt wl (outTo p t)
-    Crushing {} -> id
-    Explosive {} -> id
-    Sparking {} -> id
-    Flaming {} -> id
-    Electrical {} -> id
-    Poison {} -> id
-    Enterrement {} -> id
-    Flashing {} -> id
-  where
---    a x f w = (f w)
-    --d = _dmAmount dm
-    --sp = _dmFrom dm
-    --p = _dmAt dm
-    --outTo = p +.+ squashNormalizeV (sp -.- p)
-    outTo p t = p -.- squashNormalizeV t
-
-dirtWallDamage :: Damage -> Wall -> World -> World
-dirtWallDamage dm wl = case dm of
-    Lasering _ p t -> wlDustAt wl (outTo p t)
-    Piercing _ p t -> wlDustAt wl (outTo p t)
-    Blunt _ p t -> wlDustAt wl (outTo p t)
-    Shattering _ p t -> muchWlDustAt wl (outTo p t)
-    Crushing _ _ -> id
-    Explosive _ _ -> id
-    Sparking {} -> id
-    Flaming {} -> id
-    Electrical {} -> id
-    Poison {} -> id
-    Enterrement {} -> id
-    Flashing {} -> id
-  where
-    --a x f w = (f w)
-    --d = _dmAmount dm
-    --sp = _dmFrom dm
-    --p = _dmAt dm
-    --outTo = p +.+ squashNormalizeV (sp -.- p)
-    outTo p t = p -.- squashNormalizeV t