SimpleControl.hs

{- 2009 Daniel van den Eijkel <dvde@gmx.net> -}

{-# OPTIONS_GHC -fglasgow-exts #-}
module Sound.Hommage.DSPlayer.SimpleControl
 ( startSimpleControl
 , SimpleControl (..)
 , ListSequencer (..)
 
 , Event (..)
 , runEvent
 )
 where
------------------------------------------------------------------------------
import Sound.Hommage.DSPlayer.AudioSample
import Sound.Hommage.DSPlayer.SimplePlayer
import Sound.Hommage.DSPlayer.DSPlayer
import Sound.Hommage.DSPlayer.Voices
import Sound.Hommage.Signal
import Sound.Hommage.Misc

import Control.Monad
import Control.Monad.Fix
import Data.IORef
------------------------------------------------------------------------------
data Event = S Int (Double, Double) -- ^ AudioSample with  ID, Volume and Pan
           | L Signal               -- ^ Signal
           | A (IO ())              -- ^ IO Action

-- | Performs an event
runEvent :: SimpleControl -> Event -> IO ()           
runEvent sc e = case e of
 S nr (vol, pan) -> getAudioSample (poolSC sc) nr >>= maybe (return ()) (\sam -> 
                       playSP (playerSC sc) $ playSampleStereo sam (vol, pan))
 L (Mono li)     -> playSP (playerSC sc) $ playMonoListStereo li
 L (Stereo li)   -> playSP (playerSC sc) $ playStereoListStereo li
 A m   -> m
------------------------------------------------------------------------------
data SimpleControl = SimpleControl
 { stopSC :: IO ()                  -- ^ stops audio playback (audio restart after calling this action is currently not supported)
 , poolSC :: SamplePool             -- ^ SamplePool with AudioSamples
 , playerSC :: SimplePlayer         -- ^ SimplePlayer: playback of Signals and Samples
 , sequencerSC :: ListSequencer     -- ^ A simple list-based sequencer
 }

-- | Outputbuffer size is argument value multiplied with 512.
startSimpleControl :: Int -> IO SimpleControl
startSimpleControl latency = mfix $ \sc -> do
 sequencer <- mkListSequencer sc
 pool <- newIORef []
 player <- mkSimplePlayer (max 1 latency)
 setOnTickSP player (onTickLS sequencer)
 stop <- startDSPlayer (dsplayerSP player)
 return (SimpleControl stop pool player sequencer)

------------------------------------------------------------------------------
data ListSequencer = ListSequencer
 { onTickLS    :: IO ()                                       
 , setOnZeroLS :: Bool -> [[Event]] -> IO ()                  -- ^ set the events that should be played at the next loop (True) or at the first loop after the current events has reached its end.
 , setOnceLS   :: [[Event]] -> IO ()                          -- ^ add some events to the current played events (will be lost when next loop is played)
 , getOnZeroLS :: IO [[Event]]                                -- ^ get the eventlist
 , updOnZeroLS :: Bool -> ([[Event]] -> [[Event]]) -> IO ()   -- ^ update the eventlist
 }
 
mkListSequencer :: SimpleControl -> IO ListSequencer
mkListSequencer sc = do
 tick_ref <- newIORef (0::Int)
 next_ref <- newIORef []
 curr_ref <- newIORef []
 force_ref <- newIORef False
 once_ref  <- newIORef []
 let getOnZero = readIORef next_ref 
     setOnZero force es = do writeIORef next_ref es 
                             writeIORef force_ref force
     updOnZero force f  = do es <- readIORef next_ref 
                             writeIORef next_ref $ f es
                             writeIORef force_ref force
     setOnce es = writeIORef once_ref es
     onZero = do nx  <- readIORef next_ref
                 cur <- readIORef curr_ref
                 force_nx <- readIORef force_ref
                 if force_nx
                    then do
                        writeIORef curr_ref nx
                        writeIORef force_ref False
                    else 
                        when (null cur) $ writeIORef curr_ref nx
                 once <- readIORef once_ref
                 when (not $ null once) $ do
                      writeIORef once_ref []
                      cur <- readIORef curr_ref
                      writeIORef curr_ref (merge (++) cur once)                                
     onTick = do tick <- readIORef tick_ref
                 writeIORef tick_ref (mod (tick + 1) 96)
                 when (tick == 0) onZero
                 x <- readIORef curr_ref
                 case x of
                    es:ess -> do writeIORef curr_ref ess
                                 mapM_ (runEvent sc) es
                    []     -> return ()
 return $ ListSequencer onTick setOnZero setOnce getOnZero updOnZero
------------------------------------------------------------------------------