diff --git a/Sound/Alsa.hs b/Sound/Alsa.hs --- a/Sound/Alsa.hs +++ b/Sound/Alsa.hs @@ -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) diff --git a/alsa.cabal b/alsa.cabal --- a/alsa.cabal +++ b/alsa.cabal @@ -1,5 +1,5 @@ Name: alsa -Version: 0.2.1 +Version: 0.3 Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann Maintainer: Henning Thielemann Author: Bjorn Bringert , Iavor S. Diatchki @@ -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