diff --git a/alsa-pcm.cabal b/alsa-pcm.cabal --- a/alsa-pcm.cabal +++ b/alsa-pcm.cabal @@ -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 Author: Henning Thielemann , Bjorn Bringert , Iavor S. Diatchki @@ -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 diff --git a/examples/duplex.hs b/examples/duplex.hs --- a/examples/duplex.hs +++ b/examples/duplex.hs @@ -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 diff --git a/examples/play.hs b/examples/play.hs --- a/examples/play.hs +++ b/examples/play.hs @@ -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 diff --git a/examples/record.hs b/examples/record.hs --- a/examples/record.hs +++ b/examples/record.hs @@ -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 diff --git a/examples/sine.hs b/examples/sine.hs new file mode 100644 --- /dev/null +++ b/examples/sine.hs @@ -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 diff --git a/examples/synth.hs b/examples/synth.hs --- a/examples/synth.hs +++ b/examples/synth.hs @@ -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 diff --git a/examples/volume_meter.hs b/examples/volume_meter.hs --- a/examples/volume_meter.hs +++ b/examples/volume_meter.hs @@ -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' diff --git a/src/Sound/ALSA/PCM.hs b/src/Sound/ALSA/PCM.hs --- a/src/Sound/ALSA/PCM.hs +++ b/src/Sound/ALSA/PCM.hs @@ -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) diff --git a/src/Sound/ALSA/PCM/C2HS.hs b/src/Sound/ALSA/PCM/C2HS.hs deleted file mode 100644 --- a/src/Sound/ALSA/PCM/C2HS.hs +++ /dev/null @@ -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 diff --git a/src/Sound/ALSA/PCM/Core.chs b/src/Sound/ALSA/PCM/Core.chs deleted file mode 100644 --- a/src/Sound/ALSA/PCM/Core.chs +++ /dev/null @@ -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 - -{#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) diff --git a/src/Sound/ALSA/PCM/Core/Class.hs b/src/Sound/ALSA/PCM/Core/Class.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/Class.hs @@ -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 diff --git a/src/Sound/ALSA/PCM/Core/Convert.hs b/src/Sound/ALSA/PCM/Core/Convert.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/Convert.hs @@ -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 +-} diff --git a/src/Sound/ALSA/PCM/Core/Handle.hsc b/src/Sound/ALSA/PCM/Core/Handle.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/Handle.hsc @@ -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 + + +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 diff --git a/src/Sound/ALSA/PCM/Core/HwParams.hsc b/src/Sound/ALSA/PCM/Core/HwParams.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/HwParams.hsc @@ -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 +#include + + + +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 diff --git a/src/Sound/ALSA/PCM/Core/Params.h b/src/Sound/ALSA/PCM/Core/Params.h new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/Params.h @@ -0,0 +1,247 @@ +#include +#include + +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"); +} diff --git a/src/Sound/ALSA/PCM/Core/SwParams.hsc b/src/Sound/ALSA/PCM/Core/SwParams.hsc new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Core/SwParams.hsc @@ -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 + +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" diff --git a/src/Sound/ALSA/PCM/Node/ALSA.hs b/src/Sound/ALSA/PCM/Node/ALSA.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Node/ALSA.hs @@ -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 diff --git a/src/Sound/ALSA/PCM/Node/File.hs b/src/Sound/ALSA/PCM/Node/File.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Node/File.hs @@ -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)) diff --git a/src/Sound/ALSA/PCM/Parameters/Hardware.hs b/src/Sound/ALSA/PCM/Parameters/Hardware.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Parameters/Hardware.hs @@ -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) diff --git a/src/Sound/ALSA/PCM/Parameters/Software.hs b/src/Sound/ALSA/PCM/Parameters/Software.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/PCM/Parameters/Software.hs @@ -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