Enable sounds in menus

This commit is contained in:
2025-06-03 08:51:34 +01:00
parent 695cf3c5fd
commit e952f2abea
8 changed files with 348 additions and 326 deletions
+3
View File
@@ -99,6 +99,7 @@ firstWorldLoad theConfig = do
, _uvDebugFloat1 = 10
, _uvDebugFloat2 = 0
, _uvDebugMessageOffset = 0
, _uvSoundQueue = mempty
}
return $ u & uvScreenLayers .~ [splashMenu u]
@@ -120,6 +121,7 @@ playSoundUnlessRewinding u = case w ^. timeFlow of
doSideEffects :: Universe -> IO Universe
doSideEffects u = do
newPlayingSounds <- playSoundUnlessRewinding u
playSoundQueue (_loadedChunks . _soundData $ _preloadData u) (fmap _getSoundID $ u ^. uvSoundQueue)
u' <- _uvIOEffects u u
endTicks <- SDL.ticks
return $
@@ -129,6 +131,7 @@ doSideEffects u = do
& uvWorld . playingSounds .~ newPlayingSounds
& uvWorld . toPlaySounds .~ M.empty
& uvIOEffects .~ return
& uvSoundQueue .~ mempty
doPreload :: IO PreloadData
doPreload = do
+1 -1
View File
File diff suppressed because one or more lines are too long
+2
View File
@@ -13,6 +13,7 @@ module Dodge.Data.Universe (
module Loop.Data,
) where
import Sound.Data
import qualified Data.Map.Strict as M
import GHC.Word (Word32)
import Dodge.Data.SelectionList
@@ -44,6 +45,7 @@ data Universe = Universe
, _uvDebugFloat1 :: Float
, _uvDebugFloat2 :: Float
, _uvDebugMessageOffset :: Int
, _uvSoundQueue :: [SoundID] -- sounds without a position, to be played once
}
data DebugItem = DebugItem
@@ -1,4 +1,4 @@
-- generated at 2025-01-01 16:37:43.706494172 UTC
-- generated at 2025-06-02 21:04:57.854200257 UTC
module Dodge.SoundLogic.ExternallyGeneratedSounds where
import Sound.Data
soundToVol :: SoundID -> Float
@@ -87,29 +87,31 @@ soundToVol v = case _getSoundID v of
81 -> 500
82 -> 100
83 -> 1000
84 -> 2000
84 -> 300
85 -> 2000
86 -> 100
87 -> 500
88 -> 2000
89 -> 100
90 -> 300
91 -> 1000
92 -> 200
93 -> 100
94 -> 1000
95 -> 2000
96 -> 1000
97 -> 100
98 -> 200
99 -> 500
100 -> 100
101 -> 2000
86 -> 2000
87 -> 100
88 -> 500
89 -> 2000
90 -> 100
91 -> 300
92 -> 1000
93 -> 200
94 -> 100
95 -> 1000
96 -> 2000
97 -> 1000
98 -> 100
99 -> 200
100 -> 500
101 -> 100
102 -> 2000
103 -> 2000
104 -> 200
105 -> 100
103 -> 1000
104 -> 2000
105 -> 2000
106 -> 200
107 -> 100
108 -> 200
_ -> 50
soundToOnomato :: SoundID -> String
soundToOnomato v = case _getSoundID v of
@@ -197,29 +199,31 @@ soundToOnomato v = case _getSoundID v of
81 -> "DUDURAH"
82 -> "KKSQWL"
83 -> "CRMPL"
84 -> "CHUGUGUG"
85 -> "BANG"
86 -> "SLPP"
87 -> "DEDA"
88 -> "WHSSH"
89 -> "HNH"
90 -> "BWAH"
91 -> "CRUNK"
92 -> "SQWLTCH"
93 -> "DRR"
94 -> "TRNKL"
95 -> "BRAP"
96 -> "BLPCHCH"
97 -> "SKLE"
98 -> "ZMM"
99 -> "WRRR"
100 -> "FWUMP"
101 -> "BRAHCHCH"
102 -> "BRPBRPBRP"
103 -> "WE-OH"
104 -> "THCK"
105 -> "FHP"
106 -> "QWLPH"
84 -> "BWEP"
85 -> "CHUGUGUG"
86 -> "BANG"
87 -> "SLPP"
88 -> "DEDA"
89 -> "WHSSH"
90 -> "HNH"
91 -> "BWAH"
92 -> "CRUNK"
93 -> "SQWLTCH"
94 -> "DRR"
95 -> "TRNKL"
96 -> "BRAP"
97 -> "BLPCHCH"
98 -> "SKLE"
99 -> "ZMM"
100 -> "WRRR"
101 -> "FWUMP"
102 -> "BRAHCHCH"
103 -> "BWMP"
104 -> "BRPBRPBRP"
105 -> "WE-OH"
106 -> "THCK"
107 -> "FHP"
108 -> "QWLPH"
_ -> error "unitialised sound"
soundPathList :: [String]
soundPathList =
@@ -307,6 +311,7 @@ soundPathList =
, "eject.DUDURAH.500.wav"
, "blood3.KKSQWL.100.wav"
, "stone2.CRMPL.1000.wav"
, "tone440raise.BWEP.300.wav"
, "seagullChatter1.CHUGUGUG.2000.wav"
, "bang.BANG.2000.wav"
, "slap1.SLPP.100.wav"
@@ -325,6 +330,7 @@ soundPathList =
, "fireLoud.WRRR.500.wav"
, "tap4.FWUMP.100.wav"
, "shotgun.BRAHCHCH.2000.wav"
, "sawtoothFail.BWMP.1000.wav"
, "mini.BRPBRPBRP.2000.wav"
, "seagullWhistle.WE-OH.2000.wav"
, "connectItem.THCK.200.wav"
@@ -499,49 +505,53 @@ blood3S :: SoundID
blood3S = SoundID 82
stone2S :: SoundID
stone2S = SoundID 83
tone440raiseS :: SoundID
tone440raiseS = SoundID 84
seagullChatter1S :: SoundID
seagullChatter1S = SoundID 84
seagullChatter1S = SoundID 85
bangS :: SoundID
bangS = SoundID 85
bangS = SoundID 86
slap1S :: SoundID
slap1S = SoundID 86
slap1S = SoundID 87
dedaS :: SoundID
dedaS = SoundID 87
dedaS = SoundID 88
missileLaunchS :: SoundID
missileLaunchS = SoundID 88
missileLaunchS = SoundID 89
gruntS :: SoundID
gruntS = SoundID 89
gruntS = SoundID 90
sineRaisePitchOneSecS :: SoundID
sineRaisePitchOneSecS = SoundID 90
sineRaisePitchOneSecS = SoundID 91
metal2S :: SoundID
metal2S = SoundID 91
metal2S = SoundID 92
gut5S :: SoundID
gut5S = SoundID 92
gut5S = SoundID 93
slideDoorS :: SoundID
slideDoorS = SoundID 93
slideDoorS = SoundID 94
metal6S :: SoundID
metal6S = SoundID 94
metal6S = SoundID 95
autoGunS :: SoundID
autoGunS = SoundID 95
autoGunS = SoundID 96
oldMachineBootS :: SoundID
oldMachineBootS = SoundID 96
oldMachineBootS = SoundID 97
blood6S :: SoundID
blood6S = SoundID 97
blood6S = SoundID 98
buzzS :: SoundID
buzzS = SoundID 98
buzzS = SoundID 99
fireLoudS :: SoundID
fireLoudS = SoundID 99
fireLoudS = SoundID 100
tap4S :: SoundID
tap4S = SoundID 100
tap4S = SoundID 101
shotgunS :: SoundID
shotgunS = SoundID 101
shotgunS = SoundID 102
sawtoothFailS :: SoundID
sawtoothFailS = SoundID 103
miniS :: SoundID
miniS = SoundID 102
miniS = SoundID 104
seagullWhistleS :: SoundID
seagullWhistleS = SoundID 103
seagullWhistleS = SoundID 105
connectItemS :: SoundID
connectItemS = SoundID 104
connectItemS = SoundID 106
whiteNoiseFadeInS :: SoundID
whiteNoiseFadeInS = SoundID 105
whiteNoiseFadeInS = SoundID 107
gut1S :: SoundID
gut1S = SoundID 106
gut1S = SoundID 108
+3 -2
View File
@@ -3,6 +3,7 @@ module Dodge.Update.Input.ScreenLayer (
ldpVerticalSelection,
) where
import Dodge.SoundLogic.ExternallyGeneratedSounds
import Dodge.ListDisplayParams
import Control.Monad
import Data.Char
@@ -63,11 +64,11 @@ mouseClickOptionsList u = fromMaybe u $ do
mbs | mbs ^. at ButtonLeft == Just 0 -> do
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
f <- sl ^? ix i . siPayload . _1
return $ f u
return $ f u & uvSoundQueue .:~ click1S
mbs | mbs ^. at ButtonRight == Just 0 -> do
i <- u ^? uvWorld . input . mouseContext . mcoMenuClick
f <- sl ^? ix i . siPayload . _2
return $ f u
return $ f u & uvSoundQueue .:~ click1S
_ -> Nothing
ldpVerticalSelection :: Configuration -> ListDisplayParams -> Point2 -> Maybe Int
+3 -2
View File
@@ -51,7 +51,8 @@ In the update:
3. apply 'Just' sound position effects, set value to 'Nothing'
4. remove sounds that have stopped playing from the map.
-}
playSoundAndUpdate :: Ord a => SoundData -> M.Map a Sound -> M.Map a Sound -> IO (M.Map a Sound)
playSoundAndUpdate
:: Ord a => SoundData -> M.Map a Sound -> M.Map a Sound -> IO (M.Map a Sound)
playSoundAndUpdate sData oldSounds newSounds
= updateSounds (_loadedChunks sData) (M.unionWith mergeSound oldSounds newSounds)
@@ -135,7 +136,7 @@ playSoundQueue chunkMap = mapM_ $ \n -> runMaybeT $ playIfFree (chunkMap IM.! n)
times. Returns 'Just' the channel if succeeds. -}
playIfFree :: Mix.Chunk -> Mix.Times -> MaybeT IO Mix.Channel
playIfFree c times = do
i <- MaybeT $ Mix.getAvailable 0 -- 0 refers to the group for game sounds
i <- MaybeT $ Mix.getAvailable Mix.DefaultGroup -- try all channels
liftIO $ Mix.playOn i times c
-----------------------------------------------------------------
+1
View File
@@ -27,6 +27,7 @@ data PlayStatus
| ToStart
| ToContinueStart
| ToStop
| ToStartMenu
deriving (Eq, Ord, Show, Read) --, Generic)
newtype SoundID = SoundID {_getSoundID :: Int}
+258 -254
View File
File diff suppressed because it is too large Load Diff