This commit is contained in:
2021-04-05 12:55:52 +02:00
parent 7b3bda91c6
commit a7e56d727d
+25 -18
View File
@@ -2,8 +2,10 @@
Module : Sound Module : Sound
Description : Channel selection and storage Description : Channel selection and storage
This module checks for empty channels and plays sounds on them, using data chunks loaded into an IntMap, This module checks for empty channels and plays sounds on them.
and sound specifications of type 'Sound' loaded into a Map. It uses data chunks loaded into an IntMap to determine the actual sounds played,
and sound specifications of type 'Sound' loaded into a Map to
keep track of which sounds are playing.
Uses SDL.Mixer. Uses SDL.Mixer.
-} -}
module Sound module Sound
@@ -18,11 +20,19 @@ import Control.Monad
import Control.Lens import Control.Lens
{- | Play sounds from a list of indices. {- | Play sounds from a list of indices.
Each sound is played once if there is a free channel. Each sound starts playing (and will not repeat) if there is a free channel.
Use this if you don't care about timing, overlapping, fading, etc.
-} -}
playSoundQueue :: SoundData a -> [Int] -> IO () playSoundQueue :: SoundData a -> [Int] -> IO ()
playSoundQueue sd ns = forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once playSoundQueue sd ns = forM_ ns $ \n -> playIfFree (_loadedChunks sd IM.! n) Mix.Once
{- | Start playing new sounds and update sound specifications.
I think that this expects that unfinished sounds get passed forwards within the Map, to be rethought:
there may be a leak in the current typical usage.
-}
playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
playAndUpdate new sd = playSounds $ over playingSounds (updatePlaying new) sd
{- | Given a chunk, attempt to play this on a free channel a given number of {- | Given a chunk, attempt to play this on a free channel a given number of
times. Returns 'Just' the channel if succeeds. times. Returns 'Just' the channel if succeeds.
-} -}
@@ -44,23 +54,24 @@ playSoundIfFree c s = case _soundTime s of
f :: Maybe Mix.Channel -> Maybe Sound f :: Maybe Mix.Channel -> Maybe Sound
f = fmap ( \chan -> s & soundChannel ?~ chan) f = fmap ( \chan -> s & soundChannel ?~ chan)
{- Stop a channel if it was playing. {- | Stop a channel if it was playing.
Always returns 'IO' 'Nothing'. Always returns 'IO' 'Nothing'.
-} -}
haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound) haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
haltMaybe (Just x) = Mix.halt x >> return Nothing haltMaybe (Just x) = Mix.halt x >> return Nothing
haltMaybe Nothing = return Nothing haltMaybe Nothing = return Nothing
{- Play a sound according to it's specification. {- | Play a sound according to it's specification.
Logic: check if sound is playing: Logic: check if sound is playing:
- If so, decrement timers, and/or stop playing and remove 1. If so, decrement timers, and/or stop playing and remove
- If not, check if there is free channel: 2. If not, check if there is free channel:
- If so, start playing
- If not, remove sound. * If so, start playing
* If not, remove sound.
-} -}
playSound :: SoundData a -> Sound -> IO (Maybe Sound) updateOrStartSound :: SoundData a -> Sound -> IO (Maybe Sound)
playSound sd s = case _soundChannel s of updateOrStartSound sd s = case _soundChannel s of
Just i -> case _soundTime s of Just i -> case _soundTime s of
Just t | t > 0 -> return $ Just $ set soundTime (Just $ t - 1) s Just t | t > 0 -> return $ Just $ set soundTime (Just $ t - 1) s
| otherwise -> haltMaybe (_soundChannel s) | otherwise -> haltMaybe (_soundChannel s)
@@ -70,14 +81,14 @@ playSound sd s = case _soundChannel s of
) )
Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundType s) s Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundType s) s
{- Play all sounds and create new sound data. {- | Play all sounds and create new sound data.
-} -}
playSounds :: SoundData a -> IO (SoundData a) playSounds :: SoundData a -> IO (SoundData a)
playSounds sd = do playSounds sd = do
newSounds <- mapM (playSound sd) (_playingSounds sd) newSounds <- mapM (updateOrStartSound sd) (_playingSounds sd)
return $ sd & playingSounds .~ M.mapMaybe id newSounds return $ sd & playingSounds .~ M.mapMaybe id newSounds
{- Update sound specifications by overwriting an old Map with a new Map. {- | Update sound specifications by overwriting an old Map with a new Map.
Copies any information about channels from the old Map to the new Map. Copies any information about channels from the old Map to the new Map.
-} -}
updatePlaying :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound updatePlaying :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound
@@ -85,7 +96,3 @@ updatePlaying new old = M.unionWith f new old
where where
f newSound oldSound = newSound {_soundChannel = _soundChannel oldSound} f newSound oldSound = newSound {_soundChannel = _soundChannel oldSound}
{- Start playing new sounds and update sound specifications.
-}
playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
playAndUpdate new sd = playSounds $ over playingSounds (updatePlaying new) sd