Refactor material sounds

This commit is contained in:
2022-06-19 21:21:33 +01:00
parent 08e5df07e2
commit 8d81104f5f
14 changed files with 236 additions and 231 deletions
+3 -12
View File
@@ -1,7 +1,7 @@
module Dodge.Block where
import Dodge.Data
import Dodge.Material
--import Dodge.Block.Debris
import Dodge.SoundLogic
import Dodge.Zone
import Dodge.WorldEvent.Sound
import Dodge.Wall.Delete
@@ -18,13 +18,13 @@ import Control.Lens
splinterBlock :: Block -> World -> World
splinterBlock bl w = foldr unshadowBlock w (_blShadows bl) -- foldr shiftTowardCen w (_blWallIDs bl)
& matSplintSound bm cen
& originsIDsAt [MaterialSound bm 0,MaterialSound bm 1,MaterialSound bm 2]
(weakenMatS bm) (_blPos bl)
where
bm = fromMaybe Stone $ do
wlids <- w ^? blocks . ix (_blID bl) . blWallIDs
(wlid,_) <- IS.minView wlids
w ^? walls . ix wlid . wlMaterial
cen = centroid $ fst . _wlLine <$> IM.restrictKeys (_walls w) (_blWallIDs bl)
unshadowBlock :: Int -> World -> World
unshadowBlock wlid w = case w ^? walls . ix wlid of
@@ -35,15 +35,6 @@ unshadowBlock wlid w = case w ^? walls . ix wlid of
(x,y) = zoneOfPoint $ uncurry pHalf (_wlLine wl)
Nothing -> w
matSplintSound :: Material -> Point2 -> World -> World
matSplintSound mat = case mat of
Glass -> mkSoundSplinterGlass
Stone -> mkSoundSplinterBlock
Crystal -> mkSoundSplinterBlock
Dirt -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
Wood -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
Metal -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
checkBlockHP :: Block -> World -> World
checkBlockHP bl
| _blHP bl < 1 = destroyBlock bl
+2 -11
View File
@@ -1,7 +1,7 @@
module Dodge.Block.Debris where
import Dodge.Material
import Dodge.Prop.Moving
import Dodge.WorldEvent.Sound
import Dodge.SoundLogic
--import Dodge.Zone
import Dodge.Base
import Dodge.Data
@@ -31,7 +31,7 @@ makeDebrisDirected :: Float -> Float
makeDebrisDirected mindist maxdist arcrad dir bm p w = w
& flip (foldr (plNew props pjID)) thedebris
& randGen .~ newg
& matDesSound bm p
& originsIDsAt [MaterialSound bm i | i <- [0,1,2]] (destroyMatS bm) p
where
someDebris = case bm of
Stone -> stoneDebris
@@ -92,12 +92,3 @@ shardShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPo
debrisShape :: Float -> Prop -> Shape
debrisShape size pr = colorSH (_pjColor pr) . translateSHz (-size) $ upperPrismPoly (2*size) $ square size
matDesSound :: Material -> Point2 -> World -> World
matDesSound mat = case mat of
Glass -> mkSoundBreakGlass
Crystal -> mkSoundBreakGlass -- this should be more crunchy
Stone -> mkSoundSplinterBlock
Dirt -> originIDsAt (BlockDegradeSound 1) [impact1S,impact3S]
Wood -> originIDsAt (BlockDegradeSound 1) [impact1S,impact2S,impact3S]
Metal -> originIDsAt (BlockDegradeSound 1) [impact2S,impact3S]
+2 -1
View File
@@ -3,6 +3,7 @@ module Dodge.Creature.Lamp
, colorLamp
) where
import Dodge.Data
import Dodge.Material
import Dodge.Default
import Dodge.Creature.Picture
import Dodge.LightSource
@@ -57,7 +58,7 @@ updateLamp :: Float -> Int -> Creature -> World -> World
updateLamp h i cr w
| _crHP cr < 0 = w
& explosionFlashAt cpos
& mkSoundBreakGlass cpos
& originsIDsAt [MaterialSound Glass n | n <- [0,1,2]] (destroyMatS Glass) cpos
& lightSources . at i .~ Nothing
& creatures . at cid .~ Nothing
| otherwise = w
+2
View File
@@ -9,6 +9,7 @@ circular imports are probably not a good idea.
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data
( module Dodge.Data
, module Dodge.Data.Material
, module Dodge.Data.Wall
, module Dodge.Combine.Data
, module Dodge.Distortion.Data
@@ -28,6 +29,7 @@ module Dodge.Data
, module Dodge.Data.Room
) where
import Dodge.Data.Room
import Dodge.Data.Material
import Dodge.Data.Wall
import Dodge.RoomCluster.Data
import Dodge.Data.ItemAmount
+7
View File
@@ -0,0 +1,7 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Material where
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
deriving (Eq,Ord,Show,Bounded,Enum)
+2
View File
@@ -1,5 +1,6 @@
module Dodge.Data.SoundOrigin
where
import Dodge.Data.Material
data SoundOrigin = InventorySound
| BackgroundSound
| OnceSound
@@ -20,6 +21,7 @@ data SoundOrigin = InventorySound
| CrHitSound Int
| BarrelHiss Int
| GlassBreakSound Int
| MaterialSound Material Int
| TeleSound Int
| LeverSound Int
| Explosion Int
+1 -2
View File
@@ -3,6 +3,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
module Dodge.Data.Wall where
import Dodge.Data.Material
import Geometry
import Color
import ShapePicture
@@ -39,8 +40,6 @@ data WallStructure
{ _wlStCreature :: Int
-- , _wlStDamCreature :: Damage -> Wall -> Int -> World -> World
}
data Material = Wood | Dirt | Stone | Glass | Metal | Crystal
deriving (Eq,Ord,Show,Bounded,Enum)
makeLenses ''Wall
makeLenses ''WallStructure
makeLenses ''Opacity
+22
View File
@@ -0,0 +1,22 @@
module Dodge.Material where
import Dodge.Data.Material
import Dodge.SoundLogic.ExternallyGeneratedSounds
import Sound.Data
destroyMatS :: Material -> [SoundID]
destroyMatS mat = case mat of
Glass -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
Crystal -> [glassShat1S,glassShat2S,glassShat3S,glassShat4S]
Stone -> [stone1S,stone3S]
Dirt -> [stone1S,stone3S]
Wood -> [stone1S,stone3S]
Metal -> [metal2S,metal4S]
weakenMatS :: Material -> [SoundID]
weakenMatS mat = case mat of
Glass -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
Crystal -> [smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
Stone -> [stone1S,stone3S]
Dirt -> [stone1S,stone3S]
Wood -> [stone1S,stone3S]
Metal -> [metal2S,metal4S]
+189 -189
View File
@@ -1,72 +1,72 @@
-- generated at 2022-05-21 09:06:32.926791584 UTC
-- generated at 2022-06-19 19:56:56.88468711 UTC
module Dodge.SoundLogic.ExternallyGeneratedSounds where
import Sound.Data
soundToVol :: SoundID -> Float
soundToVol v = case _getSoundID v of
0 -> 500
1 -> 500
2 -> 1000
3 -> 2000
4 -> 500
5 -> 1000
6 -> 40
7 -> 100
2 -> 2000
3 -> 500
4 -> 1000
5 -> 40
6 -> 100
7 -> 500
8 -> 500
9 -> 500
10 -> 300
11 -> 40
12 -> 2000
9 -> 300
10 -> 40
11 -> 2000
12 -> 50
13 -> 50
14 -> 50
15 -> 2000
16 -> 200
17 -> 40
18 -> 300
19 -> 2000
20 -> 500
21 -> 100
22 -> 1000
23 -> 100
24 -> 1000
25 -> 40
26 -> 2000
27 -> 50
28 -> 1000
29 -> 2000
30 -> 50
31 -> 1000
32 -> 8000
33 -> 2000
14 -> 2000
15 -> 200
16 -> 40
17 -> 300
18 -> 2000
19 -> 500
20 -> 100
21 -> 1000
22 -> 100
23 -> 1000
24 -> 40
25 -> 2000
26 -> 50
27 -> 2000
28 -> 50
29 -> 1000
30 -> 8000
31 -> 2000
32 -> 2000
33 -> 1000
34 -> 2000
35 -> 2000
36 -> 100
35 -> 100
36 -> 40
37 -> 40
38 -> 40
39 -> 2000
40 -> 100
41 -> 40
42 -> 1000
43 -> 300
44 -> 300
45 -> 2000
38 -> 2000
39 -> 100
40 -> 40
41 -> 300
42 -> 300
43 -> 2000
44 -> 1000
45 -> 1000
46 -> 1000
47 -> 1000
48 -> 1000
49 -> 40
50 -> 50
51 -> 500
52 -> 500
53 -> 20
54 -> 500
55 -> 300
56 -> 500
57 -> 1000
47 -> 40
48 -> 50
49 -> 500
50 -> 500
51 -> 1000
52 -> 20
53 -> 500
54 -> 300
55 -> 500
56 -> 1000
57 -> 2000
58 -> 2000
59 -> 2000
60 -> 500
61 -> 2000
62 -> 100
63 -> 300
59 -> 500
60 -> 2000
61 -> 100
62 -> 300
63 -> 1000
64 -> 100
65 -> 2000
66 -> 1000
@@ -82,68 +82,68 @@ soundToOnomato :: SoundID -> String
soundToOnomato v = case _getSoundID v of
0 -> "DEDUM"
1 -> "SCREE"
2 -> "CRISH"
3 -> "BRDBRDBRD"
4 -> "DEDEDA"
5 -> "CRNK"
6 -> "CLNK"
7 -> "WRR"
8 -> "TINKLE"
9 -> "TRINKL"
10 -> "BWAAH"
11 -> "TIP"
12 -> "TATATA"
13 -> "BLIH"
14 -> "HMM"
15 -> "PEW"
16 -> "CRAKLE"
17 -> "TAP"
18 -> "DWAAH"
19 -> "BANGG"
20 -> "CRTINK"
21 -> "PHF"
22 -> "ZHM"
23 -> "THUD"
24 -> "CRUNK"
25 -> "TAPTIP"
26 -> "CHUGUGUG"
27 -> "HSSS"
28 -> "CRUMPLE"
29 -> "BOOM"
30 -> "HSS"
31 -> "TAKH"
32 -> "RINGGG"
33 -> "CRH"
34 -> "UGGAUGGA"
35 -> "CREUH"
36 -> "SMACK"
37 -> "CLICK"
38 -> "TIPTOP"
39 -> "CRUH"
40 -> "CHNKCHNKCHUNK"
41 -> "TIPTAP"
42 -> "CRASH"
43 -> "TNKTNKTNK"
44 -> "CHPCHPCHP"
45 -> "SCREE"
46 -> "BRAP"
47 -> "CRSK"
48 -> "CRNKL"
49 -> "TAPP"
50 -> "SHUHP"
51 -> "DEDEDUM"
52 -> "TAK"
53 -> "SWSH"
54 -> "BIPBIPBIP"
55 -> "BEP"
56 -> "KRTNKL"
57 -> "CRSNK"
58 -> "CHUGUGUG"
59 -> "BANG"
60 -> "DEDA"
61 -> "WHSSH"
62 -> "HNH"
63 -> "BWAH"
2 -> "BRDBRDBRD"
3 -> "DEDEDA"
4 -> "CRNK"
5 -> "CLNK"
6 -> "WRR"
7 -> "TINKLE"
8 -> "TRINKL"
9 -> "BWAAH"
10 -> "TIP"
11 -> "TATATA"
12 -> "BLIH"
13 -> "HMM"
14 -> "PEW"
15 -> "CRAKLE"
16 -> "TAP"
17 -> "DWAAH"
18 -> "BANGG"
19 -> "CRTINK"
20 -> "PHF"
21 -> "ZHM"
22 -> "THUD"
23 -> "CRASH"
24 -> "TAPTIP"
25 -> "CHUGUGUG"
26 -> "HSSS"
27 -> "BOOM"
28 -> "HSS"
29 -> "TAKH"
30 -> "RINGGG"
31 -> "CRH"
32 -> "UGGAUGGA"
33 -> "CRUMPLE"
34 -> "CREUH"
35 -> "SMACK"
36 -> "CLICK"
37 -> "TIPTOP"
38 -> "CRUH"
39 -> "CHNKCHNKCHUNK"
40 -> "TIPTAP"
41 -> "TNKTNKTNK"
42 -> "CHPCHPCHP"
43 -> "SCREE"
44 -> "BRAP"
45 -> "CRSK"
46 -> "CRNKL"
47 -> "TAPP"
48 -> "SHUHP"
49 -> "DEDEDUM"
50 -> "TAK"
51 -> "CRISH"
52 -> "SWSH"
53 -> "BIPBIPBIP"
54 -> "BEP"
55 -> "KRTNKL"
56 -> "CRSNK"
57 -> "CHUGUGUG"
58 -> "BANG"
59 -> "DEDA"
60 -> "WHSSH"
61 -> "HNH"
62 -> "BWAH"
63 -> "CRUNK"
64 -> "DRR"
65 -> "BRAP"
66 -> "BLPCHCH"
@@ -159,7 +159,6 @@ soundPathList :: [String]
soundPathList =
[ "dedum.DEDUM.500.wav"
, "tone440sawtoothquiet.SCREE.500.wav"
, "impact4.CRISH.1000.wav"
, "mini1.BRDBRDBRD.2000.wav"
, "dededa.DEDEDA.500.wav"
, "glassShat3.CRNK.1000.wav"
@@ -181,17 +180,17 @@ soundPathList =
, "whiteNoiseFadeOut.PHF.100.wav"
, "tele.ZHM.1000.wav"
, "hit.THUD.100.wav"
, "impact2.CRUNK.1000.wav"
, "stone1.CRASH.1000.wav"
, "twoStep1.TAPTIP.40.wav"
, "seagullChatter.CHUGUGUG.2000.wav"
, "foamSprayLoop.HSSS.50.wav"
, "impact3.CRUMPLE.1000.wav"
, "explosion.BOOM.2000.wav"
, "foamSprayFadeOut.HSS.50.wav"
, "tap2.TAKH.1000.wav"
, "tinitus.RINGGG.8000.wav"
, "seagullCry1.CRH.2000.wav"
, "seagullBark.UGGAUGGA.2000.wav"
, "stone3.CRUMPLE.1000.wav"
, "seagullCry2.CREUH.2000.wav"
, "hit1.SMACK.100.wav"
, "click1.CLICK.40.wav"
@@ -199,7 +198,6 @@ soundPathList =
, "seagullCry.CRUH.2000.wav"
, "crankSlow.CHNKCHNKCHUNK.100.wav"
, "twoStep.TIPTAP.40.wav"
, "impact1.CRASH.1000.wav"
, "reload.TNKTNKTNK.300.wav"
, "reload1.CHPCHPCHP.300.wav"
, "tone440sawtooth.SCREE.2000.wav"
@@ -210,6 +208,7 @@ soundPathList =
, "pickUp.SHUHP.50.wav"
, "dededum.DEDEDUM.500.wav"
, "tap1.TAK.500.wav"
, "metal4.CRISH.1000.wav"
, "knife.SWSH.20.wav"
, "computerBeeping.BIPBIPBIP.500.wav"
, "tone440.BEP.300.wav"
@@ -221,6 +220,7 @@ soundPathList =
, "missileLaunch.WHSSH.2000.wav"
, "grunt.HNH.100.wav"
, "sineRaisePitchOneSec.BWAH.300.wav"
, "metal2.CRUNK.1000.wav"
, "slideDoor.DRR.100.wav"
, "autoGun.BRAP.2000.wav"
, "oldMachineBoot.BLPCHCH.1000.wav"
@@ -236,130 +236,130 @@ dedumS :: SoundID
dedumS = SoundID 0
tone440sawtoothquietS :: SoundID
tone440sawtoothquietS = SoundID 1
impact4S :: SoundID
impact4S = SoundID 2
mini1S :: SoundID
mini1S = SoundID 3
mini1S = SoundID 2
dededaS :: SoundID
dededaS = SoundID 4
dededaS = SoundID 3
glassShat3S :: SoundID
glassShat3S = SoundID 5
glassShat3S = SoundID 4
tapQuietS :: SoundID
tapQuietS = SoundID 6
tapQuietS = SoundID 5
fireS :: SoundID
fireS = SoundID 7
fireS = SoundID 6
smallGlass4S :: SoundID
smallGlass4S = SoundID 8
smallGlass4S = SoundID 7
smallGlass1S :: SoundID
smallGlass1S = SoundID 9
smallGlass1S = SoundID 8
sineRaisePitchTwoSecS :: SoundID
sineRaisePitchTwoSecS = SoundID 10
sineRaisePitchTwoSecS = SoundID 9
foot1S :: SoundID
foot1S = SoundID 11
foot1S = SoundID 10
autoBS :: SoundID
autoBS = SoundID 12
autoBS = SoundID 11
healS :: SoundID
healS = SoundID 13
healS = SoundID 12
fridgeHumS :: SoundID
fridgeHumS = SoundID 14
fridgeHumS = SoundID 13
seagullWhistle1S :: SoundID
seagullWhistle1S = SoundID 15
seagullWhistle1S = SoundID 14
elecCrackleS :: SoundID
elecCrackleS = SoundID 16
elecCrackleS = SoundID 15
foot2S :: SoundID
foot2S = SoundID 17
foot2S = SoundID 16
skwareFadeTwoSecS :: SoundID
skwareFadeTwoSecS = SoundID 18
skwareFadeTwoSecS = SoundID 17
bangEchoS :: SoundID
bangEchoS = SoundID 19
bangEchoS = SoundID 18
smallGlass3S :: SoundID
smallGlass3S = SoundID 20
smallGlass3S = SoundID 19
whiteNoiseFadeOutS :: SoundID
whiteNoiseFadeOutS = SoundID 21
whiteNoiseFadeOutS = SoundID 20
teleS :: SoundID
teleS = SoundID 22
teleS = SoundID 21
hitS :: SoundID
hitS = SoundID 23
impact2S :: SoundID
impact2S = SoundID 24
hitS = SoundID 22
stone1S :: SoundID
stone1S = SoundID 23
twoStep1S :: SoundID
twoStep1S = SoundID 25
twoStep1S = SoundID 24
seagullChatterS :: SoundID
seagullChatterS = SoundID 26
seagullChatterS = SoundID 25
foamSprayLoopS :: SoundID
foamSprayLoopS = SoundID 27
impact3S :: SoundID
impact3S = SoundID 28
foamSprayLoopS = SoundID 26
explosionS :: SoundID
explosionS = SoundID 29
explosionS = SoundID 27
foamSprayFadeOutS :: SoundID
foamSprayFadeOutS = SoundID 30
foamSprayFadeOutS = SoundID 28
tap2S :: SoundID
tap2S = SoundID 31
tap2S = SoundID 29
tinitusS :: SoundID
tinitusS = SoundID 32
tinitusS = SoundID 30
seagullCry1S :: SoundID
seagullCry1S = SoundID 33
seagullCry1S = SoundID 31
seagullBarkS :: SoundID
seagullBarkS = SoundID 34
seagullBarkS = SoundID 32
stone3S :: SoundID
stone3S = SoundID 33
seagullCry2S :: SoundID
seagullCry2S = SoundID 35
seagullCry2S = SoundID 34
hit1S :: SoundID
hit1S = SoundID 36
hit1S = SoundID 35
click1S :: SoundID
click1S = SoundID 37
click1S = SoundID 36
twoStepSlowS :: SoundID
twoStepSlowS = SoundID 38
twoStepSlowS = SoundID 37
seagullCryS :: SoundID
seagullCryS = SoundID 39
seagullCryS = SoundID 38
crankSlowS :: SoundID
crankSlowS = SoundID 40
crankSlowS = SoundID 39
twoStepS :: SoundID
twoStepS = SoundID 41
impact1S :: SoundID
impact1S = SoundID 42
twoStepS = SoundID 40
reloadS :: SoundID
reloadS = SoundID 43
reloadS = SoundID 41
reload1S :: SoundID
reload1S = SoundID 44
reload1S = SoundID 42
tone440sawtoothS :: SoundID
tone440sawtoothS = SoundID 45
tone440sawtoothS = SoundID 43
tap3S :: SoundID
tap3S = SoundID 46
tap3S = SoundID 44
glassShat4S :: SoundID
glassShat4S = SoundID 47
glassShat4S = SoundID 45
glassShat2S :: SoundID
glassShat2S = SoundID 48
glassShat2S = SoundID 46
foot3S :: SoundID
foot3S = SoundID 49
foot3S = SoundID 47
pickUpS :: SoundID
pickUpS = SoundID 50
pickUpS = SoundID 48
dededumS :: SoundID
dededumS = SoundID 51
dededumS = SoundID 49
tap1S :: SoundID
tap1S = SoundID 52
tap1S = SoundID 50
metal4S :: SoundID
metal4S = SoundID 51
knifeS :: SoundID
knifeS = SoundID 53
knifeS = SoundID 52
computerBeepingS :: SoundID
computerBeepingS = SoundID 54
computerBeepingS = SoundID 53
tone440S :: SoundID
tone440S = SoundID 55
tone440S = SoundID 54
smallGlass2S :: SoundID
smallGlass2S = SoundID 56
smallGlass2S = SoundID 55
glassShat1S :: SoundID
glassShat1S = SoundID 57
glassShat1S = SoundID 56
seagullChatter1S :: SoundID
seagullChatter1S = SoundID 58
seagullChatter1S = SoundID 57
bangS :: SoundID
bangS = SoundID 59
bangS = SoundID 58
dedaS :: SoundID
dedaS = SoundID 60
dedaS = SoundID 59
missileLaunchS :: SoundID
missileLaunchS = SoundID 61
missileLaunchS = SoundID 60
gruntS :: SoundID
gruntS = SoundID 62
gruntS = SoundID 61
sineRaisePitchOneSecS :: SoundID
sineRaisePitchOneSecS = SoundID 63
sineRaisePitchOneSecS = SoundID 62
metal2S :: SoundID
metal2S = SoundID 63
slideDoorS :: SoundID
slideDoorS = SoundID 64
autoGunS :: SoundID
+6 -16
View File
@@ -1,8 +1,6 @@
module Dodge.WorldEvent.Sound
( mkSoundBreakGlass
, mkSoundSplinterGlass
, mkSoundSplinterBlock
, originIDsAt
( originIDsAt
, originsIDsAt
) where
import Dodge.Data
import Dodge.SoundLogic
@@ -11,20 +9,12 @@ import Geometry.Data
import RandomHelp
import Control.Lens
originsIDsAt :: [SoundOrigin] -> [SoundID] -> Point2 -> World -> World
originsIDsAt sos sids p w = soundMultiFrom sos p sid Nothing $ set randGen g w
where
(sid,g) = _randGen w & runState (takeOne sids)
originIDsAt :: SoundOrigin -> [SoundID] -> Point2 -> World -> World
originIDsAt so sids p w = soundStart so p sid Nothing $ set randGen g w
where
(sid,g) = _randGen w & runState (takeOne sids)
mkSoundBreakGlass :: Point2 -> World -> World
mkSoundBreakGlass = originIDsAt (GlassBreakSound 0)
[glassShat1S,glassShat2S,glassShat3S,glassShat4S]
mkSoundSplinterGlass :: Point2 -> World -> World
mkSoundSplinterGlass = originIDsAt (GlassBreakSound 1)
[smallGlass1S,smallGlass2S,smallGlass3S,smallGlass4S]
mkSoundSplinterBlock :: Point2 -> World -> World
mkSoundSplinterBlock = originIDsAt (BlockDegradeSound 1)
[impact1S,impact2S,impact3S,impact4S]