diff --git a/app/Main.hs b/app/Main.hs index 9be966fcd..c116d9b2e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -64,7 +64,8 @@ main = do (lightsForGloom' w) (draw blank w) playSoundQueue (_soundData preData) (_soundQueue w) - return preData + newSoundData <- playAndUpdate (_sounds w) (_soundData preData) + return $ preData {_soundData = newSoundData} --renderPicture' preData (_windowX w,_windowY w) (Circle 5) -- renderPicture' preData -- (pictures [scale 0.5 0.9 $ polygon [(0,0),(0,-0.5),(-0.5,-0.5),(-0.5,0.0)] diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index cf9a18373..db18af086 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -245,7 +245,8 @@ data MenuState data Sound = Sound { _soundTime :: Int , _soundFadeTime :: Int - , _soundChannel :: Maybe Int + --, _soundChannel :: Maybe Int + , _soundChannel :: Maybe Mix.Channel , _soundPos :: Maybe Point2 , _soundType :: Int } diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index aa764631d..d3b0db06e 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -63,6 +63,7 @@ update w cid = _clID cr updateSoundQueue = set soundQueue [] + . set sounds M.empty --updateSound :: World -> World --updateSound = set soundQueue [] . stepSoundTimers diff --git a/src/Sound.hs b/src/Sound.hs index 6571b39bd..face9d388 100644 --- a/src/Sound.hs +++ b/src/Sound.hs @@ -6,8 +6,47 @@ import Control.Monad import qualified SDL.Mixer as Mix +import Data.Maybe import qualified Data.IntMap as IM +import qualified Data.Map as M -playSoundQueue :: SoundData -> [Int] -> IO () +import Control.Lens + +import Dodge.Data + +playSoundQueue :: SoundData a -> [Int] -> IO () playSoundQueue sd ns = - forM_ ns $ \n -> Mix.play (sd IM.! n) + forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once + +playIfFree :: Mix.Chunk -> Mix.Times -> IO (Maybe Mix.Channel) +playIfFree c times = do + mayChan <- Mix.getAvailable Mix.DefaultGroup + case mayChan of + Nothing -> return Nothing + Just i -> fmap Just $ Mix.playOn i times c + +haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound) +haltMaybe (Just x) = Mix.halt x >> return Nothing +haltMaybe Nothing = return Nothing + +playSound :: SoundData a -> Sound -> IO (Maybe Sound) +playSound sd s + | _soundTime s <= 0 = haltMaybe (_soundChannel s) + | otherwise = case _soundChannel s of + Just i -> return $ Just $ over soundTime (\t -> t - 1) s + Nothing -> do maychan <- playIfFree (_loadedChunks sd IM.! _soundType s) Mix.Forever + return $ Just $ s & soundTime -~ 1 + & soundChannel .~ maychan + +playSounds :: SoundData a -> IO (SoundData a) +playSounds sd = do + newSounds <- mapM (playSound sd) (_playingSounds sd) + return $ sd & playingSounds .~ M.mapMaybe id newSounds + +updatePlaying :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound +updatePlaying new old = M.unionWith f new old + where f newSound oldSound = newSound {_soundChannel = _soundChannel oldSound} + +playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a) +playAndUpdate new sd = do + playSounds $ over playingSounds (updatePlaying new) sd diff --git a/src/Sound/Preload.hs b/src/Sound/Preload.hs index 80b4605f1..8032d99e0 100644 --- a/src/Sound/Preload.hs +++ b/src/Sound/Preload.hs @@ -1,16 +1,28 @@ +{-# LANGUAGE TemplateHaskell #-} module Sound.Preload where import qualified SDL.Mixer as Mix import qualified Data.IntMap as IM +import qualified Data.Map as M -type SoundData = IM.IntMap Mix.Chunk +import Control.Lens -cleanUpSoundPreload :: SoundData -> IO () +import Dodge.Data + +data SoundData a = SoundData + {_loadedChunks :: IM.IntMap Mix.Chunk + ,_playingSounds :: M.Map a Sound + } + +makeLenses ''SoundData + + +cleanUpSoundPreload :: SoundData a -> IO () cleanUpSoundPreload sd = Mix.closeAudio -preloadSound :: IO SoundData +preloadSound :: IO (SoundData a) preloadSound = do Mix.openAudio Mix.defaultAudio 256 -- pFireSound <- Mix.loadWAV "./data/sound/tap3.wav" @@ -56,7 +68,7 @@ preloadSound = do glass3' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A3.wav" glass4' <- Mix.load "./data/sound/Small-Piece-Of-Glass-Shattering-A4.wav" foamSpray' <- Mix.load "./data/sound/foamSprayLoop.wav" - return $ IM.fromList $ zip [0..] + let loadedS = IM.fromList $ zip [0..] $ [ pFireSound , click , reloadSound' @@ -100,3 +112,4 @@ preloadSound = do , glass4' --40 , foamSpray' ] + return $ SoundData {_loadedChunks = loadedS, _playingSounds = M.empty}