Enable sounds in menus

appDodge/Main.hs

@@ -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

src/Dodge/Data/Universe.hs

@@ -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

src/Dodge/SoundLogic/ExternallyGeneratedSounds.hs

@@ -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
+    86 -> 2000
-    87 -> 500
+    87 -> 100
-    88 -> 2000
+    88 -> 500
-    89 -> 100
+    89 -> 2000
-    90 -> 300
+    90 -> 100
-    91 -> 1000
+    91 -> 300
-    92 -> 200
+    92 -> 1000
-    93 -> 100
+    93 -> 200
-    94 -> 1000
+    94 -> 100
-    95 -> 2000
+    95 -> 1000
-    96 -> 1000
+    96 -> 2000
-    97 -> 100
+    97 -> 1000
-    98 -> 200
+    98 -> 100
-    99 -> 500
+    99 -> 200
-    100 -> 100
+    100 -> 500
-    101 -> 2000
+    101 -> 100
     102 -> 2000
-    103 -> 2000
+    103 -> 1000
-    104 -> 200
+    104 -> 2000
-    105 -> 100
+    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"
+    84 -> "BWEP"
-    85 -> "BANG"
+    85 -> "CHUGUGUG"
-    86 -> "SLPP"
+    86 -> "BANG"
-    87 -> "DEDA"
+    87 -> "SLPP"
-    88 -> "WHSSH"
+    88 -> "DEDA"
-    89 -> "HNH"
+    89 -> "WHSSH"
-    90 -> "BWAH"
+    90 -> "HNH"
-    91 -> "CRUNK"
+    91 -> "BWAH"
-    92 -> "SQWLTCH"
+    92 -> "CRUNK"
-    93 -> "DRR"
+    93 -> "SQWLTCH"
-    94 -> "TRNKL"
+    94 -> "DRR"
-    95 -> "BRAP"
+    95 -> "TRNKL"
-    96 -> "BLPCHCH"
+    96 -> "BRAP"
-    97 -> "SKLE"
+    97 -> "BLPCHCH"
-    98 -> "ZMM"
+    98 -> "SKLE"
-    99 -> "WRRR"
+    99 -> "ZMM"
-    100 -> "FWUMP"
+    100 -> "WRRR"
-    101 -> "BRAHCHCH"
+    101 -> "FWUMP"
-    102 -> "BRPBRPBRP"
+    102 -> "BRAHCHCH"
-    103 -> "WE-OH"
+    103 -> "BWMP"
-    104 -> "THCK"
+    104 -> "BRPBRPBRP"
-    105 -> "FHP"
+    105 -> "WE-OH"
-    106 -> "QWLPH"
+    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

src/Dodge/Update/Input/ScreenLayer.hs

@@ -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

src/Sound.hs

@@ -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
 
 -----------------------------------------------------------------

src/Sound/Data.hs

@@ -27,6 +27,7 @@ data PlayStatus
     | ToStart
     | ToContinueStart
     | ToStop
+    | ToStartMenu
     deriving (Eq, Ord, Show, Read) --, Generic)
 
 newtype SoundID = SoundID {_getSoundID :: Int}