alsa-pcm 0.5 → 0.5.0.1
raw patch · 9 files changed
+735/−273 lines, 9 filesdep +alsa-seqdep +storablevectornew-component:exe:alsa-minisynthPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: alsa-seq, storablevector
API changes (from Hackage documentation)
- Sound.ALSA.PCM: sampleFmtToPcmFormat :: SampleFmt y => y -> PcmFormat
+ Sound.ALSA.PCM: sampleFmtToPcmFormat :: SampleFmt y => y -> Format
Files
- alsa-pcm.cabal +54/−20
- debug/Sound/ALSA/PCM/Debug.hs +9/−0
- examples/duplex.hs +2/−3
- examples/play.hs +8/−10
- examples/synth.hs +420/−0
- nodebug/Sound/ALSA/PCM/Debug.hs +4/−0
- src/Sound/ALSA/PCM.hs +105/−114
- src/Sound/ALSA/PCM/C2HS.hs +14/−14
- src/Sound/ALSA/PCM/Core.chs +119/−112
alsa-pcm.cabal view
@@ -1,14 +1,14 @@-Name: alsa-pcm-Version: 0.5-Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann-Maintainer: Henning Thielemann <alsa@henning-thielemann.de>-Author: Bjorn Bringert <bjorn@bringert.net>, Iavor S. Diatchki <iavor.diatchki@gmail.com>-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 <alsa@henning-thielemann.de>+Author: Henning Thielemann <alsa@henning-thielemann.de>, Bjorn Bringert <bjorn@bringert.net>, Iavor S. Diatchki <iavor.diatchki@gmail.com>+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
+ debug/Sound/ALSA/PCM/Debug.hs view
@@ -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
examples/duplex.hs view
@@ -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 ()
examples/play.hs view
@@ -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 <file.pcm>"- 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
+ examples/synth.hs view
@@ -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)
+ nodebug/Sound/ALSA/PCM/Debug.hs view
@@ -0,0 +1,4 @@+module Sound.ALSA.PCM.Debug where++put :: String -> IO ()+put _ = return ()
src/Sound/ALSA/PCM.hs view
@@ -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,
src/Sound/ALSA/PCM/C2HS.hs view
@@ -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. --
src/Sound/ALSA/PCM/Core.chs view
@@ -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 <alsa/asoundlib.h> -{#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