Add sound on creature piercing damage

This commit is contained in:
2025-06-22 09:19:37 +01:00
parent 4e9739afa5
commit 2db3342532
6 changed files with 565 additions and 482 deletions
+103 -75
View File
@@ -1,80 +1,100 @@
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
import Dodge.Data.World
import Dodge.SoundLogic
import Dodge.Spark
import Dodge.WorldEvent.Cloud
import Geometry
import RandomHelp
damageMaterial ::
Damage ->
Material ->
Float -> -- the direction of the hit surface, in radians
World ->
World
type ECW = Either Creature Wall
damageMaterial :: Damage -> Material -> ECW -> World -> World
damageMaterial dm mt = case mt of
Stone -> damageStone dm
Metal -> damageMetal dm
Flesh -> damageFlesh dm
Dirt -> damageDirt dm
-- Glass -> damageGlass dm
-- Glass -> damageGlass dm
_ -> defDamageMaterial dm
defDamageMaterial :: Damage -> Float -> World -> World
defDamageMaterial :: Damage -> ECW -> World -> World
defDamageMaterial _ _ w = w
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
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)
. 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
rdir p t = argV $ reflectIn v t
where
v = case ecw of
Right wl -> uncurry (-) $ _wlLine wl
Left cr -> vNormal (p - _crPos cr)
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
damageMetal :: Damage -> ECW -> World -> World
damageMetal dm ecw 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, ting2S, ting3S]
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
v = case ecw of
Right wl -> uncurry (-) $ _wlLine wl
Left cr -> undefined
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
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
damageFlesh :: Damage -> ECW -> World -> World
damageFlesh dm ecw w = w & case dm of
Lasering _ p t -> id
Piercing _ p t -> randsound p [blood1S,blood2S,blood4S,blood5S,blood6S,blood7S,blood8S]
Piercing _ p t ->
randsound
p
[ bloodShort1S
, bloodShort2S
, bloodShort3S
, bloodShort4S
, bloodShort5S
, bloodShort6S
, bloodShort7S
, bloodShort8S
]
Blunt _ p t -> id
Shattering _ p t -> id
Crushing{} -> id
@@ -86,32 +106,40 @@ damageFlesh dm dir w = w & case dm of
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
v = case ecw of
Right wl -> uncurry (-) $ _wlLine wl
Left cr -> undefined
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
damageDirt :: Damage -> ECW -> World -> World
damageDirt dm ecw 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
v = case ecw of
Right wl -> uncurry (-) $ _wlLine wl
Left cr -> undefined
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)