Refactor damages to materials

2025-06-22 08:31:18 +01:00
parent df3fde5d3e
commit 9fa3e060d7
17 changed files with 576 additions and 609 deletions
@@ -1,39 +1,117 @@
-module Dodge.Material.Damage where
+module Dodge.Material.Damage (damageMaterial) where

+import RandomHelp
+import Dodge.SoundLogic
+import Color
+import Dodge.WorldEvent.Cloud
 import Dodge.Data.World
 import Dodge.Spark
 import Geometry
+import Control.Lens

 damageMaterial ::
    Damage ->
    Material ->
-    Float -> -- the angle of the hit surface, in radians
+    Float -> -- the direction of the hit surface, in radians
    World ->
-    (Int, World)
+    World
 damageMaterial dm mt = case mt of
    Stone -> damageStone dm
+    Metal -> damageMetal dm
+    Flesh -> damageFlesh dm
+    Dirt -> damageDirt dm
+--    Glass -> damageGlass dm
    _ -> defDamageMaterial dm

-defDamageMaterial :: Damage -> Float -> World -> (Int, World)
-defDamageMaterial dm _ w = (_dmAmount dm, w)
+defDamageMaterial :: Damage -> Float -> World -> World
+defDamageMaterial _ _ w = w

-damageStone :: Damage -> Float -> World -> (Int, World)
-damageStone dm dir = case dm of
-    Lasering _ p t -> a 0 $ makeSpark FireSpark (outTo p t) (argV $ reflectIn t v)
-    Piercing x p t -> a x $ makeSpark NormalSpark (outTo p t) (argV $ reflectIn t v)
-    Blunt x p t -> a x $ makeSpark NormalSpark (outTo p t) (argV $ reflectIn t v)
-    Shattering {} -> a 0 id
-    Crushing {} -> a 0 id
-    Explosive {} -> a 0 id
-    Sparking {} -> a 0 id
-    Flaming {} -> a 0 id
-    Electrical {} -> a 0 id
-    Poison {} -> a 0 id
-    Enterrement {} -> a 0 id
-    Flashing {} -> a 0 id
+damageStone :: Damage -> Float -> World -> World
+damageStone dm dir w = w & case dm of
+    Lasering _ p t -> makeSpark FireSpark (outTo p t) (argV $ reflectIn v t)
+    Piercing _ p t -> makeSpark NormalSpark (outTo p t) (argV $ reflectIn v t)
+        . smokeCloudAt white 20 200 1 (addZ 20 (outTo p t))
+        . randsound p [slapS,slap1S]
+    Blunt _ p t -> smokeCloudAt white 20 200 1 (addZ 20 (outTo p t))
+    Shattering _ p t -> smokeCloudAt white 20 200 1 (addZ 20 (outTo p t))
+    Crushing{} -> id
+    Explosive{} -> id
+    Sparking{} -> id
+    Flaming{} -> id
+    Electrical{} -> id
+    Poison{} -> id
+    Enterrement{} -> id
+    Flashing{} -> id
+  where
+    randsound p xs = let (x,g) = runState (takeOne xs) $ _randGen w
+        in soundStart so p x Nothing . set randGen g
+    so = DamageHitSound (w ^. cWorld . lWorld . lClock)
+    v = unitVectorAtAngle dir
+    outTo x t = x -.- squashNormalizeV t
+
+damageMetal :: Damage -> Float -> World -> World
+damageMetal dm dir w = w & case dm of
+    Lasering _ p t -> makeSpark FireSpark (outTo p t) (argV $ reflectIn v t)
+    Piercing _ p t -> makeSpark NormalSpark (outTo p t) (argV $ reflectIn v t)
+        . randsound p [tingS,ting1S]
+    Blunt _ p t -> id
+    Shattering _ p t -> id
+    Crushing{} -> id
+    Explosive{} -> id
+    Sparking{} -> id
+    Flaming{} -> id
+    Electrical{} -> id
+    Poison{} -> id
+    Enterrement{} -> id
+    Flashing{} -> id
  where
    v = unitVectorAtAngle dir
-    a x f w = (x, f w)
+    outTo x t = x -.- squashNormalizeV t
+    randsound p xs = let (x,g) = runState (takeOne xs) $ _randGen w
+        in soundStart so p x Nothing . set randGen g
+    so = DamageHitSound (w ^. cWorld . lWorld . lClock)
+
+damageFlesh :: Damage -> Float -> World -> World
+damageFlesh dm dir w = w & case dm of
+    Lasering _ p t -> id
+    Piercing _ p t -> randsound p [blood1S,blood2S,blood4S,blood5S,blood6S,blood7S,blood8S]
+    Blunt _ p t -> id
+    Shattering _ p t -> id
+    Crushing{} -> id
+    Explosive{} -> id
+    Sparking{} -> id
+    Flaming{} -> id
+    Electrical{} -> id
+    Poison{} -> id
+    Enterrement{} -> id
+    Flashing{} -> id
+  where
+    randsound p xs = let (x,g) = runState (takeOne xs) $ _randGen w
+        in soundStart so p x Nothing . set randGen g
+    so = DamageHitSound (w ^. cWorld . lWorld . lClock)
+    v = unitVectorAtAngle dir
+    outTo x t = x -.- squashNormalizeV t
+
+damageDirt :: Damage -> Float -> World -> World
+damageDirt dm dir w = w & case dm of
+    Lasering _ p t -> makeSpark FireSpark (outTo p t) (argV $ reflectIn v t)
+    Piercing _ p t -> smokeCloudAt orange 20 200 1 (addZ 20 (outTo p t))
+        . randsound p [slapS,slap1S]
+    Blunt _ p t -> smokeCloudAt orange 20 200 1 (addZ 20 (outTo p t))
+    Shattering _ p t -> smokeCloudAt orange 20 200 1 (addZ 20 (outTo p t))
+    Crushing{} -> id
+    Explosive{} -> id
+    Sparking{} -> id
+    Flaming{} -> id
+    Electrical{} -> id
+    Poison{} -> id
+    Enterrement{} -> id
+    Flashing{} -> id
+  where
+    randsound p xs = let (x,g) = runState (takeOne xs) $ _randGen w
+        in soundStart so p x Nothing . set randGen g
+    so = DamageHitSound (w ^. cWorld . lWorld . lClock)
+    v = unitVectorAtAngle dir
    outTo x t = x -.- squashNormalizeV t

 --damageGlass :: Damage -> Float -> World -> (World,Int)