diff --git a/alsa-pcm.cabal b/alsa-pcm.cabal --- a/alsa-pcm.cabal +++ b/alsa-pcm.cabal @@ -1,14 +1,14 @@ -Name: alsa-pcm -Version: 0.5 -Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann -Maintainer: Henning Thielemann -Author: Bjorn Bringert , Iavor S. Diatchki -Category: Sound, Music -License: BSD3 -License-file: LICENSE -Homepage: http://www.haskell.org/haskellwiki/ALSA -Stability: Experimental -Build-Type: Simple +Name: alsa-pcm +Version: 0.5.0.1 +Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann +Maintainer: Henning Thielemann +Author: Henning Thielemann , Bjorn Bringert , Iavor S. Diatchki +Category: Sound, Music +License: BSD3 +License-file: LICENSE +Homepage: http://www.haskell.org/haskellwiki/ALSA +Stability: Experimental +Build-Type: Simple Cabal-Version: >= 1.8 Synopsis: Binding to the ALSA Library API (PCM audio). @@ -16,19 +16,31 @@ This package provides access to ALSA realtime audio signal input and output. For MIDI support see alsa-seq. +Extra-Source-Files: + nodebug/Sound/ALSA/PCM/Debug.hs + debug/Sound/ALSA/PCM/Debug.hs + Source-Repository head type: darcs - location: http://code.haskell.org/~thielema/alsa-pcm/ + location: http://code.haskell.org/alsa/pcm/ Source-Repository this type: darcs - location: http://code.haskell.org/~thielema/alsa-pcm/ - tag: 0.5 + location: http://code.haskell.org/alsa/pcm/ + tag: 0.5.0.1 Flag buildExamples description: Build example executables default: False +Flag buildSynthesizer + description: Build example synthesizer (needs alsa-seq, too) + default: False + +Flag debug + description: Enable debug output + default: False + Library Build-depends: alsa-core >=0.5 && <0.6, @@ -38,6 +50,10 @@ base >= 3 && <5 Hs-Source-Dirs: src + If flag(debug) + Hs-Source-Dirs: debug + Else + Hs-Source-Dirs: nodebug Exposed-Modules: Sound.ALSA.PCM @@ -45,17 +61,35 @@ Other-modules: Sound.ALSA.PCM.Core Sound.ALSA.PCM.C2HS + Sound.ALSA.PCM.Debug - GHC-Options: -Wall + GHC-Options: -Wall -fwarn-tabs Includes: alsa/asoundlib.h - Extra-libraries: asound + PkgConfig-depends: alsa >= 1.0.14 +Executable alsa-minisynth + Main-Is: synth.hs + If !flag(buildSynthesizer) + Buildable: False + Hs-Source-Dirs: src, debug, examples + 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 + Executable alsa-duplex Main-Is: duplex.hs If !flag(buildExamples) Buildable: False - Hs-Source-Dirs: src, examples + Hs-Source-Dirs: src, debug, examples GHC-Options: -Wall -threaded Other-modules: Sound.ALSA.PCM @@ -70,7 +104,7 @@ Main-Is: play.hs If !flag(buildExamples) Buildable: False - Hs-Source-Dirs: src, examples + Hs-Source-Dirs: src, debug, examples GHC-Options: -Wall -threaded Other-modules: Sound.ALSA.PCM @@ -85,7 +119,7 @@ Main-Is: record.hs If !flag(buildExamples) Buildable: False - Hs-Source-Dirs: src, examples + Hs-Source-Dirs: src, debug, examples GHC-Options: -Wall -threaded Other-modules: Sound.ALSA.PCM @@ -100,7 +134,7 @@ Main-Is: volume_meter.hs If !flag(buildExamples) Buildable: False - Hs-Source-Dirs: src, examples + Hs-Source-Dirs: src, debug, examples GHC-Options: -Wall -threaded Other-modules: Sound.ALSA.PCM diff --git a/debug/Sound/ALSA/PCM/Debug.hs b/debug/Sound/ALSA/PCM/Debug.hs new file mode 100644 --- /dev/null +++ b/debug/Sound/ALSA/PCM/Debug.hs @@ -0,0 +1,9 @@ +module Sound.ALSA.PCM.Debug where + +import qualified System.IO as IO +import Control.Concurrent (myThreadId, ) + +put :: String -> IO () +put s = + do t <- myThreadId + IO.hPutStrLn IO.stderr $ "Sound.ALSA.PCM, " ++ show t ++ ": " ++ s diff --git a/examples/duplex.hs b/examples/duplex.hs --- a/examples/duplex.hs +++ b/examples/duplex.hs @@ -25,10 +25,9 @@ duplex :: FilePath -> FilePath -> IO () duplex infile outfile = - do forkOS (play infile) - forkOS (record outfile) + do _ <- forkOS (play infile) + _ <- forkOS (record outfile) threadDelay 5000000 - return () play :: FilePath -> IO () diff --git a/examples/play.hs b/examples/play.hs --- a/examples/play.hs +++ b/examples/play.hs @@ -3,8 +3,7 @@ fileSoundSource, alsaSoundSink, ) import System.Environment (getArgs, ) -import System.Exit (exitFailure, ) -import System.IO (hPutStrLn, stderr, ) + import Data.Int (Int16, ) bufSize :: Int @@ -14,14 +13,13 @@ soundFormat = SoundFmt { sampleFreq = 8000 } main :: IO () -main = do args <- getArgs - case args of - [file] -> play file - _ -> do hPutStrLn stderr "Usage: play " - exitFailure +main = + mapM_ play =<< getArgs play :: FilePath -> IO () play file = - do let source = fileSoundSource file soundFormat - sink = alsaSoundSink "plughw:0,0" soundFormat - copySound source sink bufSize + copySound + (fileSoundSource file soundFormat) + -- "default" allows mixing with other ALSA programs + (alsaSoundSink "default" soundFormat) + bufSize diff --git a/examples/synth.hs b/examples/synth.hs new file mode 100644 --- /dev/null +++ b/examples/synth.hs @@ -0,0 +1,420 @@ +import qualified Sound.ALSA.PCM as PCM + +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.Event as Event +import qualified Sound.ALSA.Sequencer.Queue as Queue +import qualified Sound.ALSA.Sequencer.RealTime as RealTime +import qualified Sound.ALSA.Sequencer as SndSeq +-- import qualified Sound.ALSA.Exception as AlsaExc + +import qualified Data.StorableVector.ST.Strict as SVST +import qualified Data.StorableVector as SV +import qualified Data.StorableVector.Base as SVB + +import Foreign.Storable (Storable, ) +import Control.Monad.ST.Strict as ST + +import qualified Control.Monad.Trans.State.Strict as MS +import Control.Monad.IO.Class (liftIO, ) + +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 = 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 + 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 + Debug.put "alsaClose" + Core.pcm_drain pcm + Core.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 +{- + (actualRate,ord) <- + Core.pcm_hw_params_get_rate_max p + 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)) +{- + let actualBufferSize = bufferSize + Core.pcm_hw_params_set_buffer_size h p 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) + + +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 + + +withInPort :: + SndSeq.BlockMode -> + (SndSeq.T SndSeq.DuplexMode -> Port.T -> IO t) -> IO t +withInPort blockMode act = + SndSeq.with SndSeq.defaultName blockMode $ \h -> + Client.setName h "alsa-haskell-minisynth" >> + Port.withSimple h "input" + (Port.caps [Port.capWrite, Port.capSubsWrite]) + Port.typeApplication + (act h) + + +type StampedEvent = (Time, Event.T) + +type Time = Integer + + +{- | +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 -> + div (RealTime.toInteger t * rate) nano + _ -> error "unsupported time stamp type", + ev) + + +nano :: Integer +nano = 10^(9::Int) + +{- | only use it for blocking sequencers -} +getStampedEventsUntilTime :: + (SndSeq.AllowInput mode, SndSeq.AllowOutput mode) => + SndSeq.T mode -> + Queue.T -> Port.T -> + Time -> Time -> + IO [StampedEvent] +getStampedEventsUntilTime h q p r t = + fmap (map (addStamp r)) $ getEventsUntilTime h q p r t + + +{- | +Get events until a certain point in time. +It sends itself an Echo event in order to measure time. +-} +getEventsUntilTime :: + (SndSeq.AllowInput mode, SndSeq.AllowOutput mode) => + SndSeq.T mode -> + Queue.T -> Port.T -> + Time -> Time -> + IO [Event.T] +getEventsUntilTime h q p r t = do +-- putStrLn $ "schedule echo for " ++ show (milliseconds t) + c <- Client.getId h + _ <- Event.output h $ + makeEcho c q p + (RealTime.fromInteger $ div (t * nano) r) + (Event.Custom 0 0 0) + _ <- Event.drainOutput h + getEventsUntilEcho c h + + +makeEcho :: + Client.T -> Queue.T -> Port.T -> + RealTime.T -> Event.Custom -> Event.T +makeEcho c q p t dat = + (Event.simple + (Addr.Cons c Port.unknown) + (Event.CustomEv Event.Echo dat)) + { Event.queue = q + , Event.timestamp = Event.RealTime t + , Event.dest = Addr.Cons { + Addr.client = c, + Addr.port = p + } + } + + +{- | +The client id may differ from the receiving sequencer. +I do not know, whether there are circumstances, where this is useful. +-} +getEventsUntilEcho :: + (SndSeq.AllowInput mode) => + Client.T -> SndSeq.T mode -> IO [Event.T] +getEventsUntilEcho c h = + let loop = do + ev <- Event.input h + let abort = + case Event.body ev of + Event.CustomEv Event.Echo _ -> + c == Addr.client (Event.source ev) + _ -> False + if abort + then + case Event.timestamp ev of + Event.RealTime t -> do +-- putStrLn $ "got Echo at: " ++ show (RealTime.toInteger t :: Double) + return [] + _ -> error "unsupported time stamp type" + else liftM (ev:) loop + in loop + + +check :: Monad m => Bool -> String -> m () -> m () +check b msg act = + if not b + then trace msg $ return () + else act + +unsafeAddChunkToBuffer :: (Storable a, Num a) => + SVST.Vector s a -> Int -> SV.Vector a -> ST s () +unsafeAddChunkToBuffer v start xs = + let go i j = + if j >= SV.length xs + then return () + else + SVST.unsafeModify v i (SV.index xs j +) >> + go (i + 1) (j + 1) + in check (start>=0) + ("start negative: " ++ show (start, SV.length xs)) $ + check (start <= SVST.length v) + ("start too late: " ++ show (start, SV.length xs)) $ + check (start+SV.length xs <= SVST.length v) + ("end too late: " ++ show (start, SV.length xs)) $ + go start 0 + +arrange :: + (Storable a, Num a) => + Int -> + [(Int, SV.Vector a)] -> + SV.Vector a +arrange size evs = + SVST.runSTVector (do + v <- SVST.new size 0 + mapM_ (uncurry $ unsafeAddChunkToBuffer v) evs + return v) + + +type Pitch = Word8 +type Velocity = Word8 + +data OscillatorState a = OscillatorState a a Int + +{- +type ToneSequence a = + (Maybe (Int, OscillatorState a), + [(Int, Int, OscillatorState a)]) + +startTone :: ToneSequence a -> ToneSequence a +-} + +stopTone :: + Int -> + (Maybe (Int, OscillatorState a), + [(Int, Int, OscillatorState a)]) -> + [(Int, Int, OscillatorState a)] +stopTone stopTime (mplaying, finished) = + case mplaying of + Just (startTime, osci) -> + (startTime, stopTime-startTime, osci) : finished + Nothing -> finished + +renderTone :: + (Storable a, Floating a) => + Int -> OscillatorState a -> + (SV.Vector a, OscillatorState a) +renderTone dur state@(OscillatorState amp freq phase) = + if dur<0 + then + trace ("renderTone: negative duration " ++ show dur) $ + (SV.empty, state) + else + let gain = 0.9999 + in (SV.zipWith (\y k -> y * sin (2*pi*fromIntegral k * freq)) + (SV.iterateN dur (gain*) amp) + (SV.iterateN dur (1+) phase), + OscillatorState (amp*gain^dur) freq (phase+dur)) + +amplitudeFromVelocity :: + (Floating y) => + Velocity -> y +amplitudeFromVelocity vel = + 4 ** ((fromIntegral vel - 64) / 128) + +frequencyFromPitch :: + (Floating y) => + Pitch -> y +frequencyFromPitch pitch = + 440 * 2 ** (fromIntegral (fromIntegral pitch + 3 - 6*12 :: Int) / 12) + +normalizeNote :: Event.NoteEv -> Event.Note -> (Event.NoteEv, Velocity) +normalizeNote notePart note = + case Event.noteVelocity note of + velocity -> + case notePart of + Event.NoteOn -> + if velocity == 0 + then (Event.NoteOff, 64) + else (Event.NoteOn, velocity) + _ -> (notePart, velocity) + +processEvents :: + (Storable a, Floating a, Monad m) => + Int -> + PCM.SampleFreq -> + [StampedEvent] -> + MS.StateT (Time, Map.Map Pitch (OscillatorState a)) m [(Int, SV.Vector a)] +processEvents size rate input = do + (chunkTime, oscis0) <- MS.get + let pendingOscis = + fmap + (\(mplaying, finished) -> + let mplayingNew = + fmap + (\(start,s0) -> + case renderTone (size-start) s0 of + (chunk, s1) -> ((start,chunk), s1)) + mplaying + in (fmap snd mplayingNew, + maybe id (\p -> (fst p :)) mplayingNew $ + map + (\(start, dur, s) -> (start, fst $ renderTone dur s)) + finished)) $ + foldl + (\oscis (time,ev) -> + case Event.body ev of + Event.NoteEv noteEv note -> + case normalizeNote noteEv note of + (Event.NoteOn, velocity) -> + Map.insertWith + (\(newOsci, []) s -> + {- + A key may be pressed that was already pressed. + This should not happen, but we must be prepared for it. + Thus we call stopTone. + -} + (newOsci, stopTone time s)) + (Event.noteNote note) + (Just (time, + OscillatorState + (0.2 * amplitudeFromVelocity velocity) + (frequencyFromPitch (Event.noteNote note) / + fromIntegral rate) + 0), + []) + oscis + (Event.NoteOff, _) -> + Map.adjust + (\s -> + {- + A key may be released that was not pressed. + This should not happen, but we must be prepared for it. + Thus stopTone also handles that case. + -} + (Nothing, stopTone time s)) + (Event.noteNote note) + oscis + _ -> oscis + _ -> oscis) + (fmap (\s -> (Just (0, s), [])) oscis0) + (map (\(time,ev) -> (fromInteger (time-chunkTime), ev)) input) + MS.put (chunkTime, Map.mapMaybe fst pendingOscis) + return (concatMap snd $ Map.elems pendingOscis) + + +write :: + (PCM.SampleFmt a) => + Core.Pcm -> SV.Vector a -> IO () +write h xs = + SVB.withStartPtr xs $ PCM.alsaWrite h + + +{- +Caution: + - MIDI clock and PCM clock are quite different: + After running the synth for about an hour + I got messages like "start too late: (8969,0)", + that is, the MIDI clock was about 9000/44100 seconds + ahead of the PCM clock. +-} +main :: IO () +main = + bracket openPCM closePCM $ \(size,rate,h) -> do + putStrLn $ "period size: " ++ show size + putStrLn $ "sample rate: " ++ show rate + withInPort SndSeq.Block $ \sq port -> + Queue.with sq $ \ q -> + do setTimestamping sq port q + Queue.control sq q Event.QueueStart 0 Nothing + _ <- Event.drainOutput sq + write h (SV.replicate (2*size) 0 :: SV.Vector Float) + flip MS.evalStateT (0,Map.empty) $ forever $ do + startTime <- MS.gets fst + let stopTime = startTime + fromIntegral size + evs <- + liftIO $ + getStampedEventsUntilTime sq q port (fromIntegral rate) stopTime + chunks <- processEvents size rate evs + liftIO $ + write h (arrange size chunks :: SV.Vector Float) + MS.modify $ \(_,ss) -> (stopTime, ss) diff --git a/nodebug/Sound/ALSA/PCM/Debug.hs b/nodebug/Sound/ALSA/PCM/Debug.hs new file mode 100644 --- /dev/null +++ b/nodebug/Sound/ALSA/PCM/Debug.hs @@ -0,0 +1,4 @@ +module Sound.ALSA.PCM.Debug where + +put :: String -> IO () +put _ = return () 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 @@ -26,8 +26,10 @@ fileSoundSink, ) where -import Sound.ALSA.PCM.Core +import Sound.ALSA.PCM.Core (Pcm) +import qualified Sound.ALSA.PCM.Core as PCM 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 @@ -36,7 +38,6 @@ import Data.Word (Word8, Word16, Word32, ) import Data.Int (Int8, Int16, Int32, ) -import Control.Concurrent (myThreadId, ) import Control.Exception (bracket, bracket_, ) import Control.Monad (liftM, when, ) import Foreign.Marshal.Array (advancePtr, allocaArray, ) @@ -51,20 +52,20 @@ -- class (Storable y, Frame.C y) => SampleFmt y where - sampleFmtToPcmFormat :: y -> PcmFormat + sampleFmtToPcmFormat :: y -> PCM.Format type SampleFreq = Int data SoundFmt y = SoundFmt { - sampleFreq :: SampleFreq - } + sampleFreq :: SampleFreq + } deriving (Show) type Time = Int data SoundBufferTime = SoundBufferTime { - bufferTime, periodTime :: Time - } + bufferTime, periodTime :: Time + } deriving (Show) @@ -103,7 +104,7 @@ nullSoundSource :: SoundFmt y -> SoundSource y h nullSoundSource fmt = SoundSource { - soundSourceFmt = fmt, + soundSourceFmt = fmt, soundSourceOpen = return undefined, soundSourceClose = \_ -> return (), soundSourceStart = \_ -> return (), @@ -114,7 +115,7 @@ nullSoundSink :: SoundFmt y -> SoundSink y h nullSoundSink fmt = SoundSink { - soundSinkFmt = fmt, + soundSinkFmt = fmt, soundSinkOpen = return undefined, soundSinkClose = \_ -> return (), soundSinkStart = \_ -> return (), @@ -139,31 +140,31 @@ instance SampleFmt Word8 where - sampleFmtToPcmFormat _ = PcmFormatU8 + sampleFmtToPcmFormat _ = PCM.FormatU8 instance SampleFmt Int8 where - sampleFmtToPcmFormat _ = PcmFormatS8 + sampleFmtToPcmFormat _ = PCM.FormatS8 instance SampleFmt Word16 where - sampleFmtToPcmFormat _ = PcmFormatU16 + sampleFmtToPcmFormat _ = PCM.FormatU16 instance SampleFmt Int16 where - sampleFmtToPcmFormat _ = PcmFormatS16 + sampleFmtToPcmFormat _ = PCM.FormatS16 instance SampleFmt Word32 where - sampleFmtToPcmFormat _ = PcmFormatU32 + sampleFmtToPcmFormat _ = PCM.FormatU32 instance SampleFmt Int32 where - sampleFmtToPcmFormat _ = PcmFormatS32 + sampleFmtToPcmFormat _ = PCM.FormatS32 instance SampleFmt Float where - sampleFmtToPcmFormat _ = PcmFormatFloat + sampleFmtToPcmFormat _ = PCM.FormatFloat instance SampleFmt Double where - sampleFmtToPcmFormat _ = PcmFormatFloat64 + sampleFmtToPcmFormat _ = PCM.FormatFloat64 instance SampleFmt MuLaw.T where - sampleFmtToPcmFormat _ = PcmFormatMuLaw + sampleFmtToPcmFormat _ = PCM.FormatMuLaw instance SampleFmt a => SampleFmt (Stereo.T a) where sampleFmtToPcmFormat y = @@ -178,12 +179,12 @@ where t = "audio/basic" {- t = case sampleFmt fmt of - SampleFmtLinear16BitSignedLE -> "audio/L16" - SampleFmtMuLaw8Bit -> "audio/basic" + SampleFmtLinear16BitSignedLE -> "audio/L16" + SampleFmtMuLaw8Bit -> "audio/basic" -} r = ";rate=" ++ show (sampleFreq fmt) c | numChannels fmt == 1 = "" - | otherwise = ";channels=" ++ show (numChannels fmt) + | otherwise = ";channels=" ++ show (numChannels fmt) numChannels :: SampleFmt y => SoundFmt y -> Int numChannels = withSampleFmt Frame.numberOfChannels @@ -226,20 +227,17 @@ -- -debug :: String -> IO () -debug s = - do t <- myThreadId - IO.hPutStrLn IO.stderr $ show t ++ ": " ++ s - alsaOpen :: SampleFmt y => String -- ^ device, e.g @"default"@ - -> SoundFmt y - -> SoundBufferTime - -> PcmStream - -> IO Pcm + -> SoundFmt y + -> SoundBufferTime + -> PCM.Stream + -> IO Pcm alsaOpen dev fmt time stream = AlsaExc.rethrow $ - do debug "alsaOpen" - h <- pcm_open dev stream 0 + 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) @@ -247,20 +245,19 @@ (bufferTime time) (periodTime time) setSwParams h buffer_size period_size - pcm_prepare h - debug $ "buffer_time = " ++ show buffer_time - debug $ "buffer_size = " ++ show buffer_size - debug $ "period_time = " ++ show period_time - debug $ "period_size = " ++ show period_size - when (stream == PcmStreamPlayback) $ + 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 -> - do pcm_writei h buf period_size - return () + PCM.writei h buf period_size >> return () return h setHwParams :: Pcm - -> PcmFormat + -> PCM.Format -> Int -- ^ number of channels -> SampleFreq -- ^ sample frequency -> Time -- ^ buffer time @@ -269,16 +266,16 @@ -- ^ (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 PcmAccessRwInterleaved - 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 + 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 + 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 + 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) @@ -289,119 +286,113 @@ 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 + --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 + --PCM.sw_params_set_silence_size h p period_size + --PCM.sw_params_set_silence_threshold h p period_size -withHwParams :: Pcm -> (PcmHwParams -> IO a) -> IO a +withHwParams :: Pcm -> (PCM.HwParams -> IO a) -> IO a withHwParams h f = - do p <- pcm_hw_params_malloc - pcm_hw_params_any h p + 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 - pcm_hw_params_free p + PCM.hw_params h p return x -withSwParams :: Pcm -> (PcmSwParams -> IO a) -> IO a +withSwParams :: Pcm -> (PCM.SwParams -> IO a) -> IO a withSwParams h f = - do p <- pcm_sw_params_malloc - pcm_sw_params_current h p + 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 - pcm_sw_params_free p + PCM.sw_params h p return x alsaClose :: Pcm -> IO () alsaClose pcm = AlsaExc.rethrow $ - do debug "alsaClose" - pcm_drain pcm - pcm_close pcm + do Debug.put "alsaClose" + PCM.drain pcm + PCM.close pcm alsaStart :: Pcm -> IO () alsaStart pcm = AlsaExc.rethrow $ - do debug "alsaStart" - pcm_prepare pcm - pcm_start pcm + do Debug.put "alsaStart" + PCM.prepare pcm + PCM.start pcm --- FIXME: use pcm_drain for sinks? +-- FIXME: use PCM.drain for sinks? alsaStop :: Pcm -> IO () alsaStop pcm = AlsaExc.rethrow $ - do debug "alsaStop" - pcm_drain pcm + do Debug.put "alsaStop" + PCM.drain pcm alsaRead :: SampleFmt y => Pcm -> Ptr y -> Int -> IO Int -alsaRead h buf n = AlsaExc.rethrow $ - do --debug $ "Reading " ++ show n ++ " samples..." - n' <- pcm_readi h buf n `AlsaExc.catchXRun` handleOverRun - --debug $ "Got " ++ show n' ++ " samples." - if n' < n - then do n'' <- alsaRead h (advancePtr buf n') (n - n') - return (n' + n'') - else return n' - where handleOverRun = do debug "snd_pcm_readi reported buffer over-run" - pcm_prepare h - alsaRead h buf n +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 + alsaWrite :: SampleFmt y => Pcm -> Ptr y -> Int -> IO () alsaWrite h buf n = AlsaExc.rethrow $ - do alsaWrite_ h buf n - return () + alsaWrite_ h buf n >> return () alsaWrite_ :: SampleFmt y => Pcm -> Ptr y -> Int -> IO Int -alsaWrite_ h buf n = - do --debug $ "Writing " ++ show n ++ " samples..." - n' <- pcm_writei h buf n `AlsaExc.catchXRun` handleUnderRun - --debug $ "Wrote " ++ show n' ++ " samples." - if (n' /= n) - then do n'' <- alsaWrite_ h (advancePtr buf n') (n - n') - return (n' + n'') - else return n' - where handleUnderRun = do debug "snd_pcm_writei reported buffer under-run" - pcm_prepare h - alsaWrite_ h buf n +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 alsaSoundSource :: SampleFmt y => String -> SoundFmt y -> SoundSource y Pcm alsaSoundSource dev fmt = - (nullSoundSource fmt) { - soundSourceOpen = alsaOpen dev fmt defaultBufferTime PcmStreamCapture, - soundSourceClose = alsaClose, - soundSourceStart = alsaStart, - soundSourceStop = alsaStop, - soundSourceRead = alsaRead - } + alsaSoundSourceTime dev fmt defaultBufferTime alsaSoundSink :: SampleFmt y => String -> SoundFmt y -> SoundSink y Pcm alsaSoundSink dev fmt = - (nullSoundSink fmt) { - soundSinkOpen = alsaOpen dev fmt defaultBufferTime PcmStreamPlayback, - soundSinkClose = alsaClose, - soundSinkStart = alsaStart, - soundSinkStop = alsaStop, - soundSinkWrite = alsaWrite - } + alsaSoundSinkTime dev fmt defaultBufferTime alsaSoundSourceTime :: SampleFmt y => String -> SoundFmt y -> SoundBufferTime -> SoundSource y Pcm alsaSoundSourceTime dev fmt time = (nullSoundSource fmt) { - soundSourceOpen = alsaOpen dev fmt time PcmStreamCapture, + soundSourceOpen = alsaOpen dev fmt time PCM.StreamCapture, soundSourceClose = alsaClose, soundSourceStart = alsaStart, soundSourceStop = alsaStop, @@ -413,7 +404,7 @@ String -> SoundFmt y -> SoundBufferTime -> SoundSink y Pcm alsaSoundSinkTime dev fmt time = (nullSoundSink fmt) { - soundSinkOpen = alsaOpen dev fmt time PcmStreamPlayback, + soundSinkOpen = alsaOpen dev fmt time PCM.StreamPlayback, soundSinkClose = alsaClose, soundSinkStart = alsaStart, soundSinkStop = alsaStop, diff --git a/src/Sound/ALSA/PCM/C2HS.hs b/src/Sound/ALSA/PCM/C2HS.hs --- a/src/Sound/ALSA/PCM/C2HS.hs +++ b/src/Sound/ALSA/PCM/C2HS.hs @@ -60,7 +60,7 @@ import Foreign.Ptr (Ptr, nullPtr, castPtr, ) -import Foreign.Storable (Storable, peek, poke, ) +import Foreign.Storable (Storable, peek, ) import Foreign.Marshal.Utils (fromBool, toBool, with, ) import qualified Foreign.Storable as St @@ -94,19 +94,19 @@ -- withIntConv :: (Storable b, Integral a, Integral b) - => a -> (Ptr b -> IO c) -> IO c + => a -> (Ptr b -> IO c) -> IO c withIntConv = with . cIntConv withFloatConv :: (Storable b, RealFloat a, RealFloat b) - => a -> (Ptr b -> IO c) -> IO c + => a -> (Ptr b -> IO c) -> IO c withFloatConv = with . cFloatConv peekIntConv :: (Storable a, Integral a, Integral b) - => Ptr a -> IO b + => Ptr a -> IO b peekIntConv = liftM cIntConv . peek peekFloatConv :: (Storable a, RealFloat a, RealFloat b) - => Ptr a -> IO b + => Ptr a -> IO b peekFloatConv = liftM cFloatConv . peek -- Passing Booleans by reference @@ -138,15 +138,15 @@ alignment _ = alignment (undefined :: Ptr ()) peek p = do - ptr <- peek (castPtr p) - if ptr == nullPtr - then return Nothing - else liftM Just $ peek ptr + 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' + ptr <- case v of + Nothing -> return nullPtr + Just v' -> new v' poke (castPtr p) ptr -} @@ -184,8 +184,8 @@ -- containsBitMask :: (Bits a, Enum b) => a -> b -> Bool bits `containsBitMask` bm = let bm' = fromIntegral . fromEnum $ bm - in - bm' .&. bits == bm' + in + bm' .&. bits == bm' -- |Given a bit pattern, yield all bit masks that it contains. -- diff --git a/src/Sound/ALSA/PCM/Core.chs b/src/Sound/ALSA/PCM/Core.chs --- a/src/Sound/ALSA/PCM/Core.chs +++ b/src/Sound/ALSA/PCM/Core.chs @@ -1,11 +1,18 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.PCM.Core where -import Sound.ALSA.PCM.C2HS +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 @@ -16,7 +23,7 @@ #include -{#context prefix = "snd_"#} +{#context prefix = "snd_pcm_"#} {#pointer *snd_pcm_t as Pcm newtype #} @@ -26,64 +33,64 @@ peek p = fmap Pcm (peek (castPtr p)) poke p (Pcm r) = poke (castPtr p) r -{#pointer *snd_pcm_hw_params_t as PcmHwParams newtype #} +{#pointer *snd_pcm_hw_params_t as HwParams newtype #} -instance Storable PcmHwParams where - sizeOf (PcmHwParams r) = sizeOf r - alignment (PcmHwParams r) = alignment r - peek p = fmap PcmHwParams (peek (castPtr p)) - poke p (PcmHwParams r) = poke (castPtr p) r +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 PcmSwParams newtype #} +{#pointer *snd_pcm_sw_params_t as SwParams newtype #} -instance Storable PcmSwParams where - sizeOf (PcmSwParams r) = sizeOf r - alignment (PcmSwParams r) = alignment r - peek p = fmap PcmSwParams (peek (castPtr p)) - poke p (PcmSwParams r) = poke (castPtr p) r +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 PcmStream {underscoreToCase} deriving (Eq,Show)#} +{#enum _snd_pcm_stream as Stream {underscoreToCase} deriving (Eq,Show)#} -{#enum _snd_pcm_access as PcmAccess {underscoreToCase} deriving (Eq,Show)#} +{#enum _snd_pcm_access as Access {underscoreToCase} deriving (Eq,Show)#} -{#enum _snd_pcm_format as PcmFormat {underscoreToCase} deriving (Eq,Show)#} +{#enum _snd_pcm_format as Format {underscoreToCase} deriving (Eq,Show)#} -{#fun pcm_open +{#fun snd_pcm_open as open { alloca- `Pcm' peek*, withCString* `String', - cFromEnum `PcmStream', + cFromEnum `Stream', `Int'} -> `()' result*- #} - where result = checkResult_ "pcm_open" + where result = checkResult_ "PCM.open" -{#fun pcm_close +{#fun snd_pcm_close as close { id `Pcm' } -> `()' result*- #} - where result = checkResult_ "pcm_close" + where result = checkResult_ "PCM.close" -{#fun pcm_prepare +{#fun prepare { id `Pcm' } -> `()' result*- #} - where result = checkResult_ "pcm_prepare" + where result = checkResult_ "PCM.prepare" -{#fun pcm_start +{#fun start { id `Pcm' } -> `()' result*- #} - where result = checkResult_ "pcm_start" + where result = checkResult_ "PCM.start" -{#fun pcm_drop +{#fun drop { id `Pcm' } -> `()' result*- #} - where result = checkResult_ "pcm_drop" + where result = checkResult_ "PCM.drop" -{#fun pcm_drain +{#fun drain { id `Pcm' } -> `()' result*- #} - where result = checkResult_ "pcm_drain" + where result = checkResult_ "PCM.drain" {- -- Only available in 1.0.11rc3 and later -{#fun pcm_set_params +{#fun set_params { id `Pcm', cFromEnum `PcmFormat', cFromEnum `PcmAccess', @@ -92,205 +99,205 @@ `Bool', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_set_params" + where result = checkResult_ "PCM.set_params" -} -{#fun pcm_hw_params +{#fun hw_params { id `Pcm', - id `PcmHwParams' } + id `HwParams' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params" + where result = checkResult_ "PCM.hw_params" -{#fun pcm_hw_params_any +{#fun hw_params_any { id `Pcm', - id `PcmHwParams' } + id `HwParams' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_any" + where result = checkResult_ "PCM.hw_params_any" -{#fun pcm_hw_params_set_access +{#fun hw_params_set_access { id `Pcm', - id `PcmHwParams', - cFromEnum `PcmAccess' + id `HwParams', + cFromEnum `Access' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_access" + where result = checkResult_ "PCM.hw_params_set_access" -{#fun pcm_hw_params_set_format +{#fun hw_params_set_format { id `Pcm', - id `PcmHwParams', - cFromEnum `PcmFormat' + id `HwParams', + cFromEnum `Format' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_format" + where result = checkResult_ "PCM.hw_params_set_format" -{#fun pcm_hw_params_set_rate +{#fun hw_params_set_rate { id `Pcm', - id `PcmHwParams', + id `HwParams', `Int', orderingToInt `Ordering' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_rate" + where result = checkResult_ "PCM.hw_params_set_rate" {- -- Available in 1.0.9rc2 and later -{#fun pcm_hw_params_set_rate_resample +{#fun hw_params_set_rate_resample { id `Pcm', - id `PcmHwParams', + id `HwParams', `Bool' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_rate_resample" + where result = checkResult_ "PCM.hw_params_set_rate_resample" -} -{#fun pcm_hw_params_set_channels +{#fun hw_params_set_channels { id `Pcm', - id `PcmHwParams', + id `HwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_channels" + where result = checkResult_ "PCM.hw_params_set_channels" -{#fun pcm_hw_params_set_buffer_size +{#fun hw_params_set_buffer_size { id `Pcm', - id `PcmHwParams', + id `HwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_buffer_size" + where result = checkResult_ "PCM.hw_params_set_buffer_size" -{#fun pcm_hw_params_get_buffer_size - { id `PcmHwParams', +{#fun hw_params_get_buffer_size + { id `HwParams', alloca- `Int' peekIntConv* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_get_buffer_size" + where result = checkResult_ "PCM.hw_params_get_buffer_size" -{#fun pcm_hw_params_get_period_size - { id `PcmHwParams', +{#fun hw_params_get_period_size + { id `HwParams', alloca- `Int' peekIntConv*, alloca- `Ordering' peekOrdering* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_get_period_size" + where result = checkResult_ "PCM.hw_params_get_period_size" -{#fun pcm_hw_params_set_period_time_near +{#fun hw_params_set_period_time_near { id `Pcm', - id `PcmHwParams', + id `HwParams', withIntConv* `Int' peekIntConv*, withOrdering* `Ordering' peekOrdering* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_period_time_near" + where result = checkResult_ "PCM.hw_params_set_period_time_near" -{#fun pcm_hw_params_set_periods +{#fun hw_params_set_periods { id `Pcm', - id `PcmHwParams', + id `HwParams', `Int', orderingToInt `Ordering' } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_periods" + where result = checkResult_ "PCM.hw_params_set_periods" -{#fun pcm_hw_params_set_buffer_time_near +{#fun hw_params_set_buffer_time_near { id `Pcm', - id `PcmHwParams', + id `HwParams', withIntConv* `Int' peekIntConv*, withOrdering* `Ordering' peekOrdering* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_set_buffer_time_near" + where result = checkResult_ "PCM.hw_params_set_buffer_time_near" -{#fun pcm_hw_params_get_buffer_time - { id `PcmHwParams', +{#fun hw_params_get_buffer_time + { id `HwParams', alloca- `Int' peekIntConv*, alloca- `Ordering' peekOrdering* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_get_buffer_time" + where result = checkResult_ "PCM.hw_params_get_buffer_time" -{#fun pcm_sw_params_set_start_threshold +{#fun sw_params_set_start_threshold { id `Pcm', - id `PcmSwParams', + id `SwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_set_start_threshold" + where result = checkResult_ "PCM.sw_params_set_start_threshold" -{#fun pcm_sw_params_set_avail_min +{#fun sw_params_set_avail_min { id `Pcm', - id `PcmSwParams', + id `SwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_set_avail_min" + where result = checkResult_ "PCM.sw_params_set_avail_min" -{#fun pcm_sw_params_set_xfer_align +{#fun sw_params_set_xfer_align { id `Pcm', - id `PcmSwParams', + id `SwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_set_xfer_align" + where result = checkResult_ "PCM.sw_params_set_xfer_align" -{#fun pcm_sw_params_set_silence_threshold +{#fun sw_params_set_silence_threshold { id `Pcm', - id `PcmSwParams', + id `SwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_set_silence_threshold" + where result = checkResult_ "PCM.sw_params_set_silence_threshold" -{#fun pcm_sw_params_set_silence_size +{#fun sw_params_set_silence_size { id `Pcm', - id `PcmSwParams', + id `SwParams', `Int' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_set_silence_size" + where result = checkResult_ "PCM.sw_params_set_silence_size" -{#fun pcm_readi +{#fun readi { id `Pcm', castPtr `Ptr a', `Int' } -> `Int' result* #} - where result = fmap fromIntegral . checkResult "pcm_readi" + where result = fmap fromIntegral . checkResult "PCM.readi" -{#fun pcm_writei +{#fun writei { id `Pcm', castPtr `Ptr a', `Int' } -> `Int' result* #} - where result = fmap fromIntegral . checkResult "pcm_writei" + where result = fmap fromIntegral . checkResult "PCM.writei" -{#fun pcm_hw_params_malloc - { alloca- `PcmHwParams' peek* } +{#fun hw_params_malloc + { alloca- `HwParams' peek* } -> `()' result*- #} - where result = checkResult_ "pcm_hw_params_malloc" + where result = checkResult_ "PCM.hw_params_malloc" -{#fun pcm_hw_params_free - { id `PcmHwParams' } +{#fun hw_params_free + { id `HwParams' } -> `()' #} -{#fun pcm_sw_params_malloc - { alloca- `PcmSwParams' peek* } +{#fun sw_params_malloc + { alloca- `SwParams' peek* } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_malloc" + where result = checkResult_ "PCM.sw_params_malloc" -{#fun pcm_sw_params_free - { id `PcmSwParams' } +{#fun sw_params_free + { id `SwParams' } -> `()' #} -{#fun pcm_sw_params +{#fun sw_params { id `Pcm', - id `PcmSwParams' } + id `SwParams' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params" + where result = checkResult_ "PCM.sw_params" -{#fun pcm_sw_params_current +{#fun sw_params_current { id `Pcm', - id `PcmSwParams' } + id `SwParams' } -> `()' result*- #} - where result = checkResult_ "pcm_sw_params_current" + where result = checkResult_ "PCM.sw_params_current" -- -- * Marshalling utilities @@ -300,7 +307,7 @@ orderingToInt o = fromIntegral (fromEnum o - 1) intToOrdering :: CInt -> Ordering -intToOrdering i = toEnum (fromIntegral i + 1) +intToOrdering i = compare i 0 peekOrdering :: Ptr CInt -> IO Ordering peekOrdering = fmap intToOrdering . peek