diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,4 @@
+#!/usr/bin/env runhaskell
+import Distribution.Simple
+main = defaultMain
+
diff --git a/Sound/Hommage/DSPlayer/AudioSample.hs b/Sound/Hommage/DSPlayer/AudioSample.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/AudioSample.hs
@@ -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 }
+---------------------------------------------------------------------------------------------------
diff --git a/Sound/Hommage/DSPlayer/DSPlayer.hs b/Sound/Hommage/DSPlayer/DSPlayer.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/DSPlayer.hs
@@ -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
+  
diff --git a/Sound/Hommage/DSPlayer/SimpleControl.hs b/Sound/Hommage/DSPlayer/SimpleControl.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/SimpleControl.hs
@@ -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
+------------------------------------------------------------------------------
diff --git a/Sound/Hommage/DSPlayer/SimplePlayer.hs b/Sound/Hommage/DSPlayer/SimplePlayer.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/SimplePlayer.hs
@@ -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
+
diff --git a/Sound/Hommage/DSPlayer/UnsafeSimpleControl.hs b/Sound/Hommage/DSPlayer/UnsafeSimpleControl.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/UnsafeSimpleControl.hs
@@ -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)
+
diff --git a/Sound/Hommage/DSPlayer/VoicePlayer.hs b/Sound/Hommage/DSPlayer/VoicePlayer.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/VoicePlayer.hs
@@ -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
+
diff --git a/Sound/Hommage/DSPlayer/Voices.hs b/Sound/Hommage/DSPlayer/Voices.hs
new file mode 100644
--- /dev/null
+++ b/Sound/Hommage/DSPlayer/Voices.hs
@@ -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
+-} 
diff --git a/hommage-ds.cabal b/hommage-ds.cabal
new file mode 100644
--- /dev/null
+++ b/hommage-ds.cabal
@@ -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
+                    
+