diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,3 +1,4 @@ +Copyright (c) 2009 Henning Thielemann Copyright (c) 2006 Bjorn Bringert Copyright (c) 2006 Iavor S. Diatchki diff --git a/Sound/Alsa.hs b/Sound/Alsa.hs --- a/Sound/Alsa.hs +++ b/Sound/Alsa.hs @@ -1,9 +1,11 @@ module Sound.Alsa (SampleFmt(..), SampleFreq, + Time, SoundFmt(..), SoundSource(..), SoundSink(..), + SoundBufferTime(..), withSoundSource, withSoundSourceRunning, withSoundSink, @@ -18,8 +20,10 @@ copySound, alsaSoundSource, alsaSoundSink, + alsaSoundSourceTime, + alsaSoundSinkTime, fileSoundSource, - fileSoundSink + fileSoundSink, ) where import Sound.Alsa.Core @@ -49,7 +53,14 @@ } deriving (Show) +type Time = Int +data SoundBufferTime = SoundBufferTime { + bufferTime, periodTime :: Time + } + deriving (Show) + + -- | Counts are in samples, not bytes. Multi-channel data is interleaved. data SoundSource handle = SoundSource { @@ -75,6 +86,13 @@ -- -- +defaultBufferTime :: SoundBufferTime +defaultBufferTime = + SoundBufferTime { + bufferTime = 500000, -- 0.5s + periodTime = 100000 -- 0.1s + } + nullSoundSource :: SoundFmt -> SoundSource h nullSoundSource fmt = SoundSource { @@ -143,9 +161,9 @@ where c = soundSourceBytesPerFrame src soundSinkWriteBytes :: SoundSink h -> h -> Ptr () -> Int -> IO () -soundSinkWriteBytes src h buf n = - soundSinkWrite src h buf (n `div` c) - where c = soundSinkBytesPerFrame src +soundSinkWriteBytes dst h buf n = + soundSinkWrite dst h buf (n `div` c) + where c = soundSinkBytesPerFrame dst copySound :: SoundSource h1 -> SoundSink h2 @@ -165,23 +183,25 @@ -- +debug :: String -> IO () debug s = do t <- myThreadId hPutStrLn stderr $ show t ++ ": " ++ s alsaOpen :: String -- ^ device, e.g @"default"@ - -> SoundFmt -> PcmStream -> IO Pcm -alsaOpen dev fmt stream = rethrowAlsaExceptions $ + -> SoundFmt + -> SoundBufferTime + -> PcmStream + -> IO Pcm +alsaOpen dev fmt time stream = rethrowAlsaExceptions $ do debug "alsaOpen" h <- pcm_open dev stream 0 - let buffer_time = 500000 -- 0.5s - period_time = 100000 -- 0.1s (buffer_time,buffer_size,period_time,period_size) <- setHwParams h (sampleFmtToPcmFormat (sampleFmt fmt)) (numChannels fmt) (sampleFreq fmt) - buffer_time - period_time + (bufferTime time) + (periodTime time) setSwParams h buffer_size period_size pcm_prepare h debug $ "buffer_time = " ++ show buffer_time @@ -201,9 +221,9 @@ setHwParams :: Pcm -> PcmFormat -> Int -- ^ number of channels - -> Int -- ^ sample frequency - -> Int -- ^ buffer time - -> Int -- ^ period time + -> SampleFreq -- ^ sample frequency + -> Time -- ^ buffer time + -> Time -- ^ period time -> IO (Int,Int,Int,Int) -- ^ (buffer_time,buffer_size,period_time,period_size) setHwParams h format channels rate buffer_time period_time @@ -212,21 +232,22 @@ 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 - (buffer_time,_) <- + (actual_buffer_time,_) <- pcm_hw_params_set_buffer_time_near h p buffer_time EQ buffer_size <- pcm_hw_params_get_buffer_size p - (period_time,_) <- + (actual_period_time,_) <- pcm_hw_params_set_period_time_near h p period_time EQ (period_size,_) <- pcm_hw_params_get_period_size p - return (buffer_time,buffer_size,period_time,period_size) + return (actual_buffer_time,buffer_size, + actual_period_time,period_size) setSwParams :: Pcm -> Int -- ^ buffer size -> Int -- ^ period size -> IO () -setSwParams h buffer_size period_size = withSwParams h $ \p -> - do let start_threshold = - (buffer_size `div` period_size) * period_size +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 @@ -309,22 +330,42 @@ alsaSoundSource :: String -> SoundFmt -> SoundSource Pcm alsaSoundSource dev fmt = (nullSoundSource fmt) { - soundSourceOpen = alsaOpen dev fmt PcmStreamCapture, - soundSourceClose = alsaClose, - soundSourceStart = alsaStart, - soundSourceStop = alsaStop, - soundSourceRead = alsaRead fmt - } + soundSourceOpen = alsaOpen dev fmt defaultBufferTime PcmStreamCapture, + soundSourceClose = alsaClose, + soundSourceStart = alsaStart, + soundSourceStop = alsaStop, + soundSourceRead = alsaRead fmt + } alsaSoundSink :: String -> SoundFmt -> SoundSink Pcm alsaSoundSink dev fmt = (nullSoundSink fmt) { - soundSinkOpen = alsaOpen dev fmt PcmStreamPlayback, - soundSinkClose = alsaClose, - soundSinkStart = alsaStart, - soundSinkStop = alsaStop, - soundSinkWrite = alsaWrite fmt - } + soundSinkOpen = alsaOpen dev fmt defaultBufferTime PcmStreamPlayback, + soundSinkClose = alsaClose, + soundSinkStart = alsaStart, + soundSinkStop = alsaStop, + soundSinkWrite = alsaWrite fmt + } + +alsaSoundSourceTime :: String -> SoundFmt -> SoundBufferTime -> SoundSource Pcm +alsaSoundSourceTime dev fmt time = + (nullSoundSource fmt) { + soundSourceOpen = alsaOpen dev fmt time PcmStreamCapture, + soundSourceClose = alsaClose, + soundSourceStart = alsaStart, + soundSourceStop = alsaStop, + soundSourceRead = alsaRead fmt + } + +alsaSoundSinkTime :: String -> SoundFmt -> SoundBufferTime -> SoundSink Pcm +alsaSoundSinkTime dev fmt time = + (nullSoundSink fmt) { + soundSinkOpen = alsaOpen dev fmt time PcmStreamPlayback, + soundSinkClose = alsaClose, + soundSinkStart = alsaStart, + soundSinkStop = alsaStop, + soundSinkWrite = alsaWrite fmt + } -- -- * File stuff diff --git a/Sound/Alsa/Sequencer/Client.hs b/Sound/Alsa/Sequencer/Client.hs --- a/Sound/Alsa/Sequencer/Client.hs +++ b/Sound/Alsa/Sequencer/Client.hs @@ -108,7 +108,7 @@ query_first_client h = do x <- client_info_malloc with_client_info x (`snd_seq_client_info_set_client` (-1)) - b <- query_next_client h x + _b <- query_next_client h x -- XXX: check that we did get the first client (should be System) return x diff --git a/alsa.cabal b/alsa.cabal --- a/alsa.cabal +++ b/alsa.cabal @@ -1,13 +1,14 @@ Name: alsa -Version: 0.2 -Copyright: Bjorn Bringert, Iavor S. Diatchki -Maintainer: bjorn@bringert.net, iavor.diatchki@gmail.com -Author: Bjorn Bringert, Iavor S. Diatchki +Version: 0.2.1 +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 +License-file: LICENSE +Homepage: http://www.haskell.org/haskellwiki/ALSA Build-depends: - base >= 3, + base >= 3 && <4, array >= 0.1 && <0.3 Stability: Experimental Extensions: ForeignFunctionInterface, GeneralizedNewtypeDeriving, EmptyDataDecls