hommage-ds (empty) → 0.0.5
raw patch · 9 files changed
+622/−0 lines, 9 filesdep +DirectSounddep +arraydep +basesetup-changed
Dependencies added: DirectSound, array, base, haskell98, hommage
Files
- Setup.hs +4/−0
- Sound/Hommage/DSPlayer/AudioSample.hs +45/−0
- Sound/Hommage/DSPlayer/DSPlayer.hs +94/−0
- Sound/Hommage/DSPlayer/SimpleControl.hs +101/−0
- Sound/Hommage/DSPlayer/SimplePlayer.hs +102/−0
- Sound/Hommage/DSPlayer/UnsafeSimpleControl.hs +110/−0
- Sound/Hommage/DSPlayer/VoicePlayer.hs +39/−0
- Sound/Hommage/DSPlayer/Voices.hs +98/−0
- hommage-ds.cabal +29/−0
+ Setup.hs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMain+
+ Sound/Hommage/DSPlayer/AudioSample.hs view
@@ -0,0 +1,45 @@+{- 2009 Daniel van den Eijkel <dvde@gmx.net> -} + +module Sound.Hommage.DSPlayer.AudioSample + ( SamplePool + , loadAudioSample + , getAudioSample + , AudioSample (..) + , openWavSample + ) + where + +--import Sound.Hommage.WavFile +import Sound.Hommage.Signal +import Sound.Hommage.Sample + +import Control.Monad +import Data.Array.Storable +import Data.Array.IO +import GHC.IOBase + +-- | A list of AudioSamples. The list can be extended at runtime. +type SamplePool = IORef [AudioSample] + +-- | Load a Sample into the SamplePool +loadAudioSample :: SamplePool -> FilePath -> IO Int +loadAudioSample ref fp = do + a <- openWavSample fp + let s = either MonoSample StereoSample a + aus <- readIORef ref + writeIORef ref (aus ++ [s]) + return $! length aus + +-- | Get the nth AudioSample. Nothing if not defined. +getAudioSample :: SamplePool -> Int -> IO (Maybe AudioSample) +getAudioSample ref i = do + aus <- readIORef ref + if i < 0 || i >= length aus + then return Nothing + else return (Just (aus !! i)) + +--------------------------------------------------------------------------------------------------- +-- Sample Mono | Sample Stereo +data AudioSample = MonoSample { theMonoSample :: Sample Mono } + | StereoSample { theStereoSample :: Sample Stereo } +---------------------------------------------------------------------------------------------------
+ Sound/Hommage/DSPlayer/DSPlayer.hs view
@@ -0,0 +1,94 @@+{- 2009 Daniel van den Eijkel <dvde@gmx.net> -}++module Sound.Hommage.DSPlayer.DSPlayer + ( DSPlayer (..)+ , startDSPlayer+ )+ where++import qualified Sound.Win32.DirectSound as DS++import Control.Monad+import Data.Maybe+import Foreign+import System.IO+---------------------------------------------------------------------------------------------------+-- | The DSPlayer object is given to the @startDSPlayer@ action. It contains all necessary +-- information like sampling rate, buffer size, a stereo flag and the fillbuffer callback function.+data DSPlayer = DSPlayer { sampleRateDS :: Int -- ^ 44100 for example+ , bufferSizeDS :: Int -- ^ 1024 for example+ , isStereoDS :: Bool + , fillBufferCallbackDS :: DS.FillBufferCallback Int16 -- ^ @Ptr a -> Word32 -> IO ()@ Length: bufferSizeDS multiplied with 2(stereo) or 1(mono)+ }+---------------------------------------------------------------------------------------------------+-- | Opens the Audio Driver, creates a Sound Buffer and starts playback. +-- Returns a stop-action. NOTE: Stopping does not work well: +-- Restarting the sound after stopping does not work currently.+--+-- After calling this action, the fillbufferCallbackDS function will be called iteratively.+-- For stereo output, the values are interleaved.+startDSPlayer :: DSPlayer -> IO (IO ()) +startDSPlayer dsplayer = do + ds <- openAudioDriver + sb <- openSoundBuffer ds (sampleRateDS dsplayer) (bufferSizeDS dsplayer) (isStereoDS dsplayer)+ stopaudio <- DS.playWithDoubleBuffering sb (fillBufferCallbackDS dsplayer)+ return stopaudio+---------------------------------------------------------------------------------------------------+openSoundBuffer :: DS.DirectSound -> Int -> Int -> Bool -> IO DS.SoundBuffer+openSoundBuffer ds sampleRate bufSize True = openStereoSoundBuffer ds sampleRate bufSize+openSoundBuffer ds sampleRate bufSize False = openMonoSoundBuffer ds sampleRate bufSize++openStereoSoundBuffer :: DS.DirectSound -> Int -> Int -> IO DS.SoundBuffer+openStereoSoundBuffer ds sampleRate bufSize = do+ let waveFormatX = DS.makeWaveFormatX sampleRate 2 DS.SampleInt16+ sb <- DS.createSoundBuffer ds waveFormatX (2*bufSize) >>= \msb -> case msb of+ Left err -> error err + Right sb -> return sb+ return sb++openMonoSoundBuffer :: DS.DirectSound -> Int -> Int -> IO DS.SoundBuffer+openMonoSoundBuffer ds sampleRate bufSize = do+ let waveFormatX = DS.makeWaveFormatX sampleRate 1 DS.SampleInt16+ sb <- DS.createSoundBuffer ds waveFormatX (2*bufSize) >>= \msb -> case msb of -- 1*bufsize ???+ Left err -> error err + Right sb -> return sb+ return sb+-------------------------------------------------------------------------------+openAudioDriver :: IO DS.DirectSound+openAudioDriver = do + drvlist <- DS.enumerateDrivers+ drv <- case drvlist of+ [] -> error "no audio device found"+ [drv] -> return drv+ _ -> selectAudioDriver drvlist (\d -> return (DS.drv_desc d)) + hwnd <- DS.getConsoleHWND_hack+ -- putStrLn $ "hwnd = " ++ show hwnd+ ds <- DS.directSoundCreate (Just drv) hwnd >>= \mds -> case mds of+ Left err -> error err+ Right ds -> return ds+ return ds+ +selectAudioDriver :: [b] -> (b -> IO [Char]) -> IO b+selectAudioDriver srclist getName = do+ names <- mapM getName srclist+ forM_ (zip [1..] names) $ \(i,name) -> putStrLn $ show (i :: Int) ++ ": " ++ name+ let nsrc = length srclist+ src <- case srclist of+ [] -> error "no devices found"+ [x] -> return x+ _ -> do+ putStrLn "please select a device"+ l <- getLine+ let k = case maybeRead l of+ { Nothing -> nsrc+ ; Just m -> if m<1 || m>nsrc then nsrc else m+ }+ putStrLn $ "device #" ++ show k ++ " selected."+ return $ srclist!!(k-1)+ return src ++maybeRead :: Read a => String -> Maybe a+maybeRead s = case reads s of + [(x,"")] -> Just x+ _ -> Nothing+
+ Sound/Hommage/DSPlayer/SimpleControl.hs view
@@ -0,0 +1,101 @@+{- 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+------------------------------------------------------------------------------
+ Sound/Hommage/DSPlayer/SimplePlayer.hs view
@@ -0,0 +1,102 @@+{- 2009 Daniel van den Eijkel <dvde@gmx.net> -}++{-# OPTIONS_GHC -fglasgow-exts #-}+module Sound.Hommage.DSPlayer.SimplePlayer+ ( SimplePlayer (..)+ , mkSimplePlayer+ )+ where++import Sound.Hommage.DSPlayer.DSPlayer+import Sound.Hommage.DSPlayer.VoicePlayer+import Sound.Hommage.Misc (for')++import Control.Monad+import Data.Array.Storable as STA+import Data.IORef+import Foreign+import System.IO++---------------------------------------------------------------------------------------------------+data SimplePlayer = SimplePlayer + { dsplayerSP :: DSPlayer -- ^ DSPlayer+ , playSP :: (Ptr Double -> Ptr Double -> IO Voice) -> IO () -- ^ creates and plays a voice+ , killSP :: IO () -- ^ removes all active voices+ , fptSP :: Int -> IO () -- ^ set the number of frames per tick+ , setOnTickSP :: IO () -> IO () -- ^ set the action which is performed on each tick+ }+---------------------------------------------------------------------------------------------------+mkSimplePlayer :: Int -> IO SimplePlayer+mkSimplePlayer latency = do+ voiceplayer <- mkVoicePlayer+ framecount_ref <- newIORef 0+ ontick_ref <- newIORef (return ())+ framespertick_ref <- newIORef 800+ (leftOutputBuffer :: STA.StorableArray Int Double) <- STA.newArray (0, 511) 0.0+ (rightOutputBuffer :: STA.StorableArray Int Double) <- STA.newArray (0, 511) 0.0+ let --mkVoice :: (Ptr Double -> Ptr Double -> IO Voice) -> IO Voice+ mkVoice f = withStorableArray leftOutputBuffer $ \ptrL ->+ withStorableArray rightOutputBuffer $ \ptrR -> f ptrL ptrR + + --addVoice :: Voice -> IO ()+ addVoice v = startVoice voiceplayer $! v ++ --stopAll :: IO ()+ stopAll = clearVoicePlayer voiceplayer ++ --setFPT :: Int -> IO ()+ setFPT fpt = writeIORef framespertick_ref $! max 512 fpt ++ --setOnTick :: IO () -> IO ()+ setOnTick f = writeIORef ontick_ref f+ + fillOutputBuffers =+ STA.withStorableArray leftOutputBuffer $ \ptrL -> + STA.withStorableArray rightOutputBuffer $ \ptrR -> do+ framecount <- readIORef framecount_ref+ framecount' <- for' 0 (<512) (+1) framecount $ \i framecount -> do+ pokeElemOff ptrL i 0+ pokeElemOff ptrR i 0+ when (framecount == 0) (join $ readIORef ontick_ref) --tickcount -- --$ getCurrentPE pateng tickcount >>= sequence_ + stepVoicePlayer voiceplayer i+ fpt <- readIORef framespertick_ref+ let framecount' = framecount + 1+ if framecount' >= fpt+ then return 0+ else return framecount'+ writeIORef framecount_ref framecount' + + lat = max 1 latency+ sampleRate = 44100+ fillBuffer outputBuffer _ = + STA.withStorableArray leftOutputBuffer $ \ptrL -> + STA.withStorableArray rightOutputBuffer $ \ptrR -> do+ forM_ [0..lat-1] $ \i -> do + --for 0 (<lat) (+1) $ \i -> do + fillOutputBuffers+ copyStereoOutputBuf512 ptrL ptrR $! (outputBuffer `advancePtr` (1024 * i)) + return () ++ return ( SimplePlayer + (DSPlayer { sampleRateDS = sampleRate+ , bufferSizeDS = lat * 512+ , isStereoDS = True+ , fillBufferCallbackDS = fillBuffer+ })+ (\v -> mkVoice v >>= addVoice)+ stopAll+ setFPT+ setOnTick )+ +copyStereoOutputBuf512 :: Ptr Double -> Ptr Double -> Ptr Int16 -> IO ()+copyStereoOutputBuf512 ptrL ptrR ptrO = do+ forM_ [0..511] $ \i -> do+ --for 0 (<512) (+1) $ \i -> do + vl <- peekElemOff ptrL i + vr <- peekElemOff ptrR i + let k = fromIntegral (i+i) :: Int+ al = round (vl*10000) :: Int16+ ar = round (vr*10000) :: Int16 + pokeElemOff ptrO (k ) al -- left channel+ pokeElemOff ptrO (k+1) ar -- right channel+
+ Sound/Hommage/DSPlayer/UnsafeSimpleControl.hs view
@@ -0,0 +1,110 @@+-- | +-- example: (you need a Wavfile (44100Hz, 16Bit, mono or stereo) named \"bassdrum.wav\")+--+-- @ ghci @+-- +-- @ :m Sound.Hommage Sound.Hommage.DSPlayer.UnsafeSimpleControl @ -- load the modules+-- +-- @ startAudio 4 @ -- start direct sound with a buffersize of 4*512 +-- +-- @ let s1 p = L $ Mono $ zipWith (*) (playADSR FitADR Linear (1,1,0.3,3) 20000) $ sinus $ repeat $ noteToFrequency 12 p @ -- define a simple synthesizer+-- +-- @ next $ (\\x -> [x]:replicate 11 []) =<< [s1 12, s1 24, s1 16, s1 19, s1 24, s1 12, s1 16, s1 19]) @ -- run a simple bassline (1 bar = 96 ticks)+-- +-- @ importSample \"bassdrum.wav\" @ -- load the bassdrum sample+-- +-- @ let b1 = concat $ replicate 4 ([S 0 (1,0)] : replicate 23 []) @ -- define a beat+-- +-- @ fnext $ zipWith (++) b1 @ -- add the beat to the current playing bassline+-- +-- @ fnext $ map $ filter $ \\e -> case e of { S 0 _ -> False; _ -> True } @ -- remove the bassdrum sample events from the current playing loop+-- +-- @ next [] @ -- silence+-- +-- @ :q @+-- +module Sound.Hommage.DSPlayer.UnsafeSimpleControl + ( startAudio+ , stopAudio+ , importSample+ , killAllVoices+ , ev+ , next+ , after + , once + , fnext + , fafter + , current+ , setBPM+ , module Sound.Hommage.DSPlayer.SimpleControl+ , module Sound.Hommage.DSPlayer.SimplePlayer+ )+ where+ +import Sound.Hommage.DSPlayer.SimpleControl+import Sound.Hommage.DSPlayer.SimplePlayer+import Sound.Hommage.DSPlayer.AudioSample+ +import Control.Concurrent+import Data.IORef+import System.IO.Unsafe+------------------------------------------------------------------------------+{-# NOINLINE ref_simplecontrol #-}+ref_simplecontrol :: IORef SimpleControl+ref_simplecontrol = unsafePerformIO $ newIORef undefined+------------------------------------------------------------------------------+-- | Start DirectSound and the sequencer loop+startAudio :: Int -> IO ()+startAudio latency = forkIO (startSimpleControl latency >>= writeIORef ref_simplecontrol) >> return ()++-- | Don't use this - quit ghci instead...+stopAudio :: IO ()+stopAudio = readIORef ref_simplecontrol >>= \c -> stopSC c++-- | Load an audiosample into RAM. The number\/ID of the sample is shown.+--+-- example: @ loadSample \"bassdrum.wav\" @ (shows for example \"Loading Sample Nr. 5\")+importSample :: FilePath -> IO ()+importSample fp = do+ sc <- readIORef ref_simplecontrol+ nr <- loadAudioSample (poolSC sc) fp + putStrLn ("Loading Sample Nr. " ++ show nr)++-- | Kill all current playing voices (lists and samples)+killAllVoices :: IO ()+killAllVoices = readIORef ref_simplecontrol >>= \sc -> killSP (playerSC sc)++-- | Set Beats-Per-Minute, (based on a 4-4-beat - so its equal to loops-per-4-minutes)+--+-- example: @ setBPM 133.33 @+setBPM :: Double -> IO ()+setBPM x = readIORef ref_simplecontrol >>= \sc -> fptSP (playerSC sc) (round(44100/((max 1 x)*24/60)))++-- | run an event+ev :: Event -> IO ()+ev e = readIORef ref_simplecontrol >>= \sc -> runEvent sc e++-- | set next loop (starting at next bar)+next :: [[Event]] -> IO ()+next es = readIORef ref_simplecontrol >>= \sc -> setOnZeroLS (sequencerSC sc) True es++-- | set next loop (starting at first bar after current events are played)+after :: [[Event]] -> IO ()+after es = readIORef ref_simplecontrol >>= \sc -> setOnZeroLS (sequencerSC sc) False es++-- | add some events to be played only once+once :: [[Event]] -> IO ()+once es = readIORef ref_simplecontrol >>= \sc -> setOnceLS (sequencerSC sc) es++-- | update next loop +fnext :: ([[Event]]->[[Event]]) -> IO ()+fnext f = readIORef ref_simplecontrol >>= \sc -> updOnZeroLS (sequencerSC sc) True f++-- | update next loop +fafter :: ([[Event]]->[[Event]]) -> IO ()+fafter f = readIORef ref_simplecontrol >>= \sc -> updOnZeroLS (sequencerSC sc) False f++-- | get next loop +current :: IO [[Event]]+current = readIORef ref_simplecontrol >>= \sc -> getOnZeroLS (sequencerSC sc)+
+ Sound/Hommage/DSPlayer/VoicePlayer.hs view
@@ -0,0 +1,39 @@+{- 2009 Daniel van den Eijkel <dvde@gmx.net> -} + +module Sound.Hommage.DSPlayer.VoicePlayer + ( Voice + , VoicePlayer (..) + , mkVoicePlayer + ) + where + +import Data.IORef + +-- | A Voice is an action that gets the current index of the output buffer. +-- Usually a voice updates the output buffer at the given index, and returns True. +-- False indicates that the voice is inactive and should be removed. +type Voice = Int -> IO Bool + +-- | A VoicePlayer encapsulates a list of voices that are active at the moment. +data VoicePlayer = VoicePlayer + { startVoice :: Voice -> IO () -- ^ Starts a voice (by adding it to the list of active voices) + , stepVoicePlayer :: Int -> IO () -- ^ Runs all voices with the given ouput array index, and removes inactive voices. + , clearVoicePlayer :: IO () -- ^ Removes all voices. + } + +-- | Creates a VoicePlayer +mkVoicePlayer :: IO VoicePlayer +mkVoicePlayer = do + vref <- newIORef [] + let addVoice v = atomicModifyIORef vref (\vs -> (v : vs, ())) + vloop i vs = let vloop' [] = return [] + vloop' (v:vs) = v i >>= \b -> + if b then vloop' vs >>= return . (v:) + else vloop' vs + in vloop' vs + step i = do voices <- readIORef vref + voices' <- vloop i voices + writeIORef vref $! voices' + stopAll = atomicModifyIORef vref (\_ -> ([], ())) + return $ VoicePlayer addVoice step stopAll +
+ Sound/Hommage/DSPlayer/Voices.hs view
@@ -0,0 +1,98 @@+{- 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 +-}
+ hommage-ds.cabal view
@@ -0,0 +1,29 @@+name: hommage-ds +version: 0.0.5 +license: GPL +author: Daniel van den Eijkel +maintainer: dvde@gmx.net +category: Sound +stability: experimental +homepage: substitut-fuer-feinmotorik/projects/haskellommage +synopsis: DirectSound extension (Windows) for the Hommage sound library +description: This library adds realtime sound playback to the hommage library. + It can be used with GHCi. + It is very experimental, not very fast + and supports only playback of Signals (Lists) and Samples (Wav-Files). + It contains a simple sequencer. +cabal-version: >=1.2 +build-type: Simple +ghc-options: -O2 + +build-depends: base>=2 && <=4, array, haskell98, DirectSound>=0.0.0, hommage>=0.0.5&&<=0.0.5 + +exposed-modules: Sound.Hommage.DSPlayer.DSPlayer , + Sound.Hommage.DSPlayer.AudioSample, + Sound.Hommage.DSPlayer.VoicePlayer, + Sound.Hommage.DSPlayer.Voices, + Sound.Hommage.DSPlayer.SimplePlayer, + Sound.Hommage.DSPlayer.SimpleControl, + Sound.Hommage.DSPlayer.UnsafeSimpleControl + +