{-# LANGUAGE ForeignFunctionInterface #-} module Sound.ALSA.PCM.Core where 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 -- defined on 32-bit machines, AFAICT #if __WORDSIZE == 32 typedef unsigned long long int u_int64_t; #endif #include {#context prefix = "snd_pcm_"#} {#pointer *snd_pcm_t as Pcm newtype #} instance Storable Pcm where sizeOf (Pcm r) = sizeOf r alignment (Pcm r) = alignment r peek p = fmap Pcm (peek (castPtr p)) poke p (Pcm r) = poke (castPtr p) r {#pointer *snd_pcm_hw_params_t as HwParams newtype #} 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 SwParams newtype #} 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 Stream {underscoreToCase} deriving (Eq,Show)#} {#enum _snd_pcm_access as Access {underscoreToCase} deriving (Eq,Show)#} {#enum _snd_pcm_format as Format {underscoreToCase} deriving (Eq,Show)#} {#fun snd_pcm_open as open { alloca- `Pcm' peek*, withCString* `String', cFromEnum `Stream', `Int'} -> `()' result*- #} where result = checkResult_ "PCM.open" {#fun snd_pcm_close as close { id `Pcm' } -> `()' result*- #} where result = checkResult_ "PCM.close" {#fun prepare { id `Pcm' } -> `()' result*- #} where result = checkResult_ "PCM.prepare" {#fun start { id `Pcm' } -> `()' result*- #} where result = checkResult_ "PCM.start" {#fun drop { id `Pcm' } -> `()' result*- #} where result = checkResult_ "PCM.drop" {#fun drain { id `Pcm' } -> `()' result*- #} where result = checkResult_ "PCM.drain" {- -- Only available in 1.0.11rc3 and later {#fun set_params { id `Pcm', cFromEnum `PcmFormat', cFromEnum `PcmAccess', `Int', `Int', `Bool', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.set_params" -} {#fun hw_params { id `Pcm', id `HwParams' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params" {#fun hw_params_any { id `Pcm', id `HwParams' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_any" {#fun hw_params_set_access { id `Pcm', id `HwParams', cFromEnum `Access' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_access" {#fun hw_params_set_format { id `Pcm', id `HwParams', cFromEnum `Format' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_format" {#fun hw_params_set_rate { id `Pcm', id `HwParams', `Int', orderingToInt `Ordering' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_rate" {- -- Available in 1.0.9rc2 and later {#fun hw_params_set_rate_resample { id `Pcm', id `HwParams', `Bool' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_rate_resample" -} {#fun hw_params_set_channels { id `Pcm', id `HwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_channels" {#fun hw_params_set_buffer_size { id `Pcm', id `HwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_buffer_size" {#fun hw_params_get_buffer_size { id `HwParams', alloca- `Int' peekIntConv* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_get_buffer_size" {#fun hw_params_get_period_size { id `HwParams', alloca- `Int' peekIntConv*, alloca- `Ordering' peekOrdering* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_get_period_size" {#fun hw_params_set_period_time_near { id `Pcm', id `HwParams', withIntConv* `Int' peekIntConv*, withOrdering* `Ordering' peekOrdering* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_period_time_near" {#fun hw_params_set_periods { id `Pcm', id `HwParams', `Int', orderingToInt `Ordering' } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_periods" {#fun hw_params_set_buffer_time_near { id `Pcm', id `HwParams', withIntConv* `Int' peekIntConv*, withOrdering* `Ordering' peekOrdering* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_set_buffer_time_near" {#fun hw_params_get_buffer_time { id `HwParams', alloca- `Int' peekIntConv*, alloca- `Ordering' peekOrdering* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_get_buffer_time" {#fun sw_params_set_start_threshold { id `Pcm', id `SwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_set_start_threshold" {#fun sw_params_set_avail_min { id `Pcm', id `SwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_set_avail_min" {#fun sw_params_set_xfer_align { id `Pcm', id `SwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_set_xfer_align" {#fun sw_params_set_silence_threshold { id `Pcm', id `SwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_set_silence_threshold" {#fun sw_params_set_silence_size { id `Pcm', id `SwParams', `Int' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_set_silence_size" {#fun readi { id `Pcm', castPtr `Ptr a', `Int' } -> `Int' result* #} where result = fmap fromIntegral . checkResult "PCM.readi" {#fun writei { id `Pcm', castPtr `Ptr a', `Int' } -> `Int' result* #} where result = fmap fromIntegral . checkResult "PCM.writei" {#fun hw_params_malloc { alloca- `HwParams' peek* } -> `()' result*- #} where result = checkResult_ "PCM.hw_params_malloc" {#fun hw_params_free { id `HwParams' } -> `()' #} {#fun sw_params_malloc { alloca- `SwParams' peek* } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_malloc" {#fun sw_params_free { id `SwParams' } -> `()' #} {#fun sw_params { id `Pcm', id `SwParams' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params" {#fun sw_params_current { id `Pcm', id `SwParams' } -> `()' result*- #} where result = checkResult_ "PCM.sw_params_current" -- -- * Marshalling utilities -- orderingToInt :: Ordering -> CInt orderingToInt o = fromIntegral (fromEnum o - 1) intToOrdering :: CInt -> Ordering intToOrdering i = compare i 0 peekOrdering :: Ptr CInt -> IO Ordering peekOrdering = fmap intToOrdering . peek withOrdering :: Ordering -> (Ptr CInt -> IO a) -> IO a withOrdering o = with (orderingToInt o)