alsa-pcm 0.5.0.1 → 0.6

raw patch · 20 files changed

+2037/−1019 lines, 20 filesdep +containersdep +storable-recorddep +transformersdep ~alsa-seqdep ~arraynew-component:exe:alsa-sinePVP ok

version bump matches the API change (PVP)

Dependencies added: containers, storable-record, transformers

Dependency ranges changed: alsa-seq, array

API changes (from Hackage documentation)

Files

• alsa-pcm.cabal +100/−42
• examples/duplex.hs +5/−5
• examples/play.hs +1/−1
• examples/record.hs +3/−3
• examples/sine.hs +88/−0
• examples/synth.hs +70/−83
• examples/volume_meter.hs +4/−4
• src/Sound/ALSA/PCM.hs +216/−328
• src/Sound/ALSA/PCM/C2HS.hs +0/−237
• src/Sound/ALSA/PCM/Core.chs +0/−316
• src/Sound/ALSA/PCM/Core/Class.hs +107/−0
• src/Sound/ALSA/PCM/Core/Convert.hs +34/−0
• src/Sound/ALSA/PCM/Core/Handle.hsc +157/−0
• src/Sound/ALSA/PCM/Core/HwParams.hsc +382/−0
• src/Sound/ALSA/PCM/Core/Params.h +247/−0
• src/Sound/ALSA/PCM/Core/SwParams.hsc +138/−0
• src/Sound/ALSA/PCM/Node/ALSA.hs +126/−0
• src/Sound/ALSA/PCM/Node/File.hs +60/−0
• src/Sound/ALSA/PCM/Parameters/Hardware.hs +262/−0
• src/Sound/ALSA/PCM/Parameters/Software.hs +37/−0

@@ -1,5 +1,5 @@ Name:          alsa-pcm-Version:       0.5.0.1+Version:       0.6 Copyright:     Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann Maintainer:    Henning Thielemann <alsa@henning-thielemann.de> Author:        Henning Thielemann <alsa@henning-thielemann.de>, Bjorn Bringert <bjorn@bringert.net>, Iavor S. Diatchki <iavor.diatchki@gmail.com>@@ -19,6 +19,7 @@ Extra-Source-Files:   nodebug/Sound/ALSA/PCM/Debug.hs   debug/Sound/ALSA/PCM/Debug.hs+  src/Sound/ALSA/PCM/Core/Params.h  Source-Repository head   type:     darcs@@ -27,7 +28,7 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/alsa/pcm/-  tag:      0.5.0.1+  tag:      0.6  Flag buildExamples   description: Build example executables@@ -44,12 +45,14 @@ Library   Build-depends:     alsa-core >=0.5 && <0.6,+    storable-record >=0.0.2 && <0.1,     sample-frame >=0.0.1 && <0.1,-    array >= 0.1 && <0.4,+    array >= 0.1 && <0.5,     extensible-exceptions >=0.1.1 && <0.2,     base >= 3 && <5    Hs-Source-Dirs: src+  Include-Dirs: src   If flag(debug)     Hs-Source-Dirs: debug   Else@@ -57,10 +60,17 @@    Exposed-Modules:     Sound.ALSA.PCM+    Sound.ALSA.PCM.Node.ALSA+    Sound.ALSA.PCM.Node.File+    Sound.ALSA.PCM.Parameters.Hardware+    Sound.ALSA.PCM.Parameters.Software    Other-modules:-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.Convert+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams     Sound.ALSA.PCM.Debug    GHC-Options: -Wall -fwarn-tabs@@ -70,77 +80,125 @@  Executable alsa-minisynth   Main-Is: synth.hs-  If !flag(buildSynthesizer)+  If flag(buildSynthesizer)+    Build-Depends:+      alsa-seq >=0.6 && <0.7,+      alsa-core >=0.5 && <0.6,+      containers >=0.2 && <0.5,+      transformers >=0.2 && <0.4,+      storablevector >=0.2.7 && <0.3,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False   Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src   GHC-Options: -Wall -threaded   Other-modules:     Sound.ALSA.PCM-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS-  Build-Depends:-    alsa-seq >=0.5 && <0.6,-    alsa-core >=0.5 && <0.6,-    storablevector >=0.2.7 && <0.3,-    sample-frame >=0.0.1 && <0.1,-    base >=3 && <5+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams +Executable alsa-sine+  Main-Is: sine.hs+  If flag(buildSynthesizer)+    Build-Depends:+      alsa-core >=0.5 && <0.6,+      storablevector >=0.2.7 && <0.3,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else+    Buildable: False+  Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src+  GHC-Options: -Wall -threaded+  Other-modules:+    Sound.ALSA.PCM+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams+ Executable alsa-duplex   Main-Is: duplex.hs-  If !flag(buildExamples)+  If flag(buildExamples)+    Build-Depends:+      alsa-core >=0.5 && <0.6,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False   Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src   GHC-Options: -Wall -threaded   Other-modules:     Sound.ALSA.PCM-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS-  Build-Depends:-    alsa-core >=0.5 && <0.6,-    sample-frame >=0.0.1 && <0.1,-    base >=3 && <5+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams  Executable alsa-play   Main-Is: play.hs-  If !flag(buildExamples)+  If flag(buildExamples)+    Build-Depends:+      alsa-core >=0.5 && <0.6,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False   Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src   GHC-Options: -Wall -threaded   Other-modules:     Sound.ALSA.PCM-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS-  Build-Depends:-    alsa-core >=0.5 && <0.6,-    sample-frame >=0.0.1 && <0.1,-    base >=3 && <5+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams  Executable alsa-record   Main-Is: record.hs-  If !flag(buildExamples)+  If flag(buildExamples)+    Build-Depends:+      alsa-core >=0.5 && <0.6,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False   Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src   GHC-Options: -Wall -threaded   Other-modules:     Sound.ALSA.PCM-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS-  Build-Depends:-    alsa-core >=0.5 && <0.6,-    sample-frame >=0.0.1 && <0.1,-    base >=3 && <5+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams  Executable alsa-volume-meter   Main-Is: volume_meter.hs-  If !flag(buildExamples)+  If flag(buildExamples)+    Build-Depends:+      alsa-core >=0.5 && <0.6,+      storable-record >=0.0.2 && <0.1,+      sample-frame >=0.0.1 && <0.1,+      base >=3 && <5+  Else     Buildable: False   Hs-Source-Dirs: src, debug, examples+  Include-Dirs: src   GHC-Options: -Wall -threaded   Other-modules:     Sound.ALSA.PCM-    Sound.ALSA.PCM.Core-    Sound.ALSA.PCM.C2HS-  Build-Depends:-    alsa-core >=0.5 && <0.6,-    sample-frame >=0.0.1 && <0.1,-    base >=3 && <5+    Sound.ALSA.PCM.Core.Class+    Sound.ALSA.PCM.Core.Handle+    Sound.ALSA.PCM.Core.HwParams+    Sound.ALSA.PCM.Core.SwParams

@@ -13,7 +13,7 @@ bufSize = 4096  soundFormat :: SoundFmt Int16-soundFormat = SoundFmt { sampleFreq  = 8000 }+soundFormat = SoundFmt { sampleFreq = 8000 }  main :: IO () main = do args <- getArgs@@ -32,12 +32,12 @@  play :: FilePath -> IO () play file =-    do let source = fileSoundSource file soundFormat-           sink   = alsaSoundSink "plughw:0,0" soundFormat+    do let source = fileSoundSource file+           sink   = alsaSoundSink "default" soundFormat        copySound source sink bufSize  record :: FilePath -> IO () record file =-    do let source = alsaSoundSource "plughw:0,0" soundFormat-           sink   = fileSoundSink file soundFormat+    do let source = alsaSoundSource "default" soundFormat+           sink   = fileSoundSink file        copySound source sink bufSize

@@ -19,7 +19,7 @@ play :: FilePath -> IO () play file =    copySound-      (fileSoundSource file soundFormat)+      (fileSoundSource file)       -- "default" allows mixing with other ALSA programs       (alsaSoundSink "default" soundFormat)       bufSize

@@ -11,7 +11,7 @@ bufSize = 8192  soundFormat :: SoundFmt Int16-soundFormat = SoundFmt { sampleFreq  = 8000 }+soundFormat = SoundFmt { sampleFreq = 8000 }  main :: IO () main = do args <- getArgs@@ -22,6 +22,6 @@  record :: FilePath -> IO () record file =-    do let source = alsaSoundSource "plughw:0,0" soundFormat-           sink   = fileSoundSink file soundFormat+    do let source = alsaSoundSource "default" soundFormat+           sink   = fileSoundSink file        copySound source sink bufSize

@@ -0,0 +1,88 @@+{- |+Demonstrate how to adapt to the parameters 'sample rate' and 'buffer size'+that are supported natively by the hardware.+-}+import qualified Sound.ALSA.PCM.Node.ALSA as PCM+import qualified Sound.ALSA.PCM.Parameters.Software as SwParam+import qualified Sound.ALSA.PCM.Parameters.Hardware as HwParam++import qualified Sound.ALSA.PCM.Debug as Debug++import qualified Data.StorableVector.Lazy as SVL+import qualified Data.StorableVector.Base as SVB++import Control.Exception (bracket, )++++openPCM ::+   (PCM.Access i, PCM.SampleFmt y) =>+   IO (PCM.Size, PCM.SampleFreq, PCM.Handle i y)+openPCM = do+   Debug.put "alsaOpenTest"+   (((bufferSize,periodSize),(bufferTime,periodTime),sampleRate), h) <-+      PCM.open (PCM.modes []) PCM.StreamPlayback+         (setHwParams 44100 1024 64)+         (\q@(sizes,_,_) -> do+             uncurry SwParam.setBufferSize sizes+             return q)+         "plughw:0"+   PCM.prepare h+   Debug.put $ "bufferTime = " ++ show bufferTime+   Debug.put $ "bufferSize = " ++ show bufferSize+   Debug.put $ "periodTime = " ++ show periodTime+   Debug.put $ "periodSize = " ++ show periodSize+   return (periodSize, sampleRate, h)++closePCM :: (PCM.Size, PCM.SampleFreq, PCM.Handle i y) -> IO ()+closePCM (_,_,pcm) = do+   Debug.put "alsaClose"+   PCM.drain pcm+   PCM.close pcm++setHwParams ::+      PCM.SampleFreq -- ^ sample frequency+   -> PCM.Size -- ^ buffer size+   -> PCM.Size -- ^ period size+   -> HwParam.T i y ((PCM.Size,PCM.Size),(PCM.Time,PCM.Time),PCM.SampleFreq)+      -- ^ ((bufferSize,periodSize),(bufferTime,periodTime),sampleRate)+setHwParams rate bufferSize periodSize = do+{-+   (actualRate,ord) <- HwParam.getRateMax+   print ord+-}+   HwParam.setRateResample False+   (actualRate,_) <-+      HwParam.setRateNear rate EQ+   (actualPeriodSize,_) <-+      HwParam.setPeriodSizeNear periodSize EQ+   actualBufferSize <-+      HwParam.setBufferSizeNear+         (max bufferSize (actualPeriodSize*2))+{-+   let actualBufferSize = bufferSize+   HwParam.setBufferSize bufferSize+-}+   (actualBufferTime,_) <- HwParam.getBufferTime+   (actualPeriodTime,_) <- HwParam.getPeriodTime+   return ((actualBufferSize, actualPeriodSize),+           (actualBufferTime, actualPeriodTime),+           actualRate)++write ::+   (PCM.SampleFmt y) =>+   PCM.Handle PCM.Interleaved y -> SVB.Vector y -> IO ()+write h xs =+   SVB.withStartPtr xs $ \buf ->+      fmap (const ()) . PCM.writeiRetry h buf . fromIntegral+++main :: IO ()+main =+   bracket openPCM closePCM $ \(size,rate,h) -> do+   putStrLn $ "period size: " ++ show size+   putStrLn $ "sample rate: " ++ show rate+   mapM_ (write h) $+      SVL.chunks $+      SVL.map ((0.99*) . sin . ((2*pi * 440 / fromIntegral rate :: Float)*)) $+      SVL.iterate (SVL.chunkSize $ fromIntegral size) (1 +) 0

@@ -1,18 +1,19 @@-import qualified Sound.ALSA.PCM as PCM+import qualified Sound.ALSA.PCM.Node.ALSA as PCM+import qualified Sound.ALSA.PCM.Parameters.Software as SwParam+import qualified Sound.ALSA.PCM.Parameters.Hardware as HwParam -import qualified Sound.ALSA.PCM.Core as Core-import qualified Sound.ALSA.Exception as AlsaExc import qualified Sound.ALSA.PCM.Debug as Debug  import qualified Sound.ALSA.Sequencer.Address as Addr import qualified Sound.ALSA.Sequencer.Client as Client import qualified Sound.ALSA.Sequencer.Port as Port-import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo+import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfo import qualified Sound.ALSA.Sequencer.Event as Event import qualified Sound.ALSA.Sequencer.Queue as Queue+import qualified Sound.ALSA.Sequencer.Time as Time import qualified Sound.ALSA.Sequencer.RealTime as RealTime import qualified Sound.ALSA.Sequencer as SndSeq--- import qualified Sound.ALSA.Exception as AlsaExc+import Sound.ALSA.Sequencer.Event (Pitch, Velocity, )  import qualified Data.StorableVector.ST.Strict as SVST import qualified Data.StorableVector as SV@@ -26,87 +27,74 @@  import qualified Data.Map as Map -import Data.Word (Word8, )- import Control.Exception (bracket, ) import Control.Monad (liftM, forever, )  import Debug.Trace (trace, )  -soundFormat :: PCM.SoundFmt Float-soundFormat = PCM.SoundFmt { PCM.sampleFreq = 44100 }--openPCM :: IO (Int, Int, Core.Pcm)+openPCM ::+   (PCM.Access i, PCM.SampleFmt y) =>+   IO (PCM.Size, PCM.SampleFreq, PCM.Handle i y) openPCM = do    Debug.put "alsaOpenTest"-   h <- Core.pcm_open "default" Core.PcmStreamPlayback 0-   (bufferTime,bufferSize,periodTime,periodSize,sampleRate) <--      setHwParams h-         (PCM.withSampleFmt PCM.sampleFmtToPcmFormat soundFormat)-         (PCM.numChannels soundFormat)-         (PCM.sampleFreq soundFormat)-         1024 64-   PCM.setSwParams h bufferSize periodSize-   Core.pcm_prepare h+   (((bufferSize,periodSize),(bufferTime,periodTime),sampleRate), h) <-+      PCM.open (PCM.modes []) PCM.StreamPlayback+         (setHwParams 44100 1024 64)+         (\q@(sizes,_,_) -> do+             uncurry SwParam.setBufferSize sizes+             return q)+         "default"+   PCM.prepare h    Debug.put $ "bufferTime = " ++ show bufferTime    Debug.put $ "bufferSize = " ++ show bufferSize    Debug.put $ "periodTime = " ++ show periodTime    Debug.put $ "periodSize = " ++ show periodSize    return (periodSize, sampleRate, h) -closePCM :: (Int, Int, Core.Pcm) -> IO ()-closePCM (_,_,pcm) = AlsaExc.rethrow $ do+closePCM :: (PCM.Size, PCM.SampleFreq, PCM.Handle i y) -> IO ()+closePCM (_,_,pcm) = do    Debug.put "alsaClose"-   Core.pcm_drain pcm-   Core.pcm_close pcm+   PCM.drain pcm+   PCM.close pcm  setHwParams ::-      Core.Pcm-   -> Core.PcmFormat-   -> Int -- ^ number of channels-   -> PCM.SampleFreq -- ^ sample frequency-   -> Int -- ^ buffer size-   -> Int -- ^ period size-   -> IO (Int,Int,Int,Int,Int)-      -- ^ (bufferTime,bufferSize,periodTime,periodSize)-setHwParams h format channels rate bufferSize periodSize =-   PCM.withHwParams h $ \p -> do-      Core.pcm_hw_params_set_access h p Core.PcmAccessRwInterleaved-      Core.pcm_hw_params_set_format h p format-      Core.pcm_hw_params_set_channels h p channels+      PCM.SampleFreq -- ^ sample frequency+   -> PCM.Size -- ^ buffer size+   -> PCM.Size -- ^ period size+   -> HwParam.T i y ((PCM.Size,PCM.Size),(PCM.Time,PCM.Time),PCM.SampleFreq)+      -- ^ ((bufferSize,periodSize),(bufferTime,periodTime),sampleRate)+setHwParams rate bufferSize periodSize = do {--      (actualRate,ord) <--         Core.pcm_hw_params_get_rate_max p-      print ord+   (actualRate,ord) <- HwParam.getRateMax+   print ord -}-      Core.pcm_hw_params_set_rate_resample h p False-      (actualRate,_) <--         Core.pcm_hw_params_set_rate_near h p rate EQ-      (actualPeriodSize,_) <--         Core.pcm_hw_params_set_period_size_near h p periodSize EQ-      actualBufferSize <--         Core.pcm_hw_params_set_buffer_size_near h p-            (max bufferSize (actualPeriodSize*2))+   HwParam.setRateResample False+   (actualRate,_) <-+      HwParam.setRateNear rate EQ+   (actualPeriodSize,_) <-+      HwParam.setPeriodSizeNear periodSize EQ+   actualBufferSize <-+      HwParam.setBufferSizeNear+         (max bufferSize (actualPeriodSize*2)) {--      let actualBufferSize = bufferSize-      Core.pcm_hw_params_set_buffer_size h p bufferSize+   let actualBufferSize = bufferSize+   HwParam.setBufferSize bufferSize -}-      (actualBufferTime,_) <- Core.pcm_hw_params_get_buffer_time p-      (actualPeriodTime,_) <- Core.pcm_hw_params_get_period_time p-      return (actualBufferTime, actualBufferSize,-              actualPeriodTime, actualPeriodSize,-              actualRate)+   (actualBufferTime,_) <- HwParam.getBufferTime+   (actualPeriodTime,_) <- HwParam.getPeriodTime+   return ((actualBufferSize, actualPeriodSize),+           (actualBufferTime, actualPeriodTime),+           actualRate)   setTimestamping ::    SndSeq.T mode -> Port.T -> Queue.T -> IO ()-setTimestamping h p q = do-   info <- PortInfo.get h p-   PortInfo.setTimestamping info True-   PortInfo.setTimestampReal info True-   PortInfo.setTimestampQueue info q-   PortInfo.set h p info+setTimestamping h p q =+   PortInfo.modify h p $ do+      PortInfo.setTimestamping True+      PortInfo.setTimestampReal True+      PortInfo.setTimestampQueue q   withInPort ::@@ -128,16 +116,17 @@  {- | RealTime.toFractional for NumericPrelude.--}+ realTimeToField :: (Fractional a) => RealTime.T -> a realTimeToField (RealTime.Cons s n) =    fromIntegral s + fromIntegral n / (10^(9::Int))+-}  addStamp ::    Time -> Event.T -> StampedEvent addStamp rate ev =-   (case Event.timestamp ev of-      Event.RealTime t ->+   (case Event.time ev of+      Time.Cons Time.Absolute (Time.Real t) ->          div (RealTime.toInteger t * rate) nano       _ -> error "unsupported time stamp type",     ev)@@ -186,7 +175,7 @@       (Addr.Cons c Port.unknown)       (Event.CustomEv Event.Echo dat))       { Event.queue = q-      , Event.timestamp = Event.RealTime t+      , Event.time = Time.consAbs $ Time.Real t       , Event.dest = Addr.Cons {            Addr.client = c,            Addr.port = p@@ -211,8 +200,8 @@                     _ -> False           if abort             then-               case Event.timestamp ev of-                 Event.RealTime t -> do+               case Event.time ev of+                 Time.Cons Time.Absolute (Time.Real _t) -> do --                    putStrLn $ "got Echo at: " ++ show (RealTime.toInteger t :: Double)                     return []                  _ -> error "unsupported time stamp type"@@ -245,19 +234,16 @@  arrange ::    (Storable a, Num a) =>-   Int ->+   PCM.Size ->    [(Int, SV.Vector a)] ->    SV.Vector a arrange size evs =    SVST.runSTVector (do-      v <- SVST.new size 0+      v <- SVST.new (fromIntegral size) 0       mapM_ (uncurry $ unsafeAddChunkToBuffer v) evs       return v)  -type Pitch = Word8-type Velocity = Word8- data OscillatorState a = OscillatorState a a Int  {-@@ -298,13 +284,13 @@ amplitudeFromVelocity ::    (Floating y) =>    Velocity -> y-amplitudeFromVelocity vel =+amplitudeFromVelocity (Event.Velocity vel) =    4 ** ((fromIntegral vel - 64) / 128)  frequencyFromPitch ::    (Floating y) =>    Pitch -> y-frequencyFromPitch pitch =+frequencyFromPitch (Event.Pitch pitch) =    440 * 2 ** (fromIntegral (fromIntegral pitch + 3 - 6*12 :: Int) / 12)  normalizeNote :: Event.NoteEv -> Event.Note -> (Event.NoteEv, Velocity)@@ -313,14 +299,14 @@       velocity ->          case notePart of             Event.NoteOn ->-               if velocity == 0-                 then (Event.NoteOff, 64)+               if velocity == Event.offVelocity+                 then (Event.NoteOff, Event.normalVelocity)                  else (Event.NoteOn, velocity)             _ -> (notePart, velocity)  processEvents ::    (Storable a, Floating a, Monad m) =>-   Int ->+   PCM.Size ->    PCM.SampleFreq ->    [StampedEvent] ->    MS.StateT (Time, Map.Map Pitch (OscillatorState a)) m [(Int, SV.Vector a)]@@ -332,7 +318,7 @@                 let mplayingNew =                        fmap                           (\(start,s0) ->-                             case renderTone (size-start) s0 of+                             case renderTone (fromIntegral size - start) s0 of                                 (chunk, s1) -> ((start,chunk), s1))                           mplaying                 in  (fmap snd mplayingNew,@@ -383,10 +369,11 @@   write ::-   (PCM.SampleFmt a) =>-   Core.Pcm -> SV.Vector a -> IO ()+   (PCM.SampleFmt y) =>+   PCM.Handle PCM.Interleaved y -> SV.Vector y -> IO () write h xs =-   SVB.withStartPtr xs $ PCM.alsaWrite h+   SVB.withStartPtr xs $ \buf ->+      fmap (const ()) . PCM.writeiRetry h buf . fromIntegral   {-@@ -405,9 +392,9 @@    withInPort SndSeq.Block $ \sq port ->       Queue.with sq $ \ q ->       do setTimestamping sq port q-         Queue.control sq q Event.QueueStart 0 Nothing+         Queue.control sq q Event.QueueStart Nothing          _ <- Event.drainOutput sq-         write h (SV.replicate (2*size) 0 :: SV.Vector Float)+         write h (SV.replicate (2 * fromIntegral size) 0 :: SV.Vector Float)          flip MS.evalStateT (0,Map.empty) $ forever $ do             startTime <- MS.gets fst             let stopTime = startTime + fromIntegral size

@@ -11,17 +11,17 @@ bufSize = 1000  inputFormat :: SoundFmt Int16-inputFormat = SoundFmt { sampleFreq  = 8000 }+inputFormat = SoundFmt { sampleFreq = 8000 }   main :: IO ()-main = let source = alsaSoundSource "plughw:0,0" inputFormat+main = let source = alsaSoundSource "default" inputFormat         in allocaArray     bufSize $ \buf  ->            withSoundSource source  $ \from ->                loop source from bufSize buf --- FIXME: assumes little-endian machine-loop :: SoundSource Int16 h -> h -> Int -> Ptr Int16 -> IO ()+-- | assumes that the file contains numbers in the host's byte order+loop :: SoundSource h Int16 -> h Int16 -> Int -> Ptr Int16 -> IO () loop src h n buf =     do n' <- soundSourceRead src h (castPtr buf) n        avg <- avgBuf buf n'

@@ -1,13 +1,14 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.PCM-    (SampleFmt(..),+    (Class.SampleFmt(..),      SampleFreq,      Time,+     Size,      SoundFmt(..),      SoundSource(..),      SoundSink(..),      SoundBufferTime(..),-     Pcm,+     Pcm, File,      withSoundSource,      withSoundSourceRunning,      withSoundSink,@@ -22,159 +23,99 @@      alsaSoundSink,      alsaSoundSourceTime,      alsaSoundSinkTime,+     alsaSoundSourceParams,+     alsaSoundSinkParams,      fileSoundSource,      fileSoundSink,     ) where -import Sound.ALSA.PCM.Core (Pcm)-import qualified Sound.ALSA.PCM.Core as PCM+import qualified Sound.ALSA.PCM.Node.ALSA as PCM+import qualified Sound.ALSA.PCM.Node.File as File++import Sound.ALSA.PCM.Parameters.Hardware (Time, SampleFreq, Size, )+import Sound.ALSA.PCM.Core.Handle (arraySize, )+import qualified Sound.ALSA.PCM.Parameters.Software as SwParam+import qualified Sound.ALSA.PCM.Parameters.Hardware as HwParam+import qualified Sound.ALSA.PCM.Core.Class as Class import qualified Sound.ALSA.Exception as AlsaExc import qualified Sound.ALSA.PCM.Debug as Debug  import qualified Sound.Frame as Frame-import qualified Sound.Frame.Stereo as Stereo-import qualified Sound.Frame.MuLaw  as MuLaw -import Data.Word (Word8, Word16, Word32, )-import Data.Int (Int8, Int16, Int32, )- import Control.Exception (bracket, bracket_, )-import Control.Monad (liftM, when, )-import Foreign.Marshal.Array (advancePtr, allocaArray, )-import Foreign.C (CSize, CInt, )-import Foreign (Storable, Ptr, minusPtr, )+import Control.Monad (when, liftM2, liftM4, )++import qualified Foreign.C.Types as C+import Foreign.Marshal.Array (allocaArray, )+import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, ) import qualified System.IO as IO-import System.IO-   (IOMode(ReadMode, WriteMode), Handle, openBinaryFile, hClose, )  -- -- * Generic sound API -- -class (Storable y, Frame.C y) => SampleFmt y where-   sampleFmtToPcmFormat :: y -> PCM.Format--type SampleFreq = Int- data SoundFmt y = SoundFmt {         sampleFreq :: SampleFreq         }   deriving (Show) -type Time = Int- data SoundBufferTime = SoundBufferTime {         bufferTime, periodTime :: Time         }   deriving (Show)  --- | Counts are in samples, not bytes. Multi-channel data is interleaved.-data SoundSource y handle =-    SoundSource {-                 soundSourceFmt   :: SoundFmt y,-                 soundSourceOpen  :: IO handle,-                 soundSourceClose :: handle -> IO (),-                 soundSourceStart :: handle -> IO (),-                 soundSourceStop  :: handle -> IO (),-                 soundSourceRead  :: handle -> Ptr y -> Int -> IO Int-                }+type Pcm = PCM.Handle PCM.Interleaved -data SoundSink y handle =-    SoundSink {-                 soundSinkFmt   :: SoundFmt y,-                 soundSinkOpen  :: IO handle,-                 soundSinkClose :: handle -> IO (),-                 soundSinkWrite :: handle -> Ptr y -> Int -> IO (),-                 soundSinkStart :: handle -> IO (),-                 soundSinkStop  :: handle -> IO ()-                }+type File = File.Handle --------- -defaultBufferTime :: SoundBufferTime-defaultBufferTime =-    SoundBufferTime {-        bufferTime = 500000, -- 0.5s-        periodTime = 100000  -- 0.1s-    }--nullSoundSource :: SoundFmt y -> SoundSource y h-nullSoundSource fmt =-    SoundSource {-                 soundSourceFmt   = fmt,-                 soundSourceOpen  = return undefined,-                 soundSourceClose = \_ -> return (),-                 soundSourceStart = \_ -> return (),-                 soundSourceStop  = \_ -> return (),-                 soundSourceRead  = \_ _ _ -> return 0-                }+-- | Counts are in samples, not bytes. Multi-channel data is interleaved.+data SoundSource handle y =+   SoundSource {+      soundSourceOpen  :: IO (handle y),+      soundSourceClose :: handle y -> IO (),+      soundSourceStart :: handle y -> IO (),+      soundSourceStop  :: handle y -> IO (),+      soundSourceRead  :: handle y -> Ptr y -> Size -> IO Size+   } -nullSoundSink :: SoundFmt y -> SoundSink y h-nullSoundSink fmt =-    SoundSink {-               soundSinkFmt   = fmt,-               soundSinkOpen  = return undefined,-               soundSinkClose = \_ -> return (),-               soundSinkStart = \_ -> return (),-               soundSinkStop  = \_ -> return (),-               soundSinkWrite = \_ _ _ -> return ()-              }+data SoundSink handle y =+   SoundSink {+      soundSinkOpen  :: IO (handle y),+      soundSinkClose :: handle y -> IO (),+      soundSinkWrite :: handle y -> Ptr y -> Size -> IO (),+      soundSinkStart :: handle y -> IO (),+      soundSinkStop  :: handle y -> IO ()+   }  -withSoundSource :: SoundSource y h -> (h -> IO a) -> IO a+withSoundSource :: SoundSource handle y -> (handle y -> IO a) -> IO a withSoundSource source =     bracket (soundSourceOpen source) (soundSourceClose source) -withSoundSourceRunning :: SoundSource y h -> h -> IO a -> IO a-withSoundSourceRunning src h = bracket_ (soundSourceStart src h) (soundSourceStop src h)+withSoundSourceRunning :: SoundSource handle y -> handle y -> IO a -> IO a+withSoundSourceRunning src h =+    bracket_ (soundSourceStart src h) (soundSourceStop src h) -withSoundSink :: SoundSink y h -> (h -> IO a) -> IO a+withSoundSink :: SoundSink handle y -> (handle y -> IO a) -> IO a withSoundSink sink =     bracket (soundSinkOpen sink) (soundSinkClose sink) -withSoundSinkRunning :: SoundSink y h -> h -> IO a -> IO a-withSoundSinkRunning src h = bracket_ (soundSinkStart src h) (soundSinkStop src h)+withSoundSinkRunning :: SoundSink handle y -> handle y -> IO a -> IO a+withSoundSinkRunning src h =+    bracket_ (soundSinkStart src h) (soundSinkStop src h)  -instance SampleFmt Word8 where-   sampleFmtToPcmFormat _ = PCM.FormatU8--instance SampleFmt Int8 where-   sampleFmtToPcmFormat _ = PCM.FormatS8--instance SampleFmt Word16 where-   sampleFmtToPcmFormat _ = PCM.FormatU16--instance SampleFmt Int16 where-   sampleFmtToPcmFormat _ = PCM.FormatS16--instance SampleFmt Word32 where-   sampleFmtToPcmFormat _ = PCM.FormatU32--instance SampleFmt Int32 where-   sampleFmtToPcmFormat _ = PCM.FormatS32--instance SampleFmt Float where-   sampleFmtToPcmFormat _ = PCM.FormatFloat--instance SampleFmt Double where-   sampleFmtToPcmFormat _ = PCM.FormatFloat64--instance SampleFmt MuLaw.T where-   sampleFmtToPcmFormat _ = PCM.FormatMuLaw--instance SampleFmt a => SampleFmt (Stereo.T a) where-   sampleFmtToPcmFormat y =-      sampleFmtToPcmFormat (Stereo.left y)- withSampleFmt :: (y -> a) -> (SoundFmt y -> a) withSampleFmt f _ = f undefined +withNodeSample :: (y -> a) -> (node y -> a)+withNodeSample f _ = f undefined -soundFmtMIME :: SampleFmt y => SoundFmt y -> String++soundFmtMIME :: Class.SampleFmt y => SoundFmt y -> String soundFmtMIME fmt = t ++ r ++ c   where t = "audio/basic" {-@@ -183,13 +124,15 @@                 SampleFmtMuLaw8Bit           -> "audio/basic" -}         r = ";rate=" ++ show (sampleFreq fmt)-        c | numChannels fmt == 1 = ""-          | otherwise = ";channels=" ++ show (numChannels fmt)+        c =+           if numChannels fmt == 1+             then ""+             else ";channels=" ++ show (numChannels fmt) -numChannels :: SampleFmt y => SoundFmt y -> Int+numChannels :: Class.SampleFmt y => SoundFmt y -> Int numChannels = withSampleFmt Frame.numberOfChannels -audioBytesPerSample :: SampleFmt y => SoundFmt y -> Int+audioBytesPerSample :: Class.SampleFmt y => SoundFmt y -> Int audioBytesPerSample = withSampleFmt Frame.sizeOfElement  {-@@ -199,22 +142,25 @@ a frame might occupy more than the calculated size in an array in memory. -}-audioBytesPerFrame :: SampleFmt y => SoundFmt y -> Int+audioBytesPerFrame :: Class.SampleFmt y => SoundFmt y -> Int audioBytesPerFrame fmt = numChannels fmt * audioBytesPerSample fmt -soundSourceBytesPerFrame :: SampleFmt y => SoundSource y h -> Int-soundSourceBytesPerFrame = audioBytesPerFrame . soundSourceFmt+soundSourceBytesPerFrame :: Class.SampleFmt y => SoundSource handle y -> Int+soundSourceBytesPerFrame =+   withNodeSample $ \y -> Frame.numberOfChannels y * Frame.sizeOfElement y -soundSinkBytesPerFrame :: SampleFmt y => SoundSink y h -> Int-soundSinkBytesPerFrame = audioBytesPerFrame . soundSinkFmt+soundSinkBytesPerFrame :: Class.SampleFmt y => SoundSink handle y -> Int+soundSinkBytesPerFrame =+   withNodeSample $ \y -> Frame.numberOfChannels y * Frame.sizeOfElement y -copySound :: SampleFmt y =>-             SoundSource y h1-          -> SoundSink y h2-          -> Int -- ^ Buffer size (in sample frames) to use-          -> IO ()+copySound ::+   Class.SampleFmt y =>+      SoundSource handleIn y+   -> SoundSink handleOut y+   -> Size -- ^ Buffer size (in sample frames) to use+   -> IO () copySound source sink bufSize =-    allocaArray     bufSize $ \buf ->+    allocaArray     (fromIntegral bufSize) $ \buf ->     withSoundSource source  $ \from ->     withSoundSink   sink    $ \to ->        let loop = do n <- soundSourceRead source from buf bufSize@@ -227,250 +173,192 @@ --  -alsaOpen :: SampleFmt y =>-           String -- ^ device, e.g @"default"@-        -> SoundFmt y-        -> SoundBufferTime-        -> PCM.Stream-        -> IO Pcm-alsaOpen dev fmt time stream = AlsaExc.rethrow $-    do Debug.put "alsaOpen"-       h <- PCM.open dev stream 0-       Debug.put $ "requested buffer_time = " ++ show (bufferTime time)-       Debug.put $ "requested period_time = " ++ show (periodTime time)-       (buffer_time,buffer_size,period_time,period_size) <--           setHwParams h (withSampleFmt sampleFmtToPcmFormat fmt)-                         (numChannels fmt)-                         (sampleFreq fmt)-                         (bufferTime time)-                         (periodTime time)-       setSwParams h buffer_size period_size-       PCM.prepare h-       Debug.put $ "buffer_time = " ++ show buffer_time-       Debug.put $ "buffer_size = " ++ show buffer_size-       Debug.put $ "period_time = " ++ show period_time-       Debug.put $ "period_size = " ++ show period_size-       when (stream == PCM.StreamPlayback) $-         callocaArray fmt period_size $ \buf ->-            PCM.writei h buf period_size >> return ()-       return h+{- |+The buffer is initialized with an empty block+which means that the zero bit pattern+should equal the number zero in the Class.SampleFmt type.+-}+alsaOpen :: Class.SampleFmt y =>+   PCM.Stream ->+   HwParam.T PCM.Interleaved y a ->+   (a -> SwParam.T PCM.Interleaved y ()) ->+   String {- ^ device, e.g @"default"@ -} ->+   IO (Pcm y)+alsaOpen stream hwParams swParams dev = AlsaExc.rethrow $ do+   Debug.put "alsaOpen"+   {-+   Debug.put $ "requested bufferTime = " ++ show (bufferTime time)+   Debug.put $ "requested periodTime = " ++ show (periodTime time)+   -}+   ((bufferTime_,bufferSize_,periodTime_,periodSize_), h) <-+      PCM.open (PCM.modes []) stream+         (liftM2 (,) hwParams $+          liftM4 (,,,)+             HwParam.getBufferSize+             HwParam.getBufferTime+             (fmap fst HwParam.getPeriodSize)+             (fmap fst HwParam.getPeriodTime))+         (\(a, params) -> swParams a >> return params)+         dev+   PCM.prepare h+   Debug.put $ "bufferTime = " ++ show bufferTime_+   Debug.put $ "bufferSize = " ++ show bufferSize_+   Debug.put $ "periodTime = " ++ show periodTime_+   Debug.put $ "periodSize = " ++ show periodSize_+   when (stream == PCM.StreamPlayback) $+      callocaArray periodSize_ $ \buf ->+         PCM.writei h buf (fromIntegral periodSize_) >> return ()+   return h +alsaClose :: Pcm y -> IO ()+alsaClose h = AlsaExc.rethrow $ do+   Debug.put "alsaClose"+   PCM.drain h+   PCM.close h -setHwParams :: Pcm-            -> PCM.Format-            -> Int -- ^ number of channels-            -> SampleFreq -- ^ sample frequency-            -> Time -- ^ buffer time-            -> Time -- ^ period time-            -> IO (Int,Int,Int,Int)-               -- ^ (buffer_time,buffer_size,period_time,period_size)-setHwParams h format channels rate buffer_time period_time-  = withHwParams h $ \p ->-    do PCM.hw_params_set_access h p PCM.AccessRwInterleaved-       PCM.hw_params_set_format h p format-       PCM.hw_params_set_channels h p channels-       PCM.hw_params_set_rate h p rate EQ-       (actual_buffer_time,_) <--           PCM.hw_params_set_buffer_time_near h p buffer_time EQ-       buffer_size <- PCM.hw_params_get_buffer_size p-       (actual_period_time,_) <--           PCM.hw_params_set_period_time_near h p period_time EQ-       (period_size,_) <- PCM.hw_params_get_period_size p-       return (actual_buffer_time,buffer_size,-               actual_period_time,period_size) -setSwParams :: Pcm-            -> Int -- ^ buffer size-            -> Int -- ^ period size-            -> IO ()-setSwParams h _buffer_size period_size = withSwParams h $ \p ->-    do -- let start_threshold =-       --        (buffer_size `div` period_size) * period_size-       --PCM.sw_params_set_start_threshold h p start_threshold-       PCM.sw_params_set_start_threshold h p 0-       PCM.sw_params_set_avail_min h p period_size-       PCM.sw_params_set_xfer_align h p 1-       -- pad buffer with silence when needed-       --PCM.sw_params_set_silence_size h p period_size-       --PCM.sw_params_set_silence_threshold h p period_size--withHwParams :: Pcm -> (PCM.HwParams -> IO a) -> IO a-withHwParams h f =-    bracket PCM.hw_params_malloc PCM.hw_params_free $ \p ->-    do PCM.hw_params_any h p-       x <- f p-       PCM.hw_params h p-       return x--withSwParams :: Pcm -> (PCM.SwParams -> IO a) -> IO a-withSwParams h f =-    bracket PCM.sw_params_malloc PCM.sw_params_free $ \p ->-    do PCM.sw_params_current h p-       x <- f p-       PCM.sw_params h p-       return x--alsaClose :: Pcm -> IO ()-alsaClose pcm = AlsaExc.rethrow $-    do Debug.put "alsaClose"-       PCM.drain pcm-       PCM.close pcm--alsaStart :: Pcm -> IO ()-alsaStart pcm = AlsaExc.rethrow $-    do Debug.put "alsaStart"-       PCM.prepare pcm-       PCM.start pcm-+alsaStart :: Pcm y -> IO ()+alsaStart h = AlsaExc.rethrow $ do+   Debug.put "alsaStart"+   PCM.prepare h+   PCM.start h  -- FIXME: use PCM.drain for sinks?-alsaStop :: Pcm -> IO ()-alsaStop pcm = AlsaExc.rethrow $-    do Debug.put "alsaStop"-       PCM.drain pcm+alsaStop :: Pcm y -> IO ()+alsaStop h = AlsaExc.rethrow $ do+   Debug.put "alsaStop"+   PCM.drain h + alsaRead ::-   SampleFmt y =>-   Pcm -> Ptr y -> Int -> IO Int+   Class.SampleFmt y =>+   Pcm y -> Ptr y -> Size -> IO Size alsaRead h buf0 n =-   let go buf offset = do-          -- debug $ "Reading " ++ show n ++ " samples..."-          nread <--             PCM.readi h buf (n-offset)-             `AlsaExc.catchXRun`-             do Debug.put "snd_pcm_readi reported buffer over-run"-                PCM.prepare h-                go buf offset-          let newOffset = offset+nread-          -- debug $ "Got " ++ show n' ++ " samples."-          if newOffset < n-            then go (advancePtr buf nread) newOffset-            else return newOffset-   in  AlsaExc.rethrow $ go buf0 0-+   AlsaExc.rethrow $ PCM.readiRetry h buf0 n  alsaWrite ::-   SampleFmt y =>-   Pcm -> Ptr y -> Int -> IO ()-alsaWrite h buf n = AlsaExc.rethrow $-    alsaWrite_ h buf n >> return ()+   Class.SampleFmt y =>+   Pcm y -> Ptr y -> Size -> IO Size+alsaWrite h buf0 n =+   AlsaExc.rethrow $ PCM.writeiRetry h buf0 n -alsaWrite_ ::-   SampleFmt y =>-   Pcm -> Ptr y -> Int -> IO Int-alsaWrite_ h buf0 n =-   let go buf offset = do-          --debug $ "Writing " ++ show n ++ " samples..."-          nwritten <--             PCM.writei h buf n-             `AlsaExc.catchXRun`-             do Debug.put "snd_pcm_writei reported buffer under-run"-                PCM.prepare h-                go buf offset-          let newOffset = offset+nwritten-          --debug $ "Wrote " ++ show n' ++ " samples."-          if newOffset < n-            then go (advancePtr buf nwritten) newOffset-            else return newOffset-   in  AlsaExc.rethrow $ go buf0 0 +defaultBufferTime :: SoundBufferTime+defaultBufferTime =+   SoundBufferTime {+      bufferTime = 500000, -- 0.5s+      periodTime = 100000  -- 0.1s+   } +bufferTimeParams ::+   SoundFmt y ->+   SoundBufferTime ->+   (HwParam.T PCM.Interleaved y (Size,Size),+    (Size,Size) -> SwParam.T PCM.Interleaved y ())+bufferTimeParams fmt time =+   (HwParam.setRateBufferTime+       (sampleFreq fmt)+       (bufferTime time)+       (periodTime time),+    uncurry SwParam.setBufferSize)+ alsaSoundSource ::-   SampleFmt y =>-   String -> SoundFmt y -> SoundSource y Pcm+   Class.SampleFmt y =>+   String -> SoundFmt y -> SoundSource Pcm y alsaSoundSource dev fmt =    alsaSoundSourceTime dev fmt defaultBufferTime  alsaSoundSink ::-   SampleFmt y =>-   String -> SoundFmt y -> SoundSink y Pcm+   Class.SampleFmt y =>+   String -> SoundFmt y -> SoundSink Pcm y alsaSoundSink dev fmt =    alsaSoundSinkTime dev fmt defaultBufferTime  alsaSoundSourceTime ::-   SampleFmt y =>-   String -> SoundFmt y -> SoundBufferTime -> SoundSource y Pcm+   Class.SampleFmt y =>+   String -> SoundFmt y -> SoundBufferTime -> SoundSource Pcm y alsaSoundSourceTime dev fmt time =-    (nullSoundSource fmt) {-        soundSourceOpen  = alsaOpen dev fmt time PCM.StreamCapture,-        soundSourceClose = alsaClose,-        soundSourceStart = alsaStart,-        soundSourceStop  = alsaStop,-        soundSourceRead  = alsaRead-    }+   uncurry (alsaSoundSourceParams dev) $+   bufferTimeParams fmt time  alsaSoundSinkTime ::-   SampleFmt y =>-   String -> SoundFmt y -> SoundBufferTime -> SoundSink y Pcm+   Class.SampleFmt y =>+   String -> SoundFmt y -> SoundBufferTime -> SoundSink Pcm y alsaSoundSinkTime dev fmt time =-    (nullSoundSink fmt) {-        soundSinkOpen  = alsaOpen dev fmt time PCM.StreamPlayback,-        soundSinkClose = alsaClose,-        soundSinkStart = alsaStart,-        soundSinkStop  = alsaStop,-        soundSinkWrite = alsaWrite-    }+   uncurry (alsaSoundSinkParams dev) $+   bufferTimeParams fmt time +alsaSoundSourceParams ::+   Class.SampleFmt y =>+   String ->+   HwParam.T PCM.Interleaved y a ->+   (a -> SwParam.T PCM.Interleaved y ()) ->+   SoundSource Pcm y+alsaSoundSourceParams dev hwParams swParams =+   SoundSource {+      soundSourceOpen  = alsaOpen PCM.StreamCapture hwParams swParams dev,+      soundSourceClose = alsaClose,+      soundSourceStart = alsaStart,+      soundSourceStop  = alsaStop,+      soundSourceRead  = alsaRead+   }++alsaSoundSinkParams ::+   Class.SampleFmt y =>+   String ->+   HwParam.T PCM.Interleaved y a ->+   (a -> SwParam.T PCM.Interleaved y ()) ->+   SoundSink Pcm y+alsaSoundSinkParams dev hwParams swParams =+   SoundSink {+      soundSinkOpen  = alsaOpen PCM.StreamPlayback hwParams swParams dev,+      soundSinkClose = alsaClose,+      soundSinkStart = alsaStart,+      soundSinkStop  = alsaStop,+      soundSinkWrite = \h buf n -> alsaWrite h buf n >> return ()+   }+ -- -- * File stuff -- -{- |-This expects pad bytes that are needed in memory-in order to satisfy aligment constraints.-This is only a problem for samples sizes like 24 bit.--}-fileRead ::-   SampleFmt y =>-   Handle -> Ptr y -> Int -> IO Int-fileRead h buf n =-   liftM (`div` arraySize buf 1) $-   IO.hGetBuf h buf (arraySize buf n)--{- |-Same restrictions as for 'fileRead'.--}-fileWrite ::-   SampleFmt y =>-   Handle -> Ptr y -> Int -> IO ()-fileWrite h buf n =-   IO.hPutBuf h buf (arraySize buf n)- fileSoundSource ::-   SampleFmt y =>-   FilePath -> SoundFmt y -> SoundSource y Handle-fileSoundSource file fmt =-    (nullSoundSource fmt) {-                           soundSourceOpen  = openBinaryFile file ReadMode,-                           soundSourceClose = hClose,-                           soundSourceRead  = fileRead-                          }+   Class.SampleFmt y =>+   FilePath -> SoundSource File y+fileSoundSource file =+   SoundSource {+      soundSourceOpen  = File.open IO.ReadMode file,+      soundSourceClose = File.close,+      soundSourceRead  = File.read,+      soundSourceStart = const $ return (),+      soundSourceStop  = const $ return ()+   }  fileSoundSink ::-   SampleFmt y =>-   FilePath -> SoundFmt y -> SoundSink y Handle-fileSoundSink file fmt =-    (nullSoundSink fmt) {-                         soundSinkOpen  = openBinaryFile file WriteMode,-                         soundSinkClose = hClose,-                         soundSinkWrite = fileWrite-                        }+   Class.SampleFmt y =>+   FilePath -> SoundSink File y+fileSoundSink file =+   SoundSink {+      soundSinkOpen  = File.open IO.WriteMode file,+      soundSinkClose = File.close,+      soundSinkWrite = File.write,+      soundSinkStart = const $ return (),+      soundSinkStop  = const $ return ()+   }  -- -- * Marshalling utilities -- -callocaArray :: Storable y => SoundFmt y -> Int -> (Ptr y -> IO b) -> IO b-callocaArray _ n f =-   allocaArray n $ \p ->-      clearBytes p (arraySize p n) >>-      f p+callocaArray :: Storable y => Size -> (Ptr y -> IO b) -> IO b+callocaArray n0 f =+   case fromIntegral n0 of+      n ->+         allocaArray n $ \p ->+            clearBytes p (arraySize p n) >>+            f p  clearBytes :: Ptr a -> Int -> IO () clearBytes p n = memset p 0 (fromIntegral n) >> return () -{-# INLINE arraySize #-}-arraySize :: Storable y => Ptr y -> Int -> Int-arraySize p n = advancePtr p n `minusPtr` p--foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO (Ptr a)+foreign import ccall unsafe "string.h" memset :: Ptr a -> C.CInt -> C.CSize -> IO (Ptr a)

@@ -1,237 +0,0 @@---  C->Haskell Compiler: Marshalling library------  Copyright (c) [1999...2005] Manuel M T Chakravarty------  Redistribution and use in source and binary forms, with or without---  modification, are permitted provided that the following conditions are met:------  1. Redistributions of source code must retain the above copyright notice,---     this list of conditions and the following disclaimer.---  2. Redistributions in binary form must reproduce the above copyright---     notice, this list of conditions and the following disclaimer in the---     documentation and/or other materials provided with the distribution.---  3. The name of the author may not be used to endorse or promote products---     derived from this software without specific prior written permission.------  THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR---  IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES---  OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN---  NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,---  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED---  TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR---  PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF---  LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING---  NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS---  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.------- Description ---------------------------------------------------------------------  Language: Haskell 98------  This module provides the marshaling routines for Haskell files produced by---  C->Haskell for binding to C library interfaces.  It exports all of the---  low-level FFI (language-independent plus the C-specific parts) together---  with the C->HS-specific higher-level marshalling routines.-----module Sound.ALSA.PCM.C2HS (--  -- * Re-export the language-independent component of the FFI-  St.Storable, St.poke, St.peek, St.sizeOf, St.alignment,-  Ptr, castPtr, with,-  Alloc.alloca,--  -- * Re-export the C language component of the FFI-  C.CInt, C.CUInt, C.CLong, C.CULong, C.CChar, C.withCString,--  -- * Composite marshalling functions-  withCStringLenIntConv, peekCStringLenIntConv, withIntConv, withFloatConv,-  peekIntConv, peekFloatConv, withBool, peekBool, withEnum, peekEnum,--  -- * Conditional results using 'Maybe'-  nothingIf, nothingIfNull,--  -- * Bit masks-  combineBitMasks, containsBitMask, extractBitMasks,--  -- * Conversion between C and Haskell types-  cIntConv, cFloatConv, cToBool, cFromBool, cToEnum, cFromEnum-) where---import Foreign.Ptr (Ptr, nullPtr, castPtr, )-import Foreign.Storable (Storable, peek, )-import Foreign.Marshal.Utils (fromBool, toBool, with, )--import qualified Foreign.Storable as St-import qualified Foreign.Marshal.Alloc as Alloc-import qualified Foreign.C as C--import Data.Bits (Bits, (.|.), (.&.), )--import Control.Monad (liftM, )----- Composite marshalling functions--- ----------------------------------- Strings with explicit length----withCStringLenIntConv ::-   (Integral i) =>-   String -> ((Ptr C.CChar, i) -> IO a) -> IO a-withCStringLenIntConv s f =-   C.withCStringLen s $ \(p, n) -> f (p, cIntConv n)--peekCStringLenIntConv ::-   (Integral i) =>-   (Ptr C.CChar, i) -> IO String-peekCStringLenIntConv (s, n) =-   C.peekCStringLen (s, cIntConv n)----- Marshalling of numerals-----withIntConv   :: (Storable b, Integral a, Integral b)-              => a -> (Ptr b -> IO c) -> IO c-withIntConv    = with . cIntConv--withFloatConv :: (Storable b, RealFloat a, RealFloat b)-              => a -> (Ptr b -> IO c) -> IO c-withFloatConv  = with . cFloatConv--peekIntConv   :: (Storable a, Integral a, Integral b)-              => Ptr a -> IO b-peekIntConv    = liftM cIntConv . peek--peekFloatConv :: (Storable a, RealFloat a, RealFloat b)-              => Ptr a -> IO b-peekFloatConv  = liftM cFloatConv . peek---- Passing Booleans by reference-----withBool :: (Integral a, Storable a) => Bool -> (Ptr a -> IO b) -> IO b-withBool  = with . fromBool--peekBool :: (Integral a, Storable a) => Ptr a -> IO Bool-peekBool  = liftM toBool . peek----- Passing enums by reference-----withEnum :: (Enum a, Integral b, Storable b) => a -> (Ptr b -> IO c) -> IO c-withEnum  = with . cFromEnum--peekEnum :: (Enum a, Integral b, Storable b) => Ptr b -> IO a-peekEnum  = liftM cToEnum . peek----- Storing of 'Maybe' values--- ---------------------------{--instance Storable a => Storable (Maybe a) where-  sizeOf    _ = sizeOf    (undefined :: Ptr ())-  alignment _ = alignment (undefined :: Ptr ())--  peek p = do-             ptr <- peek (castPtr p)-             if ptr == nullPtr-               then return Nothing-               else liftM Just $ peek ptr--  poke p v = do-               ptr <- case v of-                        Nothing -> return nullPtr-                        Just v' -> new v'-               poke (castPtr p) ptr--}---- Conditional results using 'Maybe'--- ------------------------------------- Wrap the result into a 'Maybe' type.------ * the predicate determines when the result is considered to be non-existing,---   ie, it is represented by `Nothing'------ * the second argument allows to map a result wrapped into `Just' to some---   other domain----nothingIf       :: (a -> Bool) -> (a -> b) -> a -> Maybe b-nothingIf p f x  = if p x then Nothing else Just $ f x---- |Instance for special casing null pointers.----nothingIfNull :: (Ptr a -> b) -> Ptr a -> Maybe b-nothingIfNull  = nothingIf (== nullPtr)----- Support for bit masks--- ------------------------- Given a list of enumeration values that represent bit masks, combine these--- masks using bitwise disjunction.----combineBitMasks :: (Enum a, Bits b) => [a] -> b-combineBitMasks = foldl (.|.) 0 . map (fromIntegral . fromEnum)---- Tests whether the given bit mask is contained in the given bit pattern--- (i.e., all bits set in the mask are also set in the pattern).----containsBitMask :: (Bits a, Enum b) => a -> b -> Bool-bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm-                            in-                            bm' .&. bits == bm'---- |Given a bit pattern, yield all bit masks that it contains.------ * This does *not* attempt to compute a minimal set of bit masks that when---   combined yield the bit pattern, instead all contained bit masks are---   produced.----extractBitMasks :: (Bits a, Enum b, Bounded b) => a -> [b]-extractBitMasks bits =-  [bm | bm <- [minBound..maxBound], bits `containsBitMask` bm]----- Conversion routines--- ----------------------- |Integral conversion----cIntConv :: (Integral a, Integral b) => a -> b-cIntConv  = fromIntegral---- |Floating conversion----cFloatConv :: (RealFloat a, RealFloat b) => a -> b-cFloatConv  = realToFrac--- As this conversion by default goes via `Rational', it can be very slow...-{-# RULES-  "cFloatConv/Float->Float"   forall (x::Float).  cFloatConv x = x;-  "cFloatConv/Double->Double" forall (x::Double). cFloatConv x = x- #-}---- |Obtain C value from Haskell 'Bool'.----cFromBool :: Num a => Bool -> a-cFromBool  = fromBool---- |Obtain Haskell 'Bool' from C value.----cToBool :: Num a => a -> Bool-cToBool  = toBool---- |Convert a C enumeration to Haskell.----cToEnum :: (Integral i, Enum e) => i -> e-cToEnum  = toEnum . cIntConv---- |Convert a Haskell enumeration to C.----cFromEnum :: (Enum e, Integral i) => e -> i-cFromEnum  = cIntConv . fromEnum

@@ -1,316 +0,0 @@-{-# LANGUAGE ForeignFunctionInterface #-}-module Sound.ALSA.PCM.Core where--import Sound.ALSA.PCM.C2HS (cIntConv, peekIntConv, withIntConv, cFromEnum, )-import Sound.ALSA.Exception (checkResult, checkResult_, )--import Foreign.C.Types (CUInt, CULong, CInt, CLong, CChar, )-import Foreign.C.String (withCString, )-import Foreign.Ptr (Ptr, castPtr, )-import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )-import Foreign.Marshal.Utils (with, )-import Foreign.Marshal.Alloc (alloca, )------ HACK for 32-bit machines.--- This is only used to be able to parse alsa/pcm.h,--- since snd_pcm_format_silence_64 use u_int64_t which is not--- defined on 32-bit machines, AFAICT-#if __WORDSIZE == 32-typedef unsigned long long int u_int64_t;-#endif--#include <alsa/asoundlib.h>--{#context prefix = "snd_pcm_"#}--{#pointer *snd_pcm_t as Pcm newtype #}--instance Storable Pcm where-    sizeOf (Pcm r) = sizeOf r-    alignment (Pcm r) = alignment r-    peek p = fmap Pcm (peek (castPtr p))-    poke p (Pcm r) = poke (castPtr p) r--{#pointer *snd_pcm_hw_params_t as HwParams newtype #}--instance Storable HwParams where-    sizeOf (HwParams r) = sizeOf r-    alignment (HwParams r) = alignment r-    peek p = fmap HwParams (peek (castPtr p))-    poke p (HwParams r) = poke (castPtr p) r--{#pointer *snd_pcm_sw_params_t as SwParams newtype #}--instance Storable SwParams where-    sizeOf (SwParams r) = sizeOf r-    alignment (SwParams r) = alignment r-    peek p = fmap SwParams (peek (castPtr p))-    poke p (SwParams r) = poke (castPtr p) r--{#enum _snd_pcm_stream as Stream {underscoreToCase} deriving (Eq,Show)#}--{#enum _snd_pcm_access as Access {underscoreToCase} deriving (Eq,Show)#}--{#enum _snd_pcm_format as Format {underscoreToCase} deriving (Eq,Show)#}--{#fun snd_pcm_open as open-  { alloca- `Pcm' peek*,-    withCString* `String',-    cFromEnum `Stream',-    `Int'}- -> `()' result*- #}-  where result = checkResult_ "PCM.open"--{#fun snd_pcm_close as close-  { id `Pcm' }- -> `()' result*- #}-  where result = checkResult_ "PCM.close"--{#fun prepare-  { id `Pcm' }- -> `()' result*- #}-  where result = checkResult_ "PCM.prepare"--{#fun start-  { id `Pcm' }- -> `()' result*- #}-  where result = checkResult_ "PCM.start"--{#fun drop-  { id `Pcm' }- -> `()' result*- #}-  where result = checkResult_ "PCM.drop"--{#fun drain-  { id `Pcm' }- -> `()' result*- #}-  where result = checkResult_ "PCM.drain"--{---- Only available in 1.0.11rc3 and later-{#fun set_params-  { id `Pcm',-    cFromEnum `PcmFormat',-    cFromEnum `PcmAccess',-    `Int',-    `Int',-    `Bool',-    `Int' }- -> `()' result*- #}-  where result = checkResult_ "PCM.set_params"--}--{#fun hw_params-  { id `Pcm',-    id `HwParams' }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params"--{#fun hw_params_any-  { id `Pcm',-    id `HwParams' }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_any"--{#fun hw_params_set_access-  { id `Pcm',-    id `HwParams',-    cFromEnum `Access'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_access"--{#fun hw_params_set_format-  { id `Pcm',-    id `HwParams',-    cFromEnum `Format'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_format"--{#fun hw_params_set_rate-  { id `Pcm',-    id `HwParams',-    `Int',-    orderingToInt `Ordering'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_rate"--{---- Available in 1.0.9rc2 and later-{#fun hw_params_set_rate_resample-  { id `Pcm',-    id `HwParams',-    `Bool'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_rate_resample"--}--{#fun hw_params_set_channels-  { id `Pcm',-    id `HwParams',-    `Int'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_channels"--{#fun hw_params_set_buffer_size-  { id `Pcm',-    id `HwParams',-    `Int'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_buffer_size"--{#fun hw_params_get_buffer_size-  { id `HwParams',-    alloca- `Int' peekIntConv*- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_get_buffer_size"--{#fun hw_params_get_period_size-  { id `HwParams',-    alloca- `Int' peekIntConv*,-    alloca- `Ordering' peekOrdering*- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_get_period_size"--{#fun hw_params_set_period_time_near-  { id `Pcm',-    id `HwParams',-    withIntConv* `Int' peekIntConv*,-    withOrdering* `Ordering' peekOrdering*- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_period_time_near"--{#fun hw_params_set_periods-  { id `Pcm',-    id `HwParams',-    `Int',-    orderingToInt `Ordering'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_periods"--{#fun hw_params_set_buffer_time_near-  { id `Pcm',-    id `HwParams',-    withIntConv* `Int' peekIntConv*,-    withOrdering* `Ordering' peekOrdering*- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_set_buffer_time_near"--{#fun hw_params_get_buffer_time-  { id `HwParams',-    alloca- `Int' peekIntConv*,-    alloca- `Ordering' peekOrdering*- }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_get_buffer_time"--{#fun sw_params_set_start_threshold-  { id `Pcm',-    id `SwParams',-    `Int'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_set_start_threshold"--{#fun sw_params_set_avail_min-  { id `Pcm',-    id `SwParams',-    `Int'- }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_set_avail_min"--{#fun sw_params_set_xfer_align-  { id `Pcm',-    id `SwParams',-    `Int' }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_set_xfer_align"--{#fun sw_params_set_silence_threshold-  { id `Pcm',-    id `SwParams',-    `Int' }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_set_silence_threshold"--{#fun sw_params_set_silence_size-  { id `Pcm',-    id `SwParams',-    `Int' }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_set_silence_size"--{#fun readi-  { id `Pcm',-    castPtr `Ptr a',-    `Int'- }- -> `Int' result* #}-  where result = fmap fromIntegral . checkResult "PCM.readi"--{#fun writei-  { id `Pcm',-    castPtr `Ptr a',-    `Int'- }- -> `Int' result* #}-  where result = fmap fromIntegral . checkResult "PCM.writei"--{#fun hw_params_malloc-  { alloca- `HwParams' peek* }- -> `()' result*- #}-  where result = checkResult_ "PCM.hw_params_malloc"--{#fun hw_params_free-  { id `HwParams' }- -> `()' #}--{#fun sw_params_malloc-  { alloca- `SwParams' peek* }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_malloc"--{#fun sw_params_free-  { id `SwParams' }- -> `()' #}--{#fun sw_params-  { id `Pcm',-    id `SwParams' }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params"--{#fun sw_params_current-  { id `Pcm',-    id `SwParams' }- -> `()' result*- #}-  where result = checkResult_ "PCM.sw_params_current"------- * Marshalling utilities-----orderingToInt :: Ordering -> CInt-orderingToInt o = fromIntegral (fromEnum o - 1)--intToOrdering :: CInt -> Ordering-intToOrdering i = compare i 0--peekOrdering :: Ptr CInt -> IO Ordering-peekOrdering = fmap intToOrdering . peek--withOrdering :: Ordering -> (Ptr CInt -> IO a) -> IO a-withOrdering o = with (orderingToInt o)

@@ -0,0 +1,107 @@+module Sound.ALSA.PCM.Core.Class where++import qualified Sound.ALSA.PCM.Core.Handle as Core+import qualified Sound.ALSA.PCM.Core.HwParams as HwParams+import qualified Sound.ALSA.PCM.Core.SwParams as SwParams++import qualified Sound.Frame as Frame+import qualified Sound.Frame.Stereo as Stereo+import qualified Sound.Frame.MuLaw  as MuLaw++import Data.Word (Word8, Word16, Word32, )+import Data.Int (Int8, Int16, Int32, )++import Foreign (Storable, )+++class Access i where+   access :: HwParams.T i y HwParams.Access+   setChannels :: (Frame.C y) => HwParams.T i y ()++instance Access Core.Interleaved where+   access = return HwParams.accessRwInterleaved+   setChannels =+      HwParams.setChannels . fromIntegral =<<+         withSampleFmt Frame.numberOfChannels++instance Access Core.Noninterleaved where+   access = return HwParams.accessRwNoninterleaved+   setChannels = return ()++++{-+We should have support for 24bit samples+that are packed on disk but padded to 32bit in memory.+-}+class (Storable y, Frame.C y) => SampleFmt y where+   sampleFmtToPcmFormat :: y -> HwParams.Format++instance SampleFmt Word8 where+   sampleFmtToPcmFormat _ = HwParams.formatU8++instance SampleFmt Int8 where+   sampleFmtToPcmFormat _ = HwParams.formatS8++instance SampleFmt Word16 where+   sampleFmtToPcmFormat _ = HwParams.formatU16++instance SampleFmt Int16 where+   sampleFmtToPcmFormat _ = HwParams.formatS16++instance SampleFmt Word32 where+   sampleFmtToPcmFormat _ = HwParams.formatU32++instance SampleFmt Int32 where+   sampleFmtToPcmFormat _ = HwParams.formatS32++instance SampleFmt Float where+   sampleFmtToPcmFormat _ = HwParams.formatFloat++instance SampleFmt Double where+   sampleFmtToPcmFormat _ = HwParams.formatFloat64++instance SampleFmt MuLaw.T where+   sampleFmtToPcmFormat _ = HwParams.formatMuLaw++instance SampleFmt a => SampleFmt (Stereo.T a) where+   sampleFmtToPcmFormat y =+      sampleFmtToPcmFormat (Stereo.left y)+++{- |+Sample types of this class must have exactly one channel,+i.e. Frame.numberOfChannels == 1.+-}+class (SampleFmt y) => MonoSampleFmt y where++instance MonoSampleFmt Word8 where+instance MonoSampleFmt Int8 where+instance MonoSampleFmt Word16 where+instance MonoSampleFmt Int16 where+instance MonoSampleFmt Word32 where+instance MonoSampleFmt Int32 where+instance MonoSampleFmt Float where+instance MonoSampleFmt Double where+instance MonoSampleFmt MuLaw.T where+++withSampleFmt :: (y -> a) -> HwParams.T i y a+withSampleFmt f = return $ f undefined+++withHwParams ::+   (Access i, SampleFmt y) =>+   Core.Handle i y -> HwParams.T i y a -> IO a+withHwParams h f =+   HwParams.withIO h $ (\(HwParams.Cons act) -> act h) $ do+      HwParams.setAccess =<< access+      HwParams.setFormat =<< withSampleFmt sampleFmtToPcmFormat+      setChannels+      f++withSwParams ::+   (Access i, SampleFmt y) =>+   Core.Handle i y -> SwParams.T i y a -> IO a+withSwParams h (SwParams.Cons f) =+   SwParams.withIO h $ f h

@@ -0,0 +1,34 @@+module Sound.ALSA.PCM.Core.Convert where++import qualified Foreign.Marshal.Utils as U+import qualified Foreign.Storable as St+import Foreign.Ptr (Ptr, )++import qualified Prelude as P+import Prelude hiding (id, )+++data T h c =+        Cons {fromHaskell :: h -> c, toHaskell :: c -> h}++with ::+   (St.Storable c) =>+   T h c -> h -> (Ptr c -> IO a) -> IO a+with conv a = U.with (fromHaskell conv a)++peek ::+   (St.Storable a) =>+   T h a -> Ptr a -> IO h+peek conv aptr = fmap (toHaskell conv) $ St.peek aptr+++id :: T a a+id = Cons P.id P.id++int :: (Integral a, Integral b) => T a b+int = Cons fromIntegral fromIntegral++{-+word :: T Word C.CUInt+word = Cons fromIntegral fromIntegral+-}

@@ -0,0 +1,157 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Sound.ALSA.PCM.Core.Handle where++import Sound.ALSA.Exception (checkResult, checkResult_, )++import qualified Foreign.Storable.Newtype as Store++import qualified Foreign.C.Types as C+import Foreign.C.String (CString, withCString, )+import Foreign.Ptr (Ptr, minusPtr, )+import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )+import Foreign.Marshal.Array (advancePtr, )+import Foreign.Marshal.Alloc (alloca, )++import Data.Bits ((.|.), )+import Data.Monoid (Monoid, mempty, mappend, mconcat, )++import Prelude hiding (any, )+++#include <alsa/asoundlib.h>+++data Struct i y = Struct++newtype Handle i y = Handle {dePcm :: Ptr (Struct i y)}++data Interleaved = Interleaved+data Noninterleaved = Noninterleaved+++instance Storable (Handle i y) where+   sizeOf = Store.sizeOf dePcm+   alignment = Store.alignment dePcm+   peek = Store.peek Handle+   poke = Store.poke dePcm+++type SampleFreq = Int+type Time = Int+type Size = Int+++data Stream =+     StreamPlayback+   | StreamCapture+   deriving (Eq,Show,Bounded)++instance Enum Stream where+   fromEnum StreamPlayback = #{const SND_PCM_STREAM_PLAYBACK}+   fromEnum StreamCapture  = #{const SND_PCM_STREAM_CAPTURE}++   toEnum #{const SND_PCM_STREAM_PLAYBACK} = StreamPlayback+   toEnum #{const SND_PCM_STREAM_CAPTURE}  = StreamCapture+   toEnum unmatched = error ("Stream.toEnum: Cannot match " ++ show unmatched)+++newtype Mode = Mode C.CInt++#{enum Mode, Mode,+   nonBlock = SND_PCM_NONBLOCK,+   async = SND_PCM_ASYNC }++instance Monoid Mode where+   mempty = Mode 0+   mappend (Mode a) (Mode b) = Mode (a .|. b)++modes :: [Mode] -> Mode+modes = mconcat+++foreign import ccall safe "alsa/pcm.h snd_pcm_open"+   open_ :: Ptr (Handle i y) -> CString -> C.CInt -> Mode -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_close"+   close_ :: Handle i y -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_prepare"+   prepare_ :: Handle i y -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_start"+   start_ :: Handle i y -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_drop"+   drop_ :: Handle i y -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_drain"+   drain_ :: Handle i y -> IO C.CInt+++open :: String -> Stream -> Mode -> IO (Handle i y)+open device dir mode =+   alloca $ \ptr ->+   withCString device $ \deviceCStr ->+   open_ ptr deviceCStr (fromIntegral $ fromEnum dir) mode >>=+   checkResult_ "PCM.open" >>+   peek ptr++close :: Handle i y -> IO ()+close h =+   close_ h >>= checkResult_ "PCM.close"++prepare :: Handle i y -> IO ()+prepare h =+   prepare_ h >>= checkResult_ "PCM.prepare"++start :: Handle i y -> IO ()+start h =+   start_ h >>= checkResult_ "PCM.start"++drop :: Handle i y -> IO ()+drop h =+   drop_ h >>= checkResult_ "PCM.drop"++drain :: Handle i y -> IO ()+drain h =+   drain_ h >>= checkResult_ "PCM.drain"++++foreign import ccall safe "alsa/pcm.h snd_pcm_readi"+   readi_ :: Handle Interleaved y -> Ptr y -> C.CULong -> IO C.CLong++foreign import ccall safe "alsa/pcm.h snd_pcm_writei"+   writei_ :: Handle Interleaved y -> Ptr y -> C.CULong -> IO C.CLong++foreign import ccall safe "alsa/pcm.h snd_pcm_readn"+   readn_ :: Handle Noninterleaved y -> Ptr (Ptr y) -> C.CULong -> IO C.CLong++foreign import ccall safe "alsa/pcm.h snd_pcm_writen"+   writen_ :: Handle Noninterleaved y -> Ptr (Ptr y) -> C.CULong -> IO C.CLong+++readi :: Handle Interleaved y -> Ptr y -> Size -> IO Size+readi h buf n =+   fmap fromIntegral $+   checkResult "PCM.readi" =<< readi_ h buf (fromIntegral n)++writei :: Handle Interleaved y -> Ptr y -> Size -> IO Size+writei h buf n =+   fmap fromIntegral $+   checkResult "PCM.writei" =<< writei_ h buf (fromIntegral n)++readn :: Handle Noninterleaved y -> Ptr (Ptr y) -> Size -> IO Size+readn h buf n =+   fmap fromIntegral $+   checkResult "PCM.readn" =<< readn_ h buf (fromIntegral n)++writen :: Handle Noninterleaved y -> Ptr (Ptr y) -> Size -> IO Size+writen h buf n =+   fmap fromIntegral $+   checkResult "PCM.writen" =<< writen_ h buf (fromIntegral n)+++{-# INLINE arraySize #-}+arraySize :: Storable y => Ptr y -> Int -> Int+arraySize p n = advancePtr p n `minusPtr` p

@@ -0,0 +1,382 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Sound.ALSA.PCM.Core.HwParams where++import Sound.ALSA.PCM.Core.Handle (Handle, Time, Size, SampleFreq, )+import qualified Sound.ALSA.PCM.Core.Handle as H -- expose Handle constructor to FFI+import qualified Sound.ALSA.PCM.Core.Convert as Conv+import Sound.ALSA.PCM.Core.Convert (fromHaskell, )++import Sound.ALSA.Exception (checkResult, checkResult_, )++import Control.Applicative (Applicative(pure, (<*>)))++import Control.Exception (bracket, )++import qualified Foreign.Storable.Newtype as Store++import qualified Foreign.C.Types as C+import qualified Foreign.C.Error as E+import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )+import Foreign.Marshal.Alloc (alloca, )++import Data.Word (Word, )++import Prelude hiding (any, )++#include <alsa/asoundlib.h>+#include <Sound/ALSA/PCM/Core/Params.h>++++newtype T i y a = Cons (H.Handle i y -> Ptr Params -> IO a)++data Params = Params+++{-+T is a Reader monad.+-}+instance Functor (T i y) where+   fmap f (Cons act) = Cons $ \h p -> fmap f $ act h p++instance Applicative (T i y) where+   pure a = Cons $ \ _h _p -> pure a+   Cons f <*> Cons x = Cons $ \h p -> f h p <*> x h p++instance Monad (T i y) where+   return a = Cons $ \ _h _p -> return a+   Cons x >>= k =+      Cons $ \h p -> x h p >>= \a -> case k a of Cons y -> y h p++++withIO :: Handle i y -> (Ptr Params -> IO a) -> IO a+withIO h f =+   bracket malloc free $ \p -> do+      any h p+      x <- f p+      set h p+      return x+--    bracket_ (any h p) (set h p) (f p)+++foreign import ccall safe "alsa/pcm.h snd_pcm_hw_params_malloc"+   malloc_ :: Ptr (Ptr Params) -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_hw_params_free"+   free :: Ptr Params -> IO ()++malloc :: IO (Ptr Params)+malloc =+   alloca $ \pp ->+   malloc_ pp >>=+   checkResult_ "HwParams.malloc" >>+   peek pp++++foreign import ccall safe "alsa/pcm.h snd_pcm_hw_params"+   set_ :: Handle i y -> Ptr Params -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_hw_params_any"+   any_ :: Handle i y -> Ptr Params -> IO C.CInt++set :: Handle i y -> Ptr Params -> IO ()+set h p =+   set_ h p >>= checkResult_ "HwParams.set"++any :: Handle i y -> Ptr Params -> IO ()+any h p =+   any_ h p >>= checkResult_ "HwParams.any"++-- #accessor checked, "any", pcm_params, NULL+++newtype Bool_ = Bool_ {fromBool_ :: C.CInt}+   deriving (Eq, Ord)++instance Storable Bool_ where+   sizeOf = Store.sizeOf fromBool_+   alignment = Store.alignment fromBool_+   peek = Store.peek Bool_+   poke = Store.poke fromBool_++boolConv :: Conv.T Bool Bool_+boolConv =+   Conv.Cons+      (\b -> Bool_ $ fromIntegral $ fromEnum b)+      (Bool_ 0 /=)+++newtype Direction = Direction {fromDirection :: C.CInt}+   deriving (Eq, Ord)++instance Storable Direction where+   sizeOf = Store.sizeOf fromDirection+   alignment = Store.alignment fromDirection+   peek = Store.peek Direction+   poke = Store.poke fromDirection++ordConv :: Conv.T Ordering Direction+ordConv =+   Conv.Cons+      (\o -> Direction $ fromIntegral $ fromEnum o - 1)+      (\d -> compare d $ Direction 0)+++newtype Access = Access {fromAccess :: C.CInt}+   deriving (Eq, Ord)++instance Enum Access where+   toEnum n = Access $ fromIntegral n+   fromEnum (Access n) = fromIntegral n++instance Bounded Access where+   minBound = Access #{const SND_PCM_ACCESS_MMAP_INTERLEAVED}+   maxBound = Access #{const SND_PCM_ACCESS_LAST}++instance Storable Access where+   sizeOf = Store.sizeOf fromAccess+   alignment = Store.alignment fromAccess+   peek = Store.peek Access+   poke = Store.poke fromAccess++#{enum Access, Access,+   accessMmapInterleaved    = SND_PCM_ACCESS_MMAP_INTERLEAVED,+   accessMmapNoninterleaved = SND_PCM_ACCESS_MMAP_NONINTERLEAVED,+   accessMmapComplex        = SND_PCM_ACCESS_MMAP_COMPLEX,+   accessRwInterleaved      = SND_PCM_ACCESS_RW_INTERLEAVED,+   accessRwNoninterleaved   = SND_PCM_ACCESS_RW_NONINTERLEAVED }++++newtype Format = Format {fromFormat :: C.CInt}+   deriving (Eq, Ord)++instance Enum Format where+   toEnum n = Format $ fromIntegral n+   fromEnum (Format n) = fromIntegral n++instance Bounded Format where+   minBound = formatUnknown+   maxBound = Format #{const SND_PCM_FORMAT_LAST}++instance Storable Format where+   sizeOf = Store.sizeOf fromFormat+   alignment = Store.alignment fromFormat+   peek = Store.peek Format+   poke = Store.poke fromFormat++#{enum Format, Format,+   formatUnknown          = SND_PCM_FORMAT_UNKNOWN,+   formatS8               = SND_PCM_FORMAT_S8,+   formatU8               = SND_PCM_FORMAT_U8,+   formatS16Le            = SND_PCM_FORMAT_S16_LE,+   formatS16Be            = SND_PCM_FORMAT_S16_BE,+   formatU16Le            = SND_PCM_FORMAT_U16_LE,+   formatU16Be            = SND_PCM_FORMAT_U16_BE,+   formatS24Le            = SND_PCM_FORMAT_S24_LE,+   formatS24Be            = SND_PCM_FORMAT_S24_BE,+   formatU24Le            = SND_PCM_FORMAT_U24_LE,+   formatU24Be            = SND_PCM_FORMAT_U24_BE,+   formatS32Le            = SND_PCM_FORMAT_S32_LE,+   formatS32Be            = SND_PCM_FORMAT_S32_BE,+   formatU32Le            = SND_PCM_FORMAT_U32_LE,+   formatU32Be            = SND_PCM_FORMAT_U32_BE,+   formatFloatLe          = SND_PCM_FORMAT_FLOAT_LE,+   formatFloatBe          = SND_PCM_FORMAT_FLOAT_BE,+   formatFloat64Le        = SND_PCM_FORMAT_FLOAT64_LE,+   formatFloat64Be        = SND_PCM_FORMAT_FLOAT64_BE,+   formatIec958SubframeLe = SND_PCM_FORMAT_IEC958_SUBFRAME_LE,+   formatIec958SubframeBe = SND_PCM_FORMAT_IEC958_SUBFRAME_BE,+   formatMuLaw            = SND_PCM_FORMAT_MU_LAW,+   formatALaw             = SND_PCM_FORMAT_A_LAW,+   formatImaAdpcm         = SND_PCM_FORMAT_IMA_ADPCM,+   formatMpeg             = SND_PCM_FORMAT_MPEG,+   formatGsm              = SND_PCM_FORMAT_GSM,+   formatSpecial          = SND_PCM_FORMAT_SPECIAL,+   formatS243le           = SND_PCM_FORMAT_S24_3LE,+   formatS243be           = SND_PCM_FORMAT_S24_3BE,+   formatU243le           = SND_PCM_FORMAT_U24_3LE,+   formatU243be           = SND_PCM_FORMAT_U24_3BE,+   formatS203le           = SND_PCM_FORMAT_S20_3LE,+   formatS203be           = SND_PCM_FORMAT_S20_3BE,+   formatU203le           = SND_PCM_FORMAT_U20_3LE,+   formatU203be           = SND_PCM_FORMAT_U20_3BE,+   formatS183le           = SND_PCM_FORMAT_S18_3LE,+   formatS183be           = SND_PCM_FORMAT_S18_3BE,+   formatU183le           = SND_PCM_FORMAT_U18_3LE,+   formatU183be           = SND_PCM_FORMAT_U18_3BE,+   formatS16              = SND_PCM_FORMAT_S16,+   formatU16              = SND_PCM_FORMAT_U16,+   formatS24              = SND_PCM_FORMAT_S24,+   formatU24              = SND_PCM_FORMAT_U24,+   formatS32              = SND_PCM_FORMAT_S32,+   formatU32              = SND_PCM_FORMAT_U32,+   formatFloat            = SND_PCM_FORMAT_FLOAT,+   formatFloat64          = SND_PCM_FORMAT_FLOAT64,+   formatIec958Subframe   = SND_PCM_FORMAT_IEC958_SUBFRAME }+++newtype Subformat = Subformat {fromSubformat :: C.CUInt}+   deriving (Eq, Ord)++instance Storable Subformat where+   sizeOf = Store.sizeOf fromSubformat+   alignment = Store.alignment fromSubformat+   peek = Store.peek Subformat+   poke = Store.poke fromSubformat++++#accessor boolresult, "can_mmap_sample_resolution", params_only, NULL+#accessor boolresult, "is_double", params_only, NULL+#accessor boolresult, "is_batch", params_only, NULL+#accessor boolresult, "is_block_transfer", params_only, NULL+#accessor boolresult, "can_overrange", params_only, NULL+#accessor boolresult, "can_pause", params_only, NULL+#accessor boolresult, "can_resume", params_only, NULL+#accessor boolresult, "is_half_duplex", params_only, NULL+#accessor boolresult, "is_joint_duplex", params_only, NULL+#accessor boolresult, "can_sync_start", params_only, NULL+++#accessor checked, "get_rate_numden", params_only, \+               out(&uint_p, "rateNum"), out(&uint_p, "rateDen"), NULL+#accessor uintresult, "get_sbits", params_only, NULL+#accessor uintresult, "get_fifo_size", params_only, NULL++#accessor checked, "get_access", params_only, out(&access_p, "access"), NULL+#accessor errnoresult, "test_access", pcm_params, in(&access_p, "access"), NULL+#accessor checked, "set_access", pcm_params, in(&access_p, "access"), NULL+#accessor checked, "set_access_first", pcm_params, inout(&access_p, "access"), NULL+#accessor checked, "set_access_last", pcm_params, inout(&access_p, "access"), NULL+{- in order to use this, we would have to implement mask accessors, too+#accessor checked, "set_access_mask", pcm_params, inout(&access_mask, "mask"), NULL+#accessor checked, "get_access_mask", params_only, out(&access_mask, "mask"), NULL+-}++#accessor checked, "get_format", params_only, out(&format_p, "val"), NULL+#accessor errnoresult, "test_format", pcm_params, in(&format_p, "val"), NULL+#accessor checked, "set_format", pcm_params, in(&format_p, "val"), NULL+#accessor checked, "set_format_first", pcm_params, inout(&format_p, "format"), NULL+#accessor checked, "set_format_last", pcm_params, inout(&format_p, "format"), NULL+{-+#accessor checked, "set_format_mask", pcm_params, inout(&format_mask_p, "mask"), NULL+#accessor noresult, "get_format_mask", params_only, out(&format_mask_p, "mask"), NULL+-}++#accessor checked, "get_subformat", params_only, out(&subformat_p, "subformat"), NULL+#accessor errnoresult, "test_subformat", pcm_params, in(&subformat_p, "subformat"), NULL+#accessor checked, "set_subformat", pcm_params, in(&subformat_p, "subformat"), NULL+#accessor checked, "set_subformat_first", pcm_params, inout(&subformat_p, "subformat"), NULL+#accessor checked, "set_subformat_last", pcm_params, inout(&subformat_p, "subformat"), NULL+{-+#accessor checked, "set_subformat_mask", pcm_params, inout(&subformat_mask_p, "mask"), NULL+#accessor noresult, "get_subformat_mask", params_only, out(&subformat_mask_p, "mask"), NULL+-}++#accessor checked, "get_channels", params_only, out(&uint_p, "val"), NULL+#accessor checked, "get_channels_min", params_only, out(&uint_p, "val"), NULL+#accessor checked, "get_channels_max", params_only, out(&uint_p, "val"), NULL+#accessor errnoresult, "test_channels", pcm_params, in(&uint_p, "val"), NULL+#accessor checked, "set_channels", pcm_params, in(&uint_p, "val"), NULL+#accessor checked, "set_channels_min", pcm_params, inout(&uint_p, "val"), NULL+#accessor checked, "set_channels_max", pcm_params, inout(&uint_p, "val"), NULL+#accessor checked, "set_channels_minmax", pcm_params, inout(&uint_p, "vmin"), inout(&uint_p, "vmax"), NULL+#accessor checked, "set_channels_near", pcm_params, inout(&uint_p, "val"), NULL+#accessor checked, "set_channels_first", pcm_params, inout(&uint_p, "val"), NULL+#accessor checked, "set_channels_last", pcm_params, inout(&uint_p, "val"), NULL++#accessor checked, "get_rate", params_only, out(&rate_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_rate_min", params_only, out(&rate_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_rate_max", params_only, out(&rate_p, "val"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_rate", pcm_params, in(&rate_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_rate", pcm_params, in(&rate_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_rate_min", pcm_params, inout(&rate_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_rate_max", pcm_params, inout(&rate_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_rate_minmax", pcm_params, inout(&rate_p, "vmin"), inout(&direction_p, "mindir"), inout(&rate_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_rate_near", pcm_params, inout(&rate_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_rate_first", pcm_params, inout(&rate_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_rate_last", pcm_params, inout(&rate_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_rate_resample", pcm_params, in(&bool_p, "val"), NULL+#accessor checked, "get_rate_resample", pcm_params, out(&bool_p, "val"), NULL+#accessor checked, "set_export_buffer", pcm_params, in(&bool_p, "val"), NULL+#accessor checked, "get_export_buffer", pcm_params, out(&bool_p, "val"), NULL++#accessor checked, "get_period_time", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_period_time_min", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_period_time_max", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_period_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_period_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_period_time_min", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_time_max", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_time_minmax", pcm_params, inout(&time_p, "vmin"), inout(&direction_p, "mindir"), inout(&time_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_period_time_near", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_time_first", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_time_last", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL++#accessor checked, "get_period_size", params_only, out(&uframes_p, "frames"), out(&direction_p, "dir"), NULL+#accessor checked, "get_period_size_min", params_only, out(&uframes_p, "frames"), out(&direction_p, "dir"), NULL+#accessor checked, "get_period_size_max", params_only, out(&uframes_p, "frames"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_period_size", pcm_params, in(&uframes_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_period_size", pcm_params, in(&uframes_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_min", pcm_params, inout(&uframes_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_max", pcm_params, inout(&uframes_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_minmax", pcm_params, inout(&uframes_p, "vmin"), inout(&direction_p, "mindir"), inout(&uframes_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_period_size_near", pcm_params, inout(&uframes_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_first", pcm_params, inout(&uframes_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_last", pcm_params, inout(&uframes_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_period_size_integer", pcm_params, NULL++#accessor checked, "get_periods", params_only, out(&uint_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_periods_min", params_only, out(&uint_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_periods_max", params_only, out(&uint_p, "val"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_periods", pcm_params, in(&uint_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_periods", pcm_params, in(&uint_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_periods_min", pcm_params, inout(&uint_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_periods_max", pcm_params, inout(&uint_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_periods_minmax", pcm_params, inout(&uint_p, "vmin"), inout(&direction_p, "mindir"), inout(&uint_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_periods_near", pcm_params, inout(&uint_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_periods_first", pcm_params, inout(&uint_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_periods_last", pcm_params, inout(&uint_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_periods_integer", pcm_params, NULL++#accessor checked, "get_buffer_time", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_buffer_time_min", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_buffer_time_max", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_buffer_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time_min", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time_max", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time_minmax", pcm_params, inout(&time_p, "vmin"), inout(&direction_p, "mindir"), inout(&time_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_buffer_time_near", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time_first", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_buffer_time_last", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL++#accessor checked, "get_buffer_size", params_only, out(&uframes_p, "val"), NULL+#accessor checked, "get_buffer_size_min", params_only, out(&uframes_p, "val"), NULL+#accessor checked, "get_buffer_size_max", params_only, out(&uframes_p, "val"), NULL+#accessor errnoresult, "test_buffer_size", pcm_params, in(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size", pcm_params, in(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size_min", pcm_params, inout(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size_max", pcm_params, inout(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size_minmax", pcm_params, inout(&uframes_p, "vmin"), inout(&uframes_p, "vmax"), NULL+#accessor checked, "set_buffer_size_near", pcm_params, inout(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size_first", pcm_params, inout(&uframes_p, "val"), NULL+#accessor checked, "set_buffer_size_last", pcm_params, inout(&uframes_p, "val"), NULL++#accessor checked, "get_tick_time", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_tick_time_min", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor checked, "get_tick_time_max", params_only, out(&time_p, "val"), out(&direction_p, "dir"), NULL+#accessor errnoresult, "test_tick_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time", pcm_params, in(&time_p, "val"), in(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time_min", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time_max", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time_minmax", pcm_params, inout(&time_p, "vmin"), inout(&direction_p, "mindir"), inout(&time_p, "vmax"), inout(&direction_p, "maxdir"), NULL+#accessor checked, "set_tick_time_near", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time_first", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL+#accessor checked, "set_tick_time_last", pcm_params, inout(&time_p, "val"), inout(&direction_p, "dir"), NULL++#accessor checked, "get_min_align", params_only, out(&uframes_p, "val"), NULL

@@ -0,0 +1,247 @@+#include <stdlib.h>+#include <stdarg.h>++typedef char bool;+const bool false = 0, true = 1;++enum context {pcm_params, params_only};++void make_camel_case (char *dst, const char *src) {+  while (*src != 0) {+    if (*src == '_') {+      src ++;+      if (*src == 0) {break;}+      *dst = *src - ('a'-'A'); // assumes that 'a'>'A'+    } else {+      *dst = *src;+    }+    src++;+    dst++;+  }+  *dst = 0;+}++void init_comma (bool *comma) {+  *comma = false;+}++void print_comma (bool *comma) {+  if (*comma) {+    printf(", ");+  }+  *comma = true;+}++struct type {+  char *convert;+  char *hsname;+  char *cname;+};++enum param_direction {dir_in, dir_out, dir_inout};++struct parameter {+  struct type *type;+  char *name;+  enum param_direction dir;+};++struct parameter *in (struct type* t, char *name) {+  struct parameter *p = malloc (sizeof(struct parameter));+  p->type = t;+  p->name = name;+  p->dir = dir_in;+  return p;+}++struct parameter *out (struct type* t, char *name) {+  struct parameter *p = malloc (sizeof(struct parameter));+  p->type = t;+  p->name = name;+  p->dir = dir_out;+  return p;+}++struct parameter *inout (struct type* t, char *name) {+  struct parameter *p = malloc (sizeof(struct parameter));+  p->type = t;+  p->name = name;+  p->dir = dir_inout;+  return p;+}+++struct type bool_p = {"boolConv", "Bool", "Bool_"};++struct type uint_p = {"Conv.int", "Word", "C.CUInt"};++struct type rate_p = {"Conv.int", "SampleFreq", "C.CUInt"};++struct type time_p = {"Conv.int", "Time", "C.CUInt"};++struct type direction_p = {"ordConv", "Ordering", "Direction"};++struct type uframes_p = {"Conv.int", "Size", "C.CUInt"};++struct type access_p = {"Conv.id", "Access", "Access"};++struct type format_p = {"Conv.id", "Format", "Format"};++struct type subformat_p = {"Conv.id", "Subformat", "Subformat"};++enum result {noresult, boolresult, uintresult, errnoresult, checked};+++void hsc_accessor (enum result res, const char *name, enum context ctx, ...) {+  va_list arg;+  struct parameter *p;+  bool comma;+  char *camelName = alloca (strlen (name) + 1);+  make_camel_case (camelName, name);++  printf("foreign import ccall safe \"alsa/pcm.h snd_pcm_hw_params_%s\"\n",+         name);+  printf("   %s_ :: ", camelName);+  if (ctx==pcm_params) {+//    printf("Ptr (Struct i y) -> Ptr Params -> ");+    printf("Handle i y -> Ptr Params -> ");+  } else {+    printf("Ptr Params -> ");+  }++  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir == dir_in) {+      printf("%s -> ", p->type->cname);+     } else {+      printf("Ptr %s -> ", p->type->cname);+    }+  }+  va_end (arg);++  printf("IO ");+  if (res == noresult) {+    printf("()");+  } else if (res == errnoresult) {+    printf("E.Errno");+  } else {+    printf("C.CInt");+  }+  printf("\n\n");++  printf("%s :: ", camelName);++  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir != dir_out) {+      printf("%s -> ", p->type->hsname);+    }+  }+  va_end (arg);++  printf("T i y (");+  init_comma(&comma);+  if (res == uintresult) {+    print_comma(&comma);+    printf("Word");+  } else if (res == errnoresult) {+    print_comma(&comma);+    printf("E.Errno");+  } else if (res == boolresult) {+    print_comma(&comma);+    printf("Bool");+  }+  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir != dir_in) {+      print_comma(&comma);+      printf("%s", p->type->hsname);+    }+  }+  va_end (arg);+  printf(")\n");++  printf("%s", camelName);+  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir != dir_out) {+      printf(" %s", p->name);+    }+  }+  va_end (arg);+  printf(" =\n");++  if (ctx==pcm_params) {+//    printf("   Cons $ \\(Handle h) p ->\n");+    printf("   Cons $ \\h p ->\n");+  } else {+    printf("   Cons $ \\ _ p ->\n");+  }+  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir == dir_out) {+      printf("   alloca $ \\%sPtr ->\n", p->name);+    } else if (p->dir == dir_inout) {+      printf("   Conv.with %s %s $ \\%sPtr ->\n",+         p->type->convert, p->name, p->name);+    }+  }+  va_end (arg);++  printf("   %s_", camelName);+  if (ctx==pcm_params) {+    printf(" h p");+  } else {+    printf(" p");+  }+  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir == dir_in) {+      printf(" (fromHaskell %s %s)",+                p->type->convert, p->name);+    } else {+      printf(" %sPtr", p->name);+    }+  }+  va_end (arg);+  if (res == uintresult) {+    printf(" >>=\n   checkResult \"HwParams.%s\" >>= \\res ->\n", camelName);+  } else if (res == boolresult || res == errnoresult) {+    printf(" >>= \\res ->\n");+  } else if (res == checked) {+    printf(" >>=\n   checkResult_ \"HwParams.%s\" >>\n", camelName);+  } else {+    printf(" >>\n");+  }++  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir != dir_in) {+      printf("   Conv.peek %s %sPtr >>= \\%sResult ->\n",+         p->type->convert, p->name, p->name);+    }+  }+  va_end (arg);++  printf("   return (");+  init_comma(&comma);+  if (res == uintresult) {+    print_comma(&comma);+    printf("fromIntegral res");+  } else if (res == errnoresult) {+    print_comma(&comma);+    printf("res");+  } else if (res == boolresult) {+    print_comma(&comma);+    printf("res/=0");+  }+  va_start (arg, ctx);+  while (p = va_arg (arg, struct parameter *)) {+    if (p->dir != dir_in) {+      print_comma(&comma);+      printf("%sResult", p->name);+    }+  }+  va_end (arg);+  printf(")\n");+}

@@ -0,0 +1,138 @@+{-# LANGUAGE ForeignFunctionInterface #-}+module Sound.ALSA.PCM.Core.SwParams where++import Sound.ALSA.PCM.Core.Handle (Handle, Size, )+import qualified Sound.ALSA.PCM.Core.Handle as H -- expose Handle constructor to FFI+import qualified Sound.ALSA.PCM.Core.Convert as Conv++import Sound.ALSA.Exception (checkResult_, )++import Control.Applicative (Applicative(pure, (<*>)))++import Control.Exception (bracket, )++import qualified Foreign.Storable.Newtype as Store++import qualified Foreign.C.Types as C+import Foreign.Ptr (Ptr, )+import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, )+import Foreign.Marshal.Alloc (alloca, )++import Data.Word (Word, )+++#include <alsa/asoundlib.h>++newtype T i y a = Cons (H.Handle i y -> Ptr Params -> IO a)++data Params = Params+++{-+T is a Reader monad.+-}+instance Functor (T i y) where+   fmap f (Cons act) = Cons $ \h p -> fmap f $ act h p++instance Applicative (T i y) where+   pure a = Cons $ \ _h _p -> pure a+   Cons f <*> Cons x = Cons $ \h p -> f h p <*> x h p++instance Monad (T i y) where+   return a = Cons $ \ _h _p -> return a+   Cons x >>= k =+      Cons $ \h p -> x h p >>= \a -> case k a of Cons y -> y h p++++withIO :: Handle i y -> (Ptr Params -> IO a) -> IO a+withIO h f =+   bracket malloc free $ \p -> do+      current h p+      x <- f p+      set h p+      return x+--   bracket_ (current h p) (set h p) (f p)+++foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_malloc"+   malloc_ :: Ptr (Ptr Params) -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_free"+   free :: Ptr Params -> IO ()++malloc :: IO (Ptr Params)+malloc =+   alloca $ \pp ->+   malloc_ pp >>=+   checkResult_ "SwParams.malloc" >>+   peek pp++++foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params"+   set_ :: Handle i y -> Ptr Params -> IO C.CInt++foreign import ccall safe "alsa/pcm.h snd_pcm_sw_params_current"+   current_ :: Handle i y -> Ptr Params -> IO C.CInt++set :: Handle i y -> Ptr Params -> IO ()+set h p =+   set_ h p >>= checkResult_ "SwParams.set"++current :: Handle i y -> Ptr Params -> IO ()+current h p =+   current_ h p >>= checkResult_ "SwParams.current"++++newtype TimestampMode = TimestampMode {fromTimestampMode :: C.CInt}+   deriving (Eq, Ord)++instance Enum TimestampMode where+   toEnum n = TimestampMode $ fromIntegral n+   fromEnum (TimestampMode n) = fromIntegral n++instance Storable TimestampMode where+   sizeOf = Store.sizeOf fromTimestampMode+   alignment = Store.alignment fromTimestampMode+   peek = Store.peek TimestampMode+   poke = Store.poke fromTimestampMode++#{enum TimestampMode, TimestampMode,+   timestampNone = SND_PCM_TSTAMP_NONE,+   timestampMmap = SND_PCM_TSTAMP_MMAP}++++#{let accessor hsName, cName, conv, hsType, cType =+"foreign import ccall safe \"alsa/pcm.h snd_pcm_sw_params_set_"cName"\"\n"+"   set"hsName"_ :: Handle i y -> Ptr Params -> "cType" -> IO C.CInt\n"+"\n"+"foreign import ccall safe \"alsa/pcm.h snd_pcm_sw_params_get_"cName"\"\n"+"   get"hsName"_ :: Ptr Params -> Ptr "cType" -> IO C.CInt\n"+"\n"+"set"hsName" :: "hsType" -> T i y ()\n"+"set"hsName" x =\n"+"   Cons $ \\h p ->\n"+"   set"hsName"_ h p (Conv.fromHaskell "conv" x) >>=\n"+"   checkResult_ \"SwParams.set"hsName"\"\n"+"\n"+"get"hsName" :: T i y "hsType"\n"+"get"hsName" =\n"+"   Cons $ \\_ p ->\n"+"   alloca $ \\ptr ->\n"+"   get"hsName"_ p ptr >>=\n"+"   checkResult_ \"SwParams.get"hsName"\" >>\n"+"   Conv.peek "conv" ptr\n"+}+++#accessor "TimestampMode", "tstamp_mode", "Conv.id", "TimestampMode", "TimestampMode"+#accessor "SleepMin", "sleep_min", "Conv.int", "Word", "C.CUInt"+#accessor "AvailMin", "avail_min", "Conv.int", "Size", "C.CULong"+#accessor "XferAlign", "xfer_align", "Conv.int", "Size", "C.CULong"+#accessor "StartThreshold", "start_threshold", "Conv.int", "Size", "C.CULong"+#accessor "StopThreshold", "stop_threshold", "Conv.int", "Size", "C.CULong"+#accessor "SilenceThreshold", "silence_threshold", "Conv.int", "Size", "C.CULong"+#accessor "SilenceSize", "silence_size", "Conv.int", "Size", "C.CULong"

@@ -0,0 +1,126 @@+module Sound.ALSA.PCM.Node.ALSA (+   -- * Types+   Handle,+   PCM.Stream(..),+   PCM.Mode, PCM.modes, PCM.nonBlock, PCM.async,+   Interleaved, Noninterleaved,+   Time, SampleFreq, Size,+   -- * Classes+   Class.Access, Class.SampleFmt, Class.MonoSampleFmt,+   -- * Management of streams+   open,+   PCM.close,+   PCM.prepare,+   PCM.start,+   PCM.drop,+   PCM.drain,+   -- * Data transfer+   readi, writei, readiRetry, writeiRetry,+   readn, writen,+   ) where++import Sound.ALSA.PCM.Parameters.Hardware (Time, SampleFreq, Size, )+import Sound.ALSA.PCM.Core.Handle (Handle, Interleaved, Noninterleaved, prepare, )+import qualified Sound.ALSA.PCM.Parameters.Software as SwParam+import qualified Sound.ALSA.PCM.Parameters.Hardware as HwParam+import qualified Sound.ALSA.PCM.Core.Class as Class+import qualified Sound.ALSA.PCM.Core.Handle as PCM+import qualified Sound.ALSA.PCM.Debug as Debug+import qualified Sound.ALSA.Exception as AlsaExc++import Foreign.Marshal.Array (advancePtr, )+import Foreign (Ptr, )+++open ::+   (Class.Access i, Class.SampleFmt y) =>+      PCM.Mode+   -> PCM.Stream+   -> HwParam.T i y a+   -> (a -> SwParam.T i y b)+   -> String -- ^ device, e.g @\"default\"@+   -> IO (b, Handle i y)+open mode stream hwp swp dev = do+   h <- PCM.open dev stream mode+   a <- Class.withHwParams h hwp+   b <- Class.withSwParams h $ swp a+   return (b, h)+++readi ::+   (Class.SampleFmt y) =>+   Handle Interleaved y -> Ptr y -> Size -> IO Size+readi = PCM.readi++writei ::+   (Class.SampleFmt y) =>+   Handle Interleaved y -> Ptr y -> Size -> IO Size+writei = PCM.writei++{- |+The @Ptr (Ptr y)@ argument is actually a pointer to an array of pointers.+The array must have the size of number of channels.+In 'Noninterleaved' mode you must set the number of channels manually+using 'HwParam.setChannels' or its friends.+It is an unchecked error if the number of channels+set with 'HwParam.setChannels'+does not match the array size in the 'readn' call.+-}+readn ::+   (Class.MonoSampleFmt y) =>+   Handle Noninterleaved y -> Ptr (Ptr y) -> Size -> IO Size+readn = PCM.readn++{- |+Cf. 'readn'.+-}+writen ::+   (Class.MonoSampleFmt y) =>+   Handle Noninterleaved y -> Ptr (Ptr y) -> Size -> IO Size+writen = PCM.writen++++{- |+retry on buffer over-run+-}+readiRetry ::+   Class.SampleFmt y =>+   Handle Interleaved y -> Ptr y -> Size -> IO Size+readiRetry h buf0 n =+   let go buf offset = do+          -- debug $ "Reading " ++ show n ++ " samples..."+          nread <-+             readi h buf (n-offset)+             `AlsaExc.catchXRun`+             do Debug.put "snd_pcm_readi reported buffer over-run"+                prepare h+                go buf offset+          let newOffset = offset+nread+          -- debug $ "Got " ++ show n' ++ " samples."+          if newOffset < n+            then go (advancePtr buf (fromIntegral nread)) newOffset+            else return newOffset+   in  go buf0 0++{- |+retry on buffer under-run+-}+writeiRetry ::+   Class.SampleFmt y =>+   Handle Interleaved y -> Ptr y -> Size -> IO Size+writeiRetry h buf0 n =+   let go buf offset = do+          -- debug $ "Writing " ++ show n ++ " samples..."+          nwritten <-+             writei h buf (n-offset)+             `AlsaExc.catchXRun`+             do Debug.put "snd_pcm_writei reported buffer under-run"+                prepare h+                go buf offset+          let newOffset = offset+nwritten+          --debug $ "Wrote " ++ show n' ++ " samples."+          if newOffset < n+            then go (advancePtr buf (fromIntegral nwritten)) newOffset+            else return newOffset+   in  go buf0 0

@@ -0,0 +1,60 @@+module Sound.ALSA.PCM.Node.File (+   -- * Types+   Handle,+   Time, SampleFreq, Size,+   -- * Classes+   Class.SampleFmt,+   -- * Management of streams+   open, close,+   -- * Data transfer+   read, write,+   ) where++import qualified Sound.ALSA.PCM.Core.Class as Class+import Sound.ALSA.PCM.Parameters.Hardware (Time, SampleFreq, Size, )+import Sound.ALSA.PCM.Core.Handle (arraySize, )++import Control.Monad (liftM, )+import Foreign.Ptr (Ptr, )+import qualified System.IO as IO+import System.IO (IOMode, openBinaryFile, )++import Prelude hiding (read, )+++newtype Handle y = Handle IO.Handle+++open ::+   (Class.SampleFmt y) =>+   IOMode -> FilePath -> IO (Handle y)+open mode path =+   fmap Handle $ openBinaryFile path mode++close ::+   (Class.SampleFmt y) =>+   Handle y -> IO ()+close (Handle h) =+   IO.hClose h++{- |+This expects pad bytes that are needed in memory+in order to satisfy aligment constraints.+This is only a problem for samples sizes like 24 bit.+-}+read ::+   (Class.SampleFmt y) =>+   Handle y -> Ptr y -> Size -> IO Size+read (Handle h) buf n =+   liftM fromIntegral $+   liftM (`div` arraySize buf 1) $+   IO.hGetBuf h buf (arraySize buf (fromIntegral n))++{- |+Same restrictions as for 'fileRead'.+-}+write ::+   (Class.SampleFmt y) =>+   Handle y -> Ptr y -> Size -> IO ()+write (Handle h) buf n =+   IO.hPutBuf h buf (arraySize buf (fromIntegral n))

@@ -0,0 +1,262 @@+module Sound.ALSA.PCM.Parameters.Hardware (+   -- * Types+   T, SampleFreq, Time, Size,+   Interleaved, Noninterleaved,++{-+   HwParams.Access,+   HwParams.accessMmapInterleaved,+   HwParams.accessMmapNoninterleaved,+   HwParams.accessMmapComplex,+   HwParams.accessRwInterleaved,+   HwParams.accessRwNoninterleaved,++   HwParams.Format,+   HwParams.formatUnknown,+   HwParams.formatS8,+   HwParams.formatU8,+   HwParams.formatS16Le,+   HwParams.formatS16Be,+   HwParams.formatU16Le,+   HwParams.formatU16Be,+   HwParams.formatS24Le,+   HwParams.formatS24Be,+   HwParams.formatU24Le,+   HwParams.formatU24Be,+   HwParams.formatS32Le,+   HwParams.formatS32Be,+   HwParams.formatU32Le,+   HwParams.formatU32Be,+   HwParams.formatFloatLe,+   HwParams.formatFloatBe,+   HwParams.formatFloat64Le,+   HwParams.formatFloat64Be,+   HwParams.formatIec958SubframeLe,+   HwParams.formatIec958SubframeBe,+   HwParams.formatMuLaw,+   HwParams.formatALaw,+   HwParams.formatImaAdpcm,+   HwParams.formatMpeg,+   HwParams.formatGsm,+   HwParams.formatSpecial,+   HwParams.formatS243le,+   HwParams.formatS243be,+   HwParams.formatU243le,+   HwParams.formatU243be,+   HwParams.formatS203le,+   HwParams.formatS203be,+   HwParams.formatU203le,+   HwParams.formatU203be,+   HwParams.formatS183le,+   HwParams.formatS183be,+   HwParams.formatU183le,+   HwParams.formatU183be,+   HwParams.formatS16,+   HwParams.formatU16,+   HwParams.formatS24,+   HwParams.formatU24,+   HwParams.formatS32,+   HwParams.formatU32,+   HwParams.formatFloat,+   HwParams.formatFloat64,+   HwParams.formatIec958Subframe,++   HwParams.Subformat,+-}++   -- * Primitive accessors to hardware parameters+   HwParams.canMmapSampleResolution,+   HwParams.isDouble,+   HwParams.isBatch,+   HwParams.isBlockTransfer,+   HwParams.canOverrange,+   HwParams.canPause,+   HwParams.canResume,+   HwParams.isHalfDuplex,+   HwParams.isJointDuplex,+   HwParams.canSyncStart,+   HwParams.getRateNumden,+   HwParams.getSbits,+   HwParams.getFifoSize,+{- integrated in 'with'+   HwParams.getAccess,+   HwParams.testAccess,+   HwParams.setAccess,+   HwParams.setAccessFirst,+   HwParams.setAccessLast,+   HwParams.getFormat,+   HwParams.testFormat,+   HwParams.setFormat,+   HwParams.setFormatFirst,+   HwParams.setFormatLast,+-}+{- don't know how to use this reasonably+   HwParams.getSubformat,+   HwParams.testSubformat,+   HwParams.setSubformat,+   HwParams.setSubformatFirst,+   HwParams.setSubformatLast,+-}+   HwParams.getChannels,+   HwParams.getChannelsMin,+   HwParams.getChannelsMax,+   HwParams.testChannels,+   setChannels,+   setChannelsMin,+   setChannelsMax,+   setChannelsMinmax,+   setChannelsNear,+   setChannelsFirst,+   setChannelsLast,+   HwParams.getRate,+   HwParams.getRateMin,+   HwParams.getRateMax,+   HwParams.testRate,+   HwParams.setRate,+   HwParams.setRateMin,+   HwParams.setRateMax,+   HwParams.setRateMinmax,+   HwParams.setRateNear,+   HwParams.setRateFirst,+   HwParams.setRateLast,+   HwParams.setRateResample,+   HwParams.getRateResample,+   HwParams.setExportBuffer,+   HwParams.getExportBuffer,+   HwParams.getPeriodTime,+   HwParams.getPeriodTimeMin,+   HwParams.getPeriodTimeMax,+   HwParams.testPeriodTime,+   HwParams.setPeriodTime,+   HwParams.setPeriodTimeMin,+   HwParams.setPeriodTimeMax,+   HwParams.setPeriodTimeMinmax,+   HwParams.setPeriodTimeNear,+   HwParams.setPeriodTimeFirst,+   HwParams.setPeriodTimeLast,+   HwParams.getPeriodSize,+   HwParams.getPeriodSizeMin,+   HwParams.getPeriodSizeMax,+   HwParams.testPeriodSize,+   HwParams.setPeriodSize,+   HwParams.setPeriodSizeMin,+   HwParams.setPeriodSizeMax,+   HwParams.setPeriodSizeMinmax,+   HwParams.setPeriodSizeNear,+   HwParams.setPeriodSizeFirst,+   HwParams.setPeriodSizeLast,+   HwParams.setPeriodSizeInteger,+   HwParams.getPeriods,+   HwParams.getPeriodsMin,+   HwParams.getPeriodsMax,+   HwParams.testPeriods,+   HwParams.setPeriods,+   HwParams.setPeriodsMin,+   HwParams.setPeriodsMax,+   HwParams.setPeriodsMinmax,+   HwParams.setPeriodsNear,+   HwParams.setPeriodsFirst,+   HwParams.setPeriodsLast,+   HwParams.setPeriodsInteger,+   HwParams.getBufferTime,+   HwParams.getBufferTimeMin,+   HwParams.getBufferTimeMax,+   HwParams.testBufferTime,+   HwParams.setBufferTime,+   HwParams.setBufferTimeMin,+   HwParams.setBufferTimeMax,+   HwParams.setBufferTimeMinmax,+   HwParams.setBufferTimeNear,+   HwParams.setBufferTimeFirst,+   HwParams.setBufferTimeLast,+   HwParams.getBufferSize,+   HwParams.getBufferSizeMin,+   HwParams.getBufferSizeMax,+   HwParams.testBufferSize,+   HwParams.setBufferSize,+   HwParams.setBufferSizeMin,+   HwParams.setBufferSizeMax,+   HwParams.setBufferSizeMinmax,+   HwParams.setBufferSizeNear,+   HwParams.setBufferSizeFirst,+   HwParams.setBufferSizeLast,+   HwParams.getTickTime,+   HwParams.getTickTimeMin,+   HwParams.getTickTimeMax,+   HwParams.testTickTime,+   HwParams.setTickTime,+   HwParams.setTickTimeMin,+   HwParams.setTickTimeMax,+   HwParams.setTickTimeMinmax,+   HwParams.setTickTimeNear,+   HwParams.setTickTimeFirst,+   HwParams.setTickTimeLast,+   HwParams.getMinAlign,++   -- * Complex hardware parameter configuration+   setRateBufferTime,+   ) where++import qualified Sound.ALSA.PCM.Core.HwParams as HwParams+import Sound.ALSA.PCM.Core.HwParams (T, )+import Sound.ALSA.PCM.Core.Handle+          (SampleFreq, Time, Size, Interleaved, Noninterleaved, )++import Data.Word (Word, )+++{-+Our approach cannot assert, that setChannels is called.+Is this necessary, at all?+If yes, setChannel accessors could return a secret value,+that must be passed to 'writen' in order to prove,+that setChannel was called.+-}++{- |+For non-interleaved access the number of channels must be set manually.+It can be chosen at runtime,+but the compiler cannot check whether the number of allocated channels+matches the one in 'readn' and 'writen'.++In interleaved access the number of channels is derived from the type+and must not be set manually.+The number is static+but the compiler checks consistency with 'readi' and 'writei'.+-}+setChannels :: Word -> T Noninterleaved y ()+setChannels = HwParams.setChannels++setChannelsMin :: Word -> T Noninterleaved y Word+setChannelsMin = HwParams.setChannelsMin++setChannelsMax :: Word -> T Noninterleaved y Word+setChannelsMax = HwParams.setChannelsMax++setChannelsMinmax :: Word -> Word -> T Noninterleaved y (Word, Word)+setChannelsMinmax = HwParams.setChannelsMinmax++setChannelsNear :: Word -> T Noninterleaved y Word+setChannelsNear = HwParams.setChannelsNear++setChannelsFirst :: Word -> T Noninterleaved y Word+setChannelsFirst = HwParams.setChannelsFirst++setChannelsLast :: Word -> T Noninterleaved y Word+setChannelsLast = HwParams.setChannelsLast++++setRateBufferTime ::+      SampleFreq -- ^ sample frequency+   -> Time -- ^ buffer time+   -> Time -- ^ period time+   -> T Interleaved y (Size,Size)+      -- ^ (bufferSize,periodSize)+setRateBufferTime rate bufferTime periodTime = do+   HwParams.setRate rate EQ+   _ <- HwParams.setBufferTimeNear bufferTime EQ+   bufferSize <- HwParams.getBufferSize+   _ <- HwParams.setPeriodTimeNear periodTime EQ+   (periodSize,_) <- HwParams.getPeriodSize+   return (bufferSize,periodSize)

@@ -0,0 +1,37 @@+module Sound.ALSA.PCM.Parameters.Software (+   -- * Types+   SwParams.T, Size,+   TimestampMode, timestampNone, timestampMmap,++   -- * Primitive accessors to software parameters+   getAvailMin,         setAvailMin,+   getSilenceSize,      setSilenceSize,+   getSilenceThreshold, setSilenceThreshold,+   getSleepMin,         setSleepMin,+   getStartThreshold,   setStartThreshold,+   getStopThreshold,    setStopThreshold,+   getTimestampMode,    setTimestampMode,+   getXferAlign,        setXferAlign,++   -- * Complex software parameter configuration+   setBufferSize,+   ) where++import Sound.ALSA.PCM.Core.SwParams as SwParams+import Sound.ALSA.PCM.Core.Handle (Size, )+++setBufferSize ::+      Size -- ^ buffer size+   -> Size -- ^ period size+   -> SwParams.T i y ()+setBufferSize _bufferSize periodSize = do+   -- let startThreshold =+   --        (setBufferSize `div` periodSize) * periodSize+   -- setStartThreshold startThreshold+   setStartThreshold 0+   setAvailMin $ fromIntegral periodSize+   setXferAlign 1+   -- pad buffer with silence when needed+   -- setSilenceSize periodSize+   -- setSilenceThreshold periodSize