Refactor sound
This commit is contained in:
+94
-94
@@ -3,13 +3,17 @@ Module : Sound
|
||||
Description : Channel selection and storage
|
||||
|
||||
This module checks for empty channels and plays sounds on them.
|
||||
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
|
||||
It uses data chunks loaded into an IntMap to determine the actual sounds played.
|
||||
Sound specifications of type 'Sound' loaded into a Map can be used to
|
||||
keep track of which sounds are playing.
|
||||
Uses SDL.Mixer.
|
||||
-}
|
||||
module Sound
|
||||
where
|
||||
module Sound (
|
||||
-- * Simple (One-Shot) Playback
|
||||
playSoundQueue
|
||||
-- * Complex Playback
|
||||
, playAndUpdate
|
||||
) where
|
||||
import Sound.Preload
|
||||
|
||||
import qualified SDL.Mixer as Mix
|
||||
@@ -17,49 +21,102 @@ import Data.Maybe
|
||||
import qualified Data.IntMap as IM
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Control.Lens
|
||||
|
||||
{- | Play sounds from a list of indices.
|
||||
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 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.
|
||||
A Map of new sound specifications is merged with a Map of already playing sounds,
|
||||
then sounds in the merged Map are updated.
|
||||
The Map of updated sound specifications is returned.
|
||||
|
||||
New sounds with the same keys as
|
||||
already playing sounds are merged in the following manner:
|
||||
|
||||
* the '_soundChannel' is set to the old value
|
||||
* if the old '_soundStatus' was 'FadingOut', it is replaced with the new status (allowing playback to be restarted using 'ToStart')
|
||||
* all other fields are set to the new value.
|
||||
|
||||
In the update:
|
||||
|
||||
1. sounds with a value 'ToStart' commence playing
|
||||
2. timers are decremented and any fading status is set
|
||||
3. sounds that have stopped playing are removed from the map.
|
||||
-}
|
||||
playAndUpdate :: Ord a => M.Map a Sound -> SoundData a -> IO (SoundData a)
|
||||
playAndUpdate new sd = playSounds $ over playingSounds (updatePlaying new) sd
|
||||
playAndUpdate :: Ord a => SoundData a -> M.Map a Sound -> IO (M.Map a Sound)
|
||||
playAndUpdate sData newSounds
|
||||
= updateSounds (_loadedChunks sData) (mergeSounds newSounds (_playingSounds sData))
|
||||
|
||||
--updateSound :: Sound -> Sound -> IO Sound
|
||||
--updateSound newS oldS
|
||||
-- | _soundIsFadingOut oldS
|
||||
-- = Mix.playOn i times
|
||||
-- | otherwise = newS & soundChannel .~ _soundChannel oldS
|
||||
mergeSounds :: Ord a => M.Map a Sound -> M.Map a Sound -> M.Map a Sound
|
||||
mergeSounds as bs = M.unionWith mergeSound as bs
|
||||
|
||||
startPlaying :: SoundData a -> Sound -> IO (Maybe Sound)
|
||||
startPlaying sd s = case _soundChannel s of
|
||||
Just _ -> return $ Just s
|
||||
Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundChunkID s) s
|
||||
mergeSound :: Sound -> Sound -> Sound
|
||||
mergeSound newS oldS
|
||||
| _soundStatus oldS == FadingOut
|
||||
= newS & soundChannel .~ _soundChannel oldS
|
||||
| otherwise = newS & soundChannel .~ _soundChannel oldS
|
||||
& soundStatus .~ _soundStatus oldS
|
||||
|
||||
decrimentTimer :: Sound -> IO Sound
|
||||
decrimentTimer s = case _soundTime s of
|
||||
Just t | t > 0 -> return $ s & soundTime ?~ t - 1
|
||||
updateSounds :: Ord a => IM.IntMap Mix.Chunk -> M.Map a Sound -> IO (M.Map a Sound)
|
||||
updateSounds sd ss = do
|
||||
may <- mapM (runMaybeT . updateSound sd) ss
|
||||
return $ M.mapMaybe id may
|
||||
|
||||
updateSound :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
|
||||
updateSound sd s =
|
||||
initialisePlaying sd s >>= liftIO . decrementTimer >>= cleanupHalted
|
||||
|
||||
initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
|
||||
initialisePlaying sd s = case _soundStatus s of
|
||||
ToStart -> tryPlay sd s
|
||||
_ -> return s
|
||||
|
||||
tryPlay :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
|
||||
tryPlay sd s = do
|
||||
i <- tryGetChannel s
|
||||
liftIO $ do
|
||||
Mix.halt i
|
||||
Mix.playOn i Mix.Once (sd IM.! _soundChunkID s)
|
||||
return $ s
|
||||
& soundChannel .~ Just i
|
||||
& soundStatus .~ Playing
|
||||
|
||||
repetitions :: Sound -> Mix.Times
|
||||
repetitions s = case _soundTime s of
|
||||
Nothing -> Mix.Once
|
||||
_ -> Mix.Forever
|
||||
|
||||
tryGetChannel :: Sound -> MaybeT IO Mix.Channel
|
||||
tryGetChannel s = case _soundChannel s of
|
||||
Just i -> return i
|
||||
Nothing -> MaybeT $ Mix.getAvailable Mix.DefaultGroup
|
||||
|
||||
decrementTimer :: Sound -> IO Sound
|
||||
decrementTimer s = case _soundTime s of
|
||||
Just t | t > 0 -> return $ s & soundTime .~ Just (t - 1)
|
||||
| otherwise -> fadeOutMaybe (_soundChannel s) (_soundFadeTime s)
|
||||
>> return (s & soundTime .~ Nothing
|
||||
& soundIsFadingOut .~ True)
|
||||
& soundStatus .~ FadingOut)
|
||||
Nothing -> return s
|
||||
|
||||
cleanupHalted :: Sound -> IO (Maybe Sound)
|
||||
cleanupHalted s = case _soundChannel s of
|
||||
Nothing -> return Nothing
|
||||
Just i -> do
|
||||
isPlaying <- Mix.playing i
|
||||
if isPlaying
|
||||
then return $ Just s
|
||||
else return Nothing
|
||||
fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
|
||||
fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT + 1) x
|
||||
fadeOutMaybe _ _ = return ()
|
||||
|
||||
cleanupHalted :: Sound -> MaybeT IO Sound
|
||||
cleanupHalted s = do
|
||||
i <- MaybeT $ return $ _soundChannel s
|
||||
isPlaying <- liftIO $ Mix.playing i
|
||||
if isPlaying
|
||||
then return s
|
||||
else mzero
|
||||
|
||||
-----------------------------------------------------------------
|
||||
{- | Play sounds from a list of indices.
|
||||
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, or sound positions.
|
||||
-}
|
||||
playSoundQueue :: IM.IntMap Mix.Chunk -> [Int] -> IO ()
|
||||
playSoundQueue chunkMap ns = forM_ ns $ \n -> playIfFree (chunkMap IM.! n) Mix.Once
|
||||
{- | Given a chunk, attempt to play this on a free channel a given number of
|
||||
times. Returns 'Just' the channel if succeeds.
|
||||
-}
|
||||
@@ -69,61 +126,4 @@ playIfFree c times = do
|
||||
case mayChan of
|
||||
Nothing -> return Nothing
|
||||
Just i -> Just <$> Mix.playOn i times c
|
||||
{- | Given a chunk and sound specification, play the chunk according to the specification
|
||||
if there is a free channel.
|
||||
On success return 'Just' an updated sound specification.
|
||||
-}
|
||||
playSoundIfFree :: Mix.Chunk -> Sound -> IO (Maybe Sound)
|
||||
playSoundIfFree c s = case _soundTime s of
|
||||
Just _ -> playIfFree c Mix.Forever >>= return . f
|
||||
Nothing -> playIfFree c Mix.Once >>= return . f
|
||||
where
|
||||
f :: Maybe Mix.Channel -> Maybe Sound
|
||||
f = fmap ( \chan -> s & soundChannel ?~ chan)
|
||||
|
||||
{- | Stop a channel if it was playing.
|
||||
Always returns 'IO' 'Nothing'.
|
||||
-}
|
||||
haltMaybe :: Maybe Mix.Channel -> IO (Maybe Sound)
|
||||
haltMaybe (Just x) = Mix.halt x >> return Nothing
|
||||
haltMaybe Nothing = return Nothing
|
||||
|
||||
fadeOutMaybe :: Maybe Mix.Channel -> Int -> IO ()
|
||||
fadeOutMaybe (Just x) fadeT = Mix.fadeOut (fromIntegral fadeT) x
|
||||
fadeOutMaybe _ _ = return ()
|
||||
|
||||
{- | Play a sound according to it's specification.
|
||||
Logic: check if sound is playing:
|
||||
|
||||
1. If so, decrement timers, and/or stop playing and remove
|
||||
2. If not, check if there is free channel:
|
||||
|
||||
* If so, start playing
|
||||
* If not, remove sound.
|
||||
-}
|
||||
updateOrStartSound :: SoundData a -> Sound -> IO (Maybe Sound)
|
||||
updateOrStartSound sd s = case _soundChannel s of
|
||||
Just i -> case _soundTime s of
|
||||
Just t | t > 0 -> return $ Just $ set soundTime (Just $ t - 1) s
|
||||
| otherwise -> haltMaybe (_soundChannel s)
|
||||
Nothing -> Mix.playing i >>= (\b -> if b
|
||||
then return (Just s)
|
||||
else return Nothing
|
||||
)
|
||||
Nothing -> playSoundIfFree (_loadedChunks sd IM.! _soundChunkID s) s
|
||||
|
||||
{- | Play all sounds and create new sound data.
|
||||
-}
|
||||
playSounds :: SoundData a -> IO (SoundData a)
|
||||
playSounds sd = do
|
||||
newSounds <- mapM (updateOrStartSound sd) (_playingSounds sd)
|
||||
return $ sd & playingSounds .~ M.mapMaybe id newSounds
|
||||
|
||||
{- | 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.
|
||||
-}
|
||||
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}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user