alsa 0.2.1 → 0.3

raw patch · 2 files changed

+176/−100 lines, 2 filesdep +sample-framePVP ok

version bump matches the API change (PVP)

Dependencies added: sample-frame

API changes (from Hackage documentation)

Files

• Sound/Alsa.hs +172/−97
• alsa.cabal +4/−3

@@ -15,8 +15,6 @@      audioBytesPerFrame,      soundSourceBytesPerFrame,      soundSinkBytesPerFrame,-     soundSourceReadBytes,-     soundSinkWriteBytes,      copySound,      alsaSoundSource,      alsaSoundSink,@@ -27,29 +25,36 @@     ) where  import Sound.Alsa.Core-import Sound.Alsa.Error+import Sound.Alsa.Error (rethrowAlsaExceptions, catchXRun, ) -import Control.Concurrent-import Control.Exception (bracket, bracket_)-import Control.Monad (liftM,when)-import Foreign-import Foreign.C+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.Concurrent (myThreadId, )+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 qualified System.IO as IO import System.IO+   (IOMode(ReadMode, WriteMode), Handle, openBinaryFile, hClose, )  -- -- * Generic sound API -- -data SampleFmt = SampleFmtLinear16BitSignedLE-               | SampleFmtMuLaw8Bit-  deriving (Show)+class (Storable y, Frame.C y) => SampleFmt y where+   sampleFmtToPcmFormat :: y -> PcmFormat  type SampleFreq = Int -data SoundFmt = SoundFmt {-	sampleFmt :: SampleFmt,-	sampleFreq :: SampleFreq,- 	numChannels :: Int+data SoundFmt y = SoundFmt {+	sampleFreq :: SampleFreq 	}   deriving (Show) @@ -62,22 +67,22 @@   -- | Counts are in samples, not bytes. Multi-channel data is interleaved.-data SoundSource handle =+data SoundSource y handle =     SoundSource {-                 soundSourceFmt   :: SoundFmt,+                 soundSourceFmt   :: SoundFmt y,                  soundSourceOpen  :: IO handle,                  soundSourceClose :: handle -> IO (),                  soundSourceStart :: handle -> IO (),                  soundSourceStop  :: handle -> IO (),-                 soundSourceRead  :: handle -> Ptr () -> Int -> IO Int+                 soundSourceRead  :: handle -> Ptr y -> Int -> IO Int                 } -data SoundSink handle =+data SoundSink y handle =     SoundSink {-                 soundSinkFmt   :: SoundFmt,+                 soundSinkFmt   :: SoundFmt y,                  soundSinkOpen  :: IO handle,                  soundSinkClose :: handle -> IO (),-                 soundSinkWrite :: handle -> Ptr () -> Int -> IO (),+                 soundSinkWrite :: handle -> Ptr y -> Int -> IO (),                  soundSinkStart :: handle -> IO (),                  soundSinkStop  :: handle -> IO ()                 }@@ -93,7 +98,7 @@         periodTime = 100000  -- 0.1s     } -nullSoundSource :: SoundFmt -> SoundSource h+nullSoundSource :: SoundFmt y -> SoundSource y h nullSoundSource fmt =     SoundSource { 	         soundSourceFmt   = fmt,@@ -104,7 +109,7 @@                  soundSourceRead  = \_ _ _ -> return 0                 } -nullSoundSink :: SoundFmt -> SoundSink h+nullSoundSink :: SoundFmt y -> SoundSink y h nullSoundSink fmt =     SoundSink { 	       soundSinkFmt   = fmt,@@ -116,65 +121,101 @@               }  -withSoundSource :: SoundSource h -> (h -> IO a) -> IO a+withSoundSource :: SoundSource y h -> (h -> IO a) -> IO a withSoundSource source =     bracket (soundSourceOpen source) (soundSourceClose source) -withSoundSourceRunning :: SoundSource h -> h -> IO a -> IO a+withSoundSourceRunning :: SoundSource y h -> h -> IO a -> IO a withSoundSourceRunning src h = bracket_ (soundSourceStart src h) (soundSourceStop src h) -withSoundSink :: SoundSink h -> (h -> IO a) -> IO a+withSoundSink :: SoundSink y h -> (h -> IO a) -> IO a withSoundSink sink =     bracket (soundSinkOpen sink) (soundSinkClose sink) -withSoundSinkRunning :: SoundSink h -> h -> IO a -> IO a+withSoundSinkRunning :: SoundSink y h -> h -> IO a -> IO a withSoundSinkRunning src h = bracket_ (soundSinkStart src h) (soundSinkStop src h) -soundFmtMIME :: SoundFmt -> String++instance SampleFmt Word8 where+   sampleFmtToPcmFormat _ = PcmFormatU8++instance SampleFmt Int8 where+   sampleFmtToPcmFormat _ = PcmFormatS8++instance SampleFmt Word16 where+   sampleFmtToPcmFormat _ = PcmFormatU16++instance SampleFmt Int16 where+   sampleFmtToPcmFormat _ = PcmFormatS16++instance SampleFmt Word32 where+   sampleFmtToPcmFormat _ = PcmFormatU32++instance SampleFmt Int32 where+   sampleFmtToPcmFormat _ = PcmFormatS32++instance SampleFmt Float where+   sampleFmtToPcmFormat _ = PcmFormatFloat++instance SampleFmt Double where+   sampleFmtToPcmFormat _ = PcmFormatFloat64++instance SampleFmt MuLaw.T where+   sampleFmtToPcmFormat _ = PcmFormatMuLaw++instance SampleFmt a => SampleFmt (Stereo.T a) where+   sampleFmtToPcmFormat y =+      sampleFmtToPcmFormat (Stereo.left y)++withSampleFmt :: (y -> a) -> (SoundFmt y -> a)+withSampleFmt f _ = f undefined+++soundFmtMIME :: SampleFmt y => SoundFmt y -> String soundFmtMIME fmt = t ++ r ++ c-  where t = case sampleFmt fmt of+  where t = "audio/basic"+{-+        t = case sampleFmt fmt of 		SampleFmtLinear16BitSignedLE -> "audio/L16" 		SampleFmtMuLaw8Bit           -> "audio/basic"+-}         r = ";rate=" ++ show (sampleFreq fmt)         c | numChannels fmt == 1 = "" 	  | otherwise = ";channels=" ++ show (numChannels fmt) -audioBytesPerSample :: SoundFmt -> Int-audioBytesPerSample fmt =-	case sampleFmt fmt of-		SampleFmtLinear16BitSignedLE -> 2-		SampleFmtMuLaw8Bit           -> 1+numChannels :: SampleFmt y => SoundFmt y -> Int+numChannels = withSampleFmt Frame.numberOfChannels --- assumes interleaved data-audioBytesPerFrame :: SoundFmt -> Int+audioBytesPerSample :: SampleFmt y => SoundFmt y -> Int+audioBytesPerSample = withSampleFmt Frame.sizeOfElement++{-+assumes interleaved data++Due to alignment constraints+a frame might occupy more than the calculated size+in an array in memory.+-}+audioBytesPerFrame :: SampleFmt y => SoundFmt y -> Int audioBytesPerFrame fmt = numChannels fmt * audioBytesPerSample fmt -soundSourceBytesPerFrame :: SoundSource h -> Int+soundSourceBytesPerFrame :: SampleFmt y => SoundSource y h -> Int soundSourceBytesPerFrame = audioBytesPerFrame . soundSourceFmt -soundSinkBytesPerFrame :: SoundSink h -> Int+soundSinkBytesPerFrame :: SampleFmt y => SoundSink y h -> Int soundSinkBytesPerFrame = audioBytesPerFrame . soundSinkFmt -soundSourceReadBytes :: SoundSource h -> h -> Ptr () -> Int -> IO Int-soundSourceReadBytes src h buf n =-	liftM (* c) $ soundSourceRead src h buf (n `div` c)-  where c = soundSourceBytesPerFrame src--soundSinkWriteBytes :: SoundSink h -> h -> Ptr () -> Int -> IO ()-soundSinkWriteBytes dst h buf n =-	soundSinkWrite dst h buf (n `div` c)-  where c = soundSinkBytesPerFrame dst--copySound :: SoundSource h1-          -> SoundSink h2-          -> Int -- ^ Buffer size (in bytes) to use+copySound :: SampleFmt y =>+             SoundSource y h1+          -> SoundSink y h2+          -> Int -- ^ Buffer size (in sample frames) to use           -> IO () copySound source sink bufSize =-    allocaBytes     bufSize $ \buf ->+    allocaArray     bufSize $ \buf ->     withSoundSource source  $ \from ->     withSoundSink   sink    $ \to ->-       let loop = do n <- soundSourceReadBytes source from buf bufSize-                     when (n > 0) $ do soundSinkWriteBytes sink to buf n+       let loop = do n <- soundSourceRead source from buf bufSize+                     when (n > 0) $ do soundSinkWrite sink to buf n                                        loop         in loop @@ -186,10 +227,11 @@ debug :: String -> IO () debug s =     do t <- myThreadId-       hPutStrLn stderr $ show t ++ ": " ++ s+       IO.hPutStrLn IO.stderr $ show t ++ ": " ++ s -alsaOpen :: String -- ^ device, e.g @"default"@-	-> SoundFmt+alsaOpen :: SampleFmt y =>+           String -- ^ device, e.g @"default"@+	-> SoundFmt y 	-> SoundBufferTime 	-> PcmStream 	-> IO Pcm@@ -197,7 +239,7 @@     do debug "alsaOpen"        h <- pcm_open dev stream 0        (buffer_time,buffer_size,period_time,period_size) <--           setHwParams h (sampleFmtToPcmFormat (sampleFmt fmt))+           setHwParams h (withSampleFmt sampleFmtToPcmFormat fmt)                          (numChannels fmt)                          (sampleFreq fmt)                          (bufferTime time)@@ -209,14 +251,11 @@        debug $ "period_time = " ++ show period_time        debug $ "period_size = " ++ show period_size        when (stream == PcmStreamPlayback) $-         callocaBytes (audioBytesPerFrame fmt * period_size) $ \buf ->+         callocaArray fmt period_size $ \buf -> 	   do pcm_writei h buf period_size               return ()        return h -sampleFmtToPcmFormat :: SampleFmt -> PcmFormat-sampleFmtToPcmFormat SampleFmtLinear16BitSignedLE = PcmFormatS16Le-sampleFmtToPcmFormat SampleFmtMuLaw8Bit           = PcmFormatMuLaw  setHwParams :: Pcm             -> PcmFormat@@ -293,116 +332,152 @@     do debug "alsaStop"        pcm_drain pcm -alsaRead :: SoundFmt -> Pcm -> Ptr () -> Int -> IO Int-alsaRead fmt h buf n = rethrowAlsaExceptions $+alsaRead ::+   SampleFmt y =>+   Pcm -> Ptr y -> Int -> IO Int+alsaRead h buf n = rethrowAlsaExceptions $      do --debug $ "Reading " ++ show n ++ " samples..."         n' <- pcm_readi h buf n `catchXRun` handleOverRun         --debug $ "Got " ++ show n' ++ " samples." 	if n' < n-          then do n'' <- alsaRead fmt h (buf `plusPtr` (n' * c)) (n - n')+          then do n'' <- alsaRead h (advancePtr buf n') (n - n') 	          return (n' + n'')           else return n'-  where c = audioBytesPerFrame fmt-        handleOverRun = do debug "snd_pcm_readi reported buffer over-run"+  where handleOverRun = do debug "snd_pcm_readi reported buffer over-run"                            pcm_prepare h-                           alsaRead fmt h buf n+                           alsaRead h buf n -alsaWrite :: SoundFmt -> Pcm -> Ptr () -> Int -> IO ()-alsaWrite fmt h buf n = rethrowAlsaExceptions $-    do alsaWrite_ fmt h buf n+alsaWrite ::+   SampleFmt y =>+   Pcm -> Ptr y -> Int -> IO ()+alsaWrite h buf n = rethrowAlsaExceptions $+    do alsaWrite_ h buf n        return () -alsaWrite_ :: SoundFmt -> Pcm -> Ptr () -> Int -> IO Int-alsaWrite_ fmt h buf n =+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 `catchXRun` handleUnderRun         --debug $ "Wrote " ++ show n' ++ " samples." 	if (n' /= n)-            then do n'' <- alsaWrite_ fmt h (buf `plusPtr` (n' * c)) (n - n')+            then do n'' <- alsaWrite_ h (advancePtr buf n') (n - n')                     return (n' + n'')             else return n'-  where c = audioBytesPerFrame fmt-        handleUnderRun = do debug "snd_pcm_writei reported buffer under-run"+  where handleUnderRun = do debug "snd_pcm_writei reported buffer under-run"                             pcm_prepare h-                            alsaWrite_ fmt h buf n+                            alsaWrite_ h buf n  -alsaSoundSource :: String -> SoundFmt -> SoundSource Pcm+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 fmt+        soundSourceRead  = alsaRead     } -alsaSoundSink :: String -> SoundFmt -> SoundSink Pcm+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 fmt+        soundSinkWrite = alsaWrite     } -alsaSoundSourceTime :: String -> SoundFmt -> SoundBufferTime -> SoundSource Pcm+alsaSoundSourceTime ::+   SampleFmt y =>+   String -> SoundFmt y -> SoundBufferTime -> SoundSource y Pcm alsaSoundSourceTime dev fmt time =     (nullSoundSource fmt) {         soundSourceOpen  = alsaOpen dev fmt time PcmStreamCapture,         soundSourceClose = alsaClose,         soundSourceStart = alsaStart,         soundSourceStop  = alsaStop,-        soundSourceRead  = alsaRead fmt+        soundSourceRead  = alsaRead     } -alsaSoundSinkTime :: String -> SoundFmt -> SoundBufferTime -> SoundSink Pcm+alsaSoundSinkTime ::+   SampleFmt y =>+   String -> SoundFmt y -> SoundBufferTime -> SoundSink y Pcm alsaSoundSinkTime dev fmt time =     (nullSoundSink fmt) {         soundSinkOpen  = alsaOpen dev fmt time PcmStreamPlayback,         soundSinkClose = alsaClose,         soundSinkStart = alsaStart,         soundSinkStop  = alsaStop,-        soundSinkWrite = alsaWrite fmt+        soundSinkWrite = alsaWrite     }  -- -- * File stuff -- -fileRead :: SoundFmt -> Handle -> Ptr () -> Int -> IO Int-fileRead fmt h buf n = liftM (`div` c) $ hGetBuf h buf (n * c)-  where c = audioBytesPerSample fmt+{- |+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) -fileWrite :: SoundFmt -> Handle -> Ptr () -> Int -> IO ()-fileWrite fmt h buf n = hPutBuf h buf (n * c)-  where c = audioBytesPerSample fmt+{- |+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 :: FilePath -> SoundFmt -> SoundSource Handle+fileSoundSource ::+   SampleFmt y =>+   FilePath -> SoundFmt y -> SoundSource y Handle fileSoundSource file fmt =     (nullSoundSource fmt) {                            soundSourceOpen  = openBinaryFile file ReadMode,                            soundSourceClose = hClose,-                           soundSourceRead  = fileRead fmt+                           soundSourceRead  = fileRead                           } -fileSoundSink :: FilePath -> SoundFmt -> SoundSink Handle+fileSoundSink ::+   SampleFmt y =>+   FilePath -> SoundFmt y -> SoundSink y Handle fileSoundSink file fmt =     (nullSoundSink fmt) {                          soundSinkOpen  = openBinaryFile file WriteMode,                          soundSinkClose = hClose,-                         soundSinkWrite = fileWrite fmt+                         soundSinkWrite = fileWrite                         }  -- -- * Marshalling utilities -- -callocaBytes :: Int -> (Ptr a -> IO b) -> IO b-callocaBytes n f = allocaBytes n (\p -> clearBytes p n >> f p)+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  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)

@@ -1,5 +1,5 @@ Name: alsa-Version: 0.2.1+Version: 0.3 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>@@ -8,8 +8,9 @@ License-file: LICENSE Homepage: http://www.haskell.org/haskellwiki/ALSA Build-depends:-  base >= 3 && <4,-  array >= 0.1 && <0.3+  sample-frame >=0.0.1 && <0.1,+  array >= 0.1 && <0.3,+  base >= 3 && <4 Stability: Experimental Extensions: ForeignFunctionInterface, GeneralizedNewtypeDeriving, EmptyDataDecls Build-Type: Simple