Voices.hs

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

module Sound.Hommage.DSPlayer.Voices
 ( playMonoListStereo
 , playStereoListStereo
 , playSampleStereo
 )
 where
import Data.Array.IO
import Data.IORef
import Foreign
import Sound.Hommage.Signal (Stereo (..))
import Sound.Hommage.Sample
import Sound.Hommage.DSPlayer.VoicePlayer
import Sound.Hommage.DSPlayer.AudioSample

playMonoListStereo :: [Double] -> Ptr Double -> Ptr Double -> IO Voice
playMonoListStereo xs ptrL ptrR = do
 pref <- newIORef xs
 return $ \i -> do xs <- readIORef pref
                   case xs of
                    []  -> return False
                    x:r -> do yL <- peekElemOff ptrL i
                              yR <- peekElemOff ptrR i
                              pokeElemOff ptrL i (x+yL)
                              pokeElemOff ptrR i (x+yR)
                              writeIORef pref r
                              return True

playStereoListStereo :: [Stereo] -> Ptr Double -> Ptr Double -> IO Voice
playStereoListStereo xs ptrL ptrR = do
 pref <- newIORef xs
 return $ \i -> do xs <- readIORef pref
                   case xs of
                    []  -> return False
                    (xL:><:xR):r -> do yL <- peekElemOff ptrL i
                                       yR <- peekElemOff ptrR i
                                       pokeElemOff ptrL i (xL+yL)
                                       pokeElemOff ptrR i (xR+yR)
                                       writeIORef pref r
                                       return True
playSampleStereo :: AudioSample -> (Double, Double) -> Ptr Double -> Ptr Double -> IO Voice
playSampleStereo (MonoSample samp) (vol, pan) ptrL ptrR = do
 let len = sizeSample samp
     arr = arraySample samp
 pref <- newIORef 0
 let vL = vol * (1 - (min 1 (max 0 pan)))
     vR = vol * (1 - (min 1 (max 0 $ negate pan)))
 return $ \i -> do pos <- readIORef pref
                   if pos >= len then return False else do
                     x <- readArray arr pos
                     yL <- peekElemOff ptrL i
                     yR <- peekElemOff ptrR i
                     pokeElemOff ptrL i (vL*x+yL)
                     pokeElemOff ptrR i (vR*x+yR)
                     writeIORef pref (pos+1)
                     return True
playSampleStereo (StereoSample samp) (vol, pan) ptrL ptrR = do
 let len = sizeSample samp
     arr = arraySample samp
 pref <- newIORef 0
 let vL = vol * (1 - (min 1 (max 0 pan)))
     vR = vol * (1 - (min 1 (max 0 $ negate pan)))
 return $ \i -> do pos <- readIORef pref
                   if pos >= len then return False else do
                     xL:><:xR <- readArray arr pos 
                     yL <- peekElemOff ptrL i
                     yR <- peekElemOff ptrR i
                     pokeElemOff ptrL i (vL*xL+yL)
                     pokeElemOff ptrR i (vR*xR+yR)
                     writeIORef pref (pos+1)
                     return True

{-
playSampleMono :: AudioSample -> Ptr Double -> IO Voice
playSampleMono (MonoSample samp) ptr = do
 let len = sizeSample samp
     arr = arraySample samp
 pref <- newIORef 0
 return $ \i -> do pos <- readIORef pref
                   if pos >= len then return False else do
                     x <- readArray arr pos 
                     y <- peekElemOff ptr i
                     pokeElemOff ptr i (x+y)
                     writeIORef pref (pos+1)
                     return True
playSampleMono (StereoSample samp) ptr = do
 let len = sizeSample samp
     arr = arraySample samp
 pref <- newIORef 0
 return $ \i -> do pos <- readIORef pref
                   if pos >= len then return False else do
                     xL:><:xR <- readArray arrL pos                      
                     y <- peekElemOff ptr i
                     pokeElemOff ptr i (y + (xL + xR)*0.5)
                     writeIORef pref (pos+1)
                     return True
-}