Apply different damage amounts to different materials

2025-10-24 10:08:36 +01:00
parent b2265297b5
commit 9a3c642684
4 changed files with 72 additions and 65 deletions
@@ -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 Geometry
+--import Dodge.Spark
+--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) $
-  case dm of
-    Piercing{} -> applyPiercingDamage cr dm w
-    _ -> w & damageHP cr (_dmAmount dm)
+applyIndividualDamage cr w dm = 
+    let (i,w') = damMatSideEffect dm (crMaterial (_crType cr)) (Left cr) w
+    in w' & damageHP cr i
+--  case dm of
+--    Piercing{} -> applyPiercingDamage cr dm w
+--    _ -> w & damageHP cr (_dmAmount dm)

-applyPiercingDamage :: Creature -> Damage -> World -> World
-applyPiercingDamage cr dm w
-    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
-        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
-    | otherwise = f . damageHP cr (_dmAmount dm) $ w
-  where
-    f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
-            / V2 x x
-    x = crMass (_crType cr)
-    p = _dmPos dm
-    p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)
+--applyPiercingDamage :: Creature -> Damage -> World -> World
+--applyPiercingDamage cr dm w
+--    | crIsArmouredFrom (w ^. cWorld . lWorld . items) p cr 
+--        = f . makeSpark NormalSpark p1 (argV (p1 - p)) $ w
+--    | otherwise = f . damageHP cr (_dmAmount dm) $ w
+--  where
+--    f = cWorld . lWorld . creatures . ix (_crID cr) . crPos . _xy +~ _dmVector dm
+--            / V2 x x
+--    x = crMass (_crType cr)
+--    p = _dmPos dm
+--    p1 = p + 2 *.* squashNormalizeV (p - cr ^. crPos . _xy)

 damageHP :: Creature -> Int -> World -> World
 damageHP cr x =
@@ -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
@@ -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 ->
@@ -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
-        Explosive y _ -> y * 100
-        _ -> dt ^. dmAmount
-    w' = damMatSideEffect dt (_wlMaterial wl) (Right wl) w
+--    x = case dt of
+--        Explosive y _ -> y * 100
+--        _ -> dt ^. dmAmount
+    (dmam,w') = damMatSideEffect dt (_wlMaterial wl) (Right wl) w

 -- block destruction is convoluted...
 maybeDestroyBlock :: Int -> World -> World