loop/src/Sound.hs

{-|
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.
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 (
    -- * Simple (One-Shot) Playback
      playSoundQueue
    , playPositionalSoundQueue
    -- * Complex Playback
    , playSoundAndUpdate
    -- * Volume Control
    , setSoundVolume
    , setMusicVolume

    , module Sound.Data
    ) where
import Sound.Data

import qualified SDL.Mixer as Mix
import Data.Maybe
import qualified Data.IntMap.Strict as IM
import qualified Data.Map as M
import qualified Streaming.Prelude as S
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Control.Lens
import Data.Int (Int16)
{- | Start playing new sounds and update sound specifications.
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 as follows:

    * '_soundChannel' is set to the old value
    * if the old sound is not fading and the chunk is the same, '_soundStatus' is set to the old value 
    * all other values are set to the new values

In the update: 
    
    1. commence playing sounds with 'ToStart' status
    2. decrement timers, set any fading status
    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 sData oldSounds newSounds
    = updateSounds (_loadedChunks sData) (M.unionWith mergeSound oldSounds newSounds)

mergeSound :: Sound -> Sound -> Sound
mergeSound oldS newS
    | _soundChunkID newS == _soundChunkID oldS && _playStatus (_soundStatus newS) == ToContinueStart
                = newOldChannel & soundStatus . playStatus .~ _playStatus (_soundStatus oldS)
    | otherwise = newOldChannel
  where
    newOldChannel = newS & soundChannel .~ _soundChannel oldS

updateSounds :: 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 >=> applyPosition) 
    >>= cleanupHalted

initialisePlaying :: IM.IntMap Mix.Chunk -> Sound -> MaybeT IO Sound
initialisePlaying sd s = case _playStatus $ _soundStatus s of
    ToStart -> tryPlay sd s
    ToContinueStart -> tryPlay sd s
    JustStartedPlaying -> return $ s & soundStatus . playStatus .~ Playing
    _ -> 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 timesToPlay (sd IM.! _getSoundID (_soundChunkID s))
    return $ s 
        & soundChannel ?~ i
        & soundStatus . playStatus .~ JustStartedPlaying
  where
    timesToPlay | _isLooping (_soundStatus s) = Mix.Forever
        | otherwise = Mix.Once

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 -~ 1
        | otherwise -> do 
            forM_ (_soundChannel s) Mix.halt
            return $ s & soundTime .~ Nothing
    Nothing -> return s

applyPosition :: Sound -> IO Sound
applyPosition s = case _soundAngDist s of
    Nothing     -> return s
    Just (a,d)  -> Mix.effectPosition (fromJust $ _soundChannel s) a d
                    >> return (s & soundAngDist .~ Nothing)

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.
For each index, the corresponding sound starts playing 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 = mapM_ $ \n -> runMaybeT $ 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.  -}
playIfFree :: Mix.Chunk -> Mix.Times -> MaybeT IO Mix.Channel
playIfFree c times = do
    i <- MaybeT $ Mix.getAvailable Mix.DefaultGroup
    liftIO $ Mix.playOn i times c

-----------------------------------------------------------------
{- | Play sounds from a list of index/position pairs.
As for 'playSoundQueue', but with positional information in the form of an Int16.  -}
playPositionalSoundQueue :: IM.IntMap Mix.Chunk -> [(Int,Int16)] -> IO ()
playPositionalSoundQueue chunkMap 
    = S.mapM_ ( \(n,a) -> 
                runMaybeT $ playIfFree (chunkMap IM.! n) Mix.Once >>= setChannelPos a )
    . S.each

setChannelPos :: Int16 -> Mix.Channel -> MaybeT IO Mix.Channel
setChannelPos a i = do
    _ <- liftIO $ Mix.effectPosition i a 0 
    return i
-----------------------------------------------------------------
{- | Set the volume for all sound channels.
Behind the scenes, scales a float [0,1] to an Int [0..128].  -}
setSoundVolume :: Float -> IO ()
setSoundVolume x = Mix.setVolume (round (x * 128)) Mix.AllChannels

{- | Set the music volume.
Behind the scenes, scales a float [0,1] to an Int [0..128].  -}
setMusicVolume :: Float -> IO ()
setMusicVolume x = Mix.setMusicVolume (round (x * 128))