diff --git a/Sound/ALSA/Mixer/Internal.chs b/Sound/ALSA/Mixer/Internal.chs new file mode 100644 --- /dev/null +++ b/Sound/ALSA/Mixer/Internal.chs @@ -0,0 +1,470 @@ +{-# LANGUAGE CPP, ForeignFunctionInterface #-} +module Sound.ALSA.Mixer.Internal + ( Mixer() + , SimpleElement() + , SimpleElementId() + , Channel(..) + , allChannels + , elements + , getMixerByName + , isPlaybackMono + , isCaptureMono + , hasPlaybackChannel + , hasCaptureChannel + , hasCommonVolume + , hasPlaybackVolume + , hasPlaybackVolumeJoined + , hasCaptureVolume + , hasCaptureVolumeJoined + , hasCommonSwitch + , hasPlaybackSwitch + , hasPlaybackSwitchJoined + , hasCaptureSwitch + , hasCaptureSwitchJoined + , getPlaybackVolume + , getCaptureVolume + , getPlaybackDb + , getCaptureDb + , getPlaybackSwitch + , getCaptureSwitch + , setPlaybackVolume + , setCaptureVolume + , setPlaybackDb + , setCaptureDb + , setPlaybackVolumeAll + , setCaptureVolumeAll + , setPlaybackDbAll + , setCaptureDbAll + , setPlaybackSwitch + , setCaptureSwitch + , setPlaybackSwitchAll + , setCaptureSwitchAll + , getPlaybackVolumeRange + , getPlaybackDbRange + , getCaptureVolumeRange + , getCaptureDbRange + , setPlaybackVolumeRange + , setCaptureVolumeRange + , getName + , getIndex + ) where + +import Foreign +import Foreign.C.Error ( eNOENT ) +import Foreign.C.String +import Foreign.C.Types +import Sound.ALSA.Exception ( checkResult_, throw ) + +#include "alsa/asoundlib.h" +{#context lib = "asoundlib" #} + +{#pointer *snd_mixer_t as Mixer foreign#} +{#pointer *snd_mixer_elem_t as Element#} +{#pointer *snd_mixer_selem_id_t as SimpleElementId foreign#} +type SimpleElement = (Mixer, Element) + +{#enum snd_mixer_selem_channel_id_t as Channel + { SND_MIXER_SCHN_UNKNOWN as Unknown + , SND_MIXER_SCHN_FRONT_LEFT as FrontLeft + , SND_MIXER_SCHN_FRONT_RIGHT as FrontRight + , SND_MIXER_SCHN_REAR_LEFT as RearLeft + , SND_MIXER_SCHN_REAR_RIGHT as RearRight + , SND_MIXER_SCHN_FRONT_CENTER as FrontCenter + , SND_MIXER_SCHN_WOOFER as Woofer + , SND_MIXER_SCHN_SIDE_LEFT as SideLeft + , SND_MIXER_SCHN_SIDE_RIGHT as SideRight + , SND_MIXER_SCHN_REAR_CENTER as RearCenter + , SND_MIXER_SCHN_LAST as Last + } deriving (Eq, Read, Show) #} + +allChannels :: [Channel] +allChannels = map toEnum $ enumFromTo (fromEnum FrontLeft) (fromEnum RearCenter) + +----------------------------------------------------------------------- +-- open +-- -------------------------------------------------------------------- + +{#fun snd_mixer_open as open + { mallocMixer- `Mixer' peekMixer* + , modeZero- `Int' fromIntegral- } -> `Int' checkOpen*- #} + +mallocMixer f = do + pm <- malloc + f pm + +modeZero f = f $ fromIntegral 0 +checkOpen = checkResult_ "snd_mixer_open" +peekMixer pm = peek pm >>= newForeignPtr snd_mixer_close + +-- Static address import for finalizer. Suppression of the return type may +-- not be a good idea, but the workaround involves lots of C. +foreign import ccall "alsa/asoundlib.h &snd_mixer_close" + snd_mixer_close :: FunPtr (Ptr () -> IO ()) + +----------------------------------------------------------------------- +-- attach +-- -------------------------------------------------------------------- + +{#fun snd_mixer_attach as attach + { withForeignPtr* `Mixer', `String' } -> `Int' checkAttach*- #} + +checkAttach = checkResult_ "snd_mixer_attach" + +----------------------------------------------------------------------- +-- load +-- -------------------------------------------------------------------- + +{#fun snd_mixer_load as ^ + { withForeignPtr* `Mixer' } -> `Int' checkSndMixerLoad*- #} + +checkSndMixerLoad = checkResult_ "snd_mixer_load" + +{#fun snd_mixer_selem_register as ^ + { withForeignPtr* `Mixer' + , id `Ptr ()' + , id `Ptr (Ptr ())' } -> `Int' checkSndMixerSelemRegister*- #} + +checkSndMixerSelemRegister = checkResult_ "snd_mixer_selem_register" + +load :: Mixer -> IO () +load fmix = do + sndMixerSelemRegister fmix nullPtr nullPtr + sndMixerLoad fmix + +----------------------------------------------------------------------- +-- getId +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_id_malloc as ^ + { alloca- `SimpleElementId' peekSimpleElementId* } -> `()' #} + +{#fun snd_mixer_selem_get_id as ^ + { id `Element', withForeignPtr* `SimpleElementId' } -> `()' #} + +peekSimpleElementId pid = peek pid >>= newForeignPtr snd_mixer_selem_id_free + +foreign import ccall "alsa/asoundlib.h &snd_mixer_selem_id_free" + snd_mixer_selem_id_free :: FunPtr (Ptr () -> IO ()) + +getId :: Element -> IO SimpleElementId +getId e = do + newSid <- sndMixerSelemIdMalloc + sndMixerSelemGetId e newSid + return newSid + +----------------------------------------------------------------------- +-- elements +-- -------------------------------------------------------------------- + +{#fun snd_mixer_first_elem as ^ + { withForeignPtr* `Mixer' } -> `Element' id #} + +{#fun snd_mixer_last_elem as ^ + { withForeignPtr* `Mixer' } -> `Element' id #} + +{#fun snd_mixer_elem_next as ^ + { id `Element' } -> `Element' id #} + +elements :: Mixer -> IO [(SimpleElementId, SimpleElement)] +elements fMix = do + pFirst <- sndMixerFirstElem fMix + pLast <- sndMixerLastElem fMix + es <- elements' pFirst [] pLast + mapM (simpleElement fMix) es + where elements' pThis xs pLast | pThis == pLast = return $ pThis : xs + | otherwise = do + pNext <- sndMixerElemNext pThis + elements' pNext (pThis : xs) pLast + +----------------------------------------------------------------------- +-- simpleElement +-- -------------------------------------------------------------------- + +{#fun snd_mixer_find_selem as ^ + { withForeignPtr* `Mixer' + , withForeignPtr* `SimpleElementId' } -> `Element' id #} + +simpleElement :: Mixer -> Element -> IO (SimpleElementId, SimpleElement) +simpleElement fMix pElem = do + fId <- getId pElem + pSElem <- sndMixerFindSelem fMix fId + if pSElem == nullPtr + then throw "snd_mixer_find_selem" eNOENT + else return (fId, (fMix, pSElem)) + +----------------------------------------------------------------------- +-- getName +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_id_get_name as getName + { withForeignPtr* `SimpleElementId' } -> `String' #} + +----------------------------------------------------------------------- +-- getIndex +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_id_get_index as getIndex + { withForeignPtr* `SimpleElementId' } -> `Integer' fromIntegral #} + +----------------------------------------------------------------------- +-- getMixerByName +-- -------------------------------------------------------------------- + +-- | Returns the named 'Mixer'. Will throw an exception if the named mixer +-- cannot be found. A mixer named \"default\" should always exist. +getMixerByName :: String -> IO Mixer +getMixerByName name = do + mix <- open + attach mix name + load mix + return mix + +----------------------------------------------------------------------- +-- utilities +-- -------------------------------------------------------------------- + +cToBool = toBool + +cFromBool = fromBool + +withSimpleElement :: SimpleElement -> (Element -> IO a) -> IO a +withSimpleElement (m, s) f = do + r <- f s + touchForeignPtr m + return r + +channelToC = toEnum . fromEnum + +cToIntegral = (>>= return . fromIntegral) . peek + +cFromIntegral :: Integer -> (Ptr CLong -> IO a) -> IO a +cFromIntegral = with . fromIntegral + +negOne f = f $! negate 1 + +----------------------------------------------------------------------- +-- has +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_is_playback_mono as isPlaybackMono + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_is_capture_mono as isCaptureMono + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_common_volume as hasCommonVolume + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_playback_volume as hasPlaybackVolume + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_playback_volume_joined as hasPlaybackVolumeJoined + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_capture_volume as hasCaptureVolume + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_capture_volume_joined as hasCaptureVolumeJoined + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_common_switch as hasCommonSwitch + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_playback_switch as hasPlaybackSwitch + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_playback_switch_joined as hasPlaybackSwitchJoined + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_capture_switch as hasCaptureSwitch + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_capture_switch_joined as hasCaptureSwitchJoined + { withSimpleElement* `SimpleElement' } -> `Bool' #} + +{#fun snd_mixer_selem_has_playback_channel as hasPlaybackChannel + { withSimpleElement* `SimpleElement' + , channelToC `Channel' } -> `Bool' #} + +{#fun snd_mixer_selem_has_capture_channel as hasCaptureChannel + { withSimpleElement* `SimpleElement' + , channelToC `Channel' } -> `Bool' #} + +----------------------------------------------------------------------- +-- get +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_get_playback_volume as getPlaybackVolume + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Integer' cToIntegral* } -> `Int' checkGetPlaybackVolume*- #} + +checkGetPlaybackVolume = checkResult_ "snd_mixer_selem_get_playback_volume" + +{#fun snd_mixer_selem_get_capture_volume as getCaptureVolume + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Integer' cToIntegral* } -> `Int' checkGetCaptureVolume*- #} + +checkGetCaptureVolume = checkResult_ "snd_mixer_selem_get_capture_volume" + +{#fun snd_mixer_selem_get_playback_dB as getPlaybackDb + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Integer' cToIntegral* } -> `Int' checkPlaybackDb*- #} + +checkPlaybackDb = checkResult_ "snd_mixer_selem_get_playback_dB" + +{#fun snd_mixer_selem_get_capture_dB as getCaptureDb + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Integer' cToIntegral* } -> `Int' checkCaptureDb*- #} + +checkCaptureDb = checkResult_ "snd_mixer_selem_get_capture_dB" + +peekBool = (>>= return . cToBool) . peek + +{#fun snd_mixer_selem_get_playback_switch as getPlaybackSwitch + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Bool' peekBool* } -> `Int' checkPlaybackSwitch*- #} + +checkPlaybackSwitch = checkResult_ "snd_mixer_selem_get_playback_switch" + +{#fun snd_mixer_selem_get_capture_switch as getCaptureSwitch + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , alloca- `Bool' peekBool* } -> `Int' checkCaptureSwitch*- #} + +checkCaptureSwitch = checkResult_ "snd_mixer_selem_get_capture_switch" + +{#fun snd_mixer_selem_get_playback_volume_range as getPlaybackVolumeRange + { withSimpleElement* `SimpleElement' + , alloca- `Integer' cToIntegral* + , alloca- `Integer' cToIntegral* } -> `Int' checkGetPlaybackVolumeRange*- #} + +checkGetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_get_playback_volume_range" + +{#fun snd_mixer_selem_get_capture_volume_range as getCaptureVolumeRange + { withSimpleElement* `SimpleElement' + , alloca- `Integer' cToIntegral* + , alloca- `Integer' cToIntegral* } -> `Int' checkGetCaptureVolumeRange*- #} + +checkGetCaptureVolumeRange = checkResult_ "snd_mixer_selem_get_capture_volume_range" + +{#fun snd_mixer_selem_get_playback_dB_range as getPlaybackDbRange + { withSimpleElement* `SimpleElement' + , alloca- `Integer' cToIntegral* + , alloca- `Integer' cToIntegral* } -> `Int' checkGetPlaybackDbRange*- #} + +checkGetPlaybackDbRange = checkResult_ "snd_mixer_selem_get_playback_dB_range" + +{#fun snd_mixer_selem_get_capture_dB_range as getCaptureDbRange + { withSimpleElement* `SimpleElement' + , alloca- `Integer' cToIntegral* + , alloca- `Integer' cToIntegral* } -> `Int' checkGetCaptureDbRange*- #} + +checkGetCaptureDbRange = checkResult_ "snd_mixer_selem_get_capture_dB_range" + +----------------------------------------------------------------------- +-- set +-- -------------------------------------------------------------------- + +{#fun snd_mixer_selem_set_playback_volume as setPlaybackVolume + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , fromIntegral `Integer' } -> `Int' checkSetPlaybackVolume*- #} + +checkSetPlaybackVolume = checkResult_ "snd_mixer_selem_set_playback_volume" + +{#fun snd_mixer_selem_set_capture_volume as setCaptureVolume + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , fromIntegral `Integer' } -> `Int' checkSetCaptureVolume*- #} + +checkSetCaptureVolume = checkResult_ "snd_mixer_selem_set_capture_volume" + +{#fun snd_mixer_selem_set_playback_dB as setPlaybackDb + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , fromIntegral `Integer' + , negOne- `Int' } -> `Int' checkSetPlaybackDb*- #} + +checkSetPlaybackDb = checkResult_ "snd_mixer_selem_set_playback_dB" + +{#fun snd_mixer_selem_set_capture_dB as setCaptureDb + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , fromIntegral `Integer' + , negOne- `Int' } -> `Int' checkSetCaptureDb*- #} + +checkSetCaptureDb = checkResult_ "snd_mixer_selem_set_capture_dB" + +{#fun snd_mixer_selem_set_playback_volume_all as setPlaybackVolumeAll + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' } -> `Int' checkSetPlaybackVolumeAll*- #} + +checkSetPlaybackVolumeAll = checkResult_ "snd_mixer_selem_set_playback_volume_all" + +{#fun snd_mixer_selem_set_capture_volume_all as setCaptureVolumeAll + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' } -> `Int' checkSetCaptureVolumeAll*- #} + +checkSetCaptureVolumeAll = checkResult_ "snd_mixer_selem_set_capture_volume_all" + +{#fun snd_mixer_selem_set_playback_dB_all as setPlaybackDbAll + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' + , negOne- `Int' } -> `Int' checkSetPlaybackDbAll*- #} + +checkSetPlaybackDbAll = checkResult_ "snd_mixer_selem_set_playback_dB_all" + +{#fun snd_mixer_selem_set_capture_dB_all as setCaptureDbAll + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' + , negOne- `Int' } -> `Int' checkSetCaptureDbAll*- #} + +checkSetCaptureDbAll = checkResult_ "snd_mixer_selem_set_capture_dB_all" + +{#fun snd_mixer_selem_set_playback_switch as setPlaybackSwitch + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , `Bool' } -> `Int' checkSetPlaybackSwitch*- #} + +checkSetPlaybackSwitch = checkResult_ "snd_mixer_selem_set_playback_switch" + +{#fun snd_mixer_selem_set_capture_switch as setCaptureSwitch + { withSimpleElement* `SimpleElement' + , channelToC `Channel' + , `Bool' } -> `Int' checkSetCaptureSwitch*- #} + +checkSetCaptureSwitch = checkResult_ "snd_mixer_selem_set_capture_switch" + +{#fun snd_mixer_selem_set_playback_switch_all as setPlaybackSwitchAll + { withSimpleElement* `SimpleElement' + , `Bool' } -> `Int' checkSetPlaybackSwitchAll*- #} + +checkSetPlaybackSwitchAll = checkResult_ "snd_mixer_selem_set_playback_switch_all" + +{#fun snd_mixer_selem_set_capture_switch_all as setCaptureSwitchAll + { withSimpleElement* `SimpleElement' + , `Bool' } -> `Int' checkSetCaptureSwitchAll*- #} + +checkSetCaptureSwitchAll = checkResult_ "snd_mixer_selem_set_capture_switch_all" + +{#fun snd_mixer_selem_set_playback_volume_range as setPlaybackVolumeRange' + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' + , fromIntegral `Integer' } -> `Int' checkSetPlaybackVolumeRange*- #} + +checkSetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_set_playback_volume_range" + +{#fun snd_mixer_selem_set_capture_volume_range as setCaptureVolumeRange' + { withSimpleElement* `SimpleElement' + , fromIntegral `Integer' + , fromIntegral `Integer' } -> `Int' checkSetCaptureVolumeRange*- #} + +checkSetCaptureVolumeRange = checkResult_ "snd_mixer_selem_set_capture_volume_range" + +setPlaybackVolumeRange m = uncurry (setPlaybackVolumeRange' m) +setCaptureVolumeRange m = uncurry (setCaptureVolumeRange' m) diff --git a/Sound/ALSA/Mixer/Internal.hs b/Sound/ALSA/Mixer/Internal.hs deleted file mode 100644 --- a/Sound/ALSA/Mixer/Internal.hs +++ /dev/null @@ -1,266 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, TemplateHaskell #-} -module Sound.ALSA.Mixer.Internal - ( Mixer() - , SimpleElement() - , SimpleElementId() - , Channel(..) - , allChannels - , elements - , getMixerByName - , isPlaybackMono - , isCaptureMono - , hasPlaybackChannel - , hasCaptureChannel - , hasCommonVolume - , hasPlaybackVolume - , hasPlaybackVolumeJoined - , hasCaptureVolume - , hasCaptureVolumeJoined - , hasCommonSwitch - , hasPlaybackSwitch - , hasPlaybackSwitchJoined - , hasCaptureSwitch - , hasCaptureSwitchJoined - , getPlaybackVolume - , getCaptureVolume - , getPlaybackDb - , getCaptureDb - , getPlaybackSwitch - , getCaptureSwitch - , setPlaybackVolume - , setCaptureVolume - , setPlaybackDb - , setCaptureDb - , setPlaybackVolumeAll - , setCaptureVolumeAll - , setPlaybackDbAll - , setCaptureDbAll - , setPlaybackSwitch - , setCaptureSwitch - , setPlaybackSwitchAll - , setCaptureSwitchAll - , getPlaybackVolumeRange - , getPlaybackDbRange - , getCaptureVolumeRange - , getCaptureDbRange - , setPlaybackVolumeRange - , setCaptureVolumeRange - , getName - , getIndex - ) where - -import qualified Data.ByteString.Char8 as B -import Foreign -import Foreign.C.Error ( eNOENT ) -import Foreign.C.String ( CString ) -import Foreign.C.Types -import Sound.ALSA.Exception ( checkResult_, throw ) -import Sound.ALSA.Mixer.Templates - ------------------------------------------------------------------------ --- open --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_open" - snd_mixer_open :: Ptr (Ptr MixerT) -> IO CInt - --- Static address import for finalizer. Suppression of the return type may --- not be a good idea, but the workaround involves lots of C. -foreign import ccall "alsa/asoundlib.h &snd_mixer_close" - snd_mixer_close :: FunPtr (Ptr MixerT -> IO ()) - -open :: IO Mixer -open = do - ppmix <- malloc - pmix <- do - snd_mixer_open ppmix >>= checkResult_ "snd_mixer_open" - peek ppmix - newForeignPtr snd_mixer_close pmix - ------------------------------------------------------------------------ --- attach --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_attach" - snd_mixer_attach :: Ptr MixerT -> CString -> IO CInt - -attach :: Mixer -> String -> IO () -attach fmix name = - B.useAsCString (B.pack name) $ \pName -> - withForeignPtr fmix $ \pmix -> - snd_mixer_attach pmix pName >>= checkResult_ "snd_mixer_attach" - ------------------------------------------------------------------------ --- load --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_load" - snd_mixer_load :: Ptr MixerT -> IO CInt - -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_register" - snd_mixer_selem_register :: Ptr MixerT -> Ptr () -> Ptr () -> IO CInt - -load :: Mixer -> IO () -load fmix = withForeignPtr fmix $ \pmix -> do - snd_mixer_selem_register pmix nullPtr nullPtr - >>= checkResult_ "snd_mixer_selem_register" - snd_mixer_load pmix >>= checkResult_ "snd_mixer_load" - ------------------------------------------------------------------------ --- getId --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_id_malloc" - snd_mixer_selem_id_malloc :: Ptr (Ptr SimpleElementIdT) -> IO () - -foreign import ccall "alsa/asoundlib.h &snd_mixer_selem_id_free" - snd_mixer_selem_id_free :: FunPtr (Ptr SimpleElementIdT -> IO ()) - -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_get_id" - snd_mixer_selem_get_id :: Element -> Ptr SimpleElementIdT -> IO () - -getId :: Element -> IO SimpleElementId -getId pElem = do - pId <- alloca $ \ppId -> do - snd_mixer_selem_id_malloc ppId - peek ppId - snd_mixer_selem_get_id pElem pId - newForeignPtr snd_mixer_selem_id_free pId - ------------------------------------------------------------------------ --- elements --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_first_elem" - snd_mixer_first_elem :: Ptr MixerT -> IO Element - -foreign import ccall "alsa/asoundlib.h snd_mixer_last_elem" - snd_mixer_last_elem :: Ptr MixerT -> IO Element - -foreign import ccall "alsa/asoundlib.h snd_mixer_elem_next" - snd_mixer_elem_next :: Element -> IO Element - -elements :: Mixer -> IO [(SimpleElementId, SimpleElement)] -elements fMix = withForeignPtr fMix $ \pMix -> do - pFirst <- snd_mixer_first_elem pMix - pLast <- snd_mixer_last_elem pMix - es <- elements' pFirst [] pLast - mapM (simpleElement fMix) es - where elements' pThis xs pLast | pThis == pLast = return $ pThis : xs - | otherwise = do - pNext <- snd_mixer_elem_next pThis - elements' pNext (pThis : xs) pLast - ------------------------------------------------------------------------ --- simpleElement --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_find_selem" - snd_mixer_find_selem :: Ptr MixerT -> Ptr SimpleElementIdT -> IO (Ptr SimpleElementT) - -simpleElement :: Mixer -> Element -> IO (SimpleElementId, SimpleElement) -simpleElement fMix pElem = withForeignPtr fMix $ \pMix -> do - fId <- getId pElem - pSElem <- withForeignPtr fId $ snd_mixer_find_selem pMix - if pSElem == nullPtr - then throw "snd_mixer_find_selem" eNOENT - else return (fId, (fMix, pSElem)) - ------------------------------------------------------------------------ --- getName --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_id_get_name" - snd_mixer_selem_id_get_name :: Ptr SimpleElementIdT -> IO CString - -getName :: SimpleElementId -> IO String -getName fId = withForeignPtr fId $ \pId -> do - cStr <- snd_mixer_selem_id_get_name pId - bStr <- B.packCString cStr - return $ B.unpack bStr - ------------------------------------------------------------------------ --- getIndex --- -------------------------------------------------------------------- -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_id_get_index" - snd_mixer_selem_id_get_index :: Ptr SimpleElementIdT -> IO CInt - -getIndex :: SimpleElementId -> IO Integer -getIndex fId = withForeignPtr fId $ \pId -> do - cIndex <- snd_mixer_selem_id_get_index pId - return $! fromIntegral cIndex - ------------------------------------------------------------------------ --- getMixerByName --- -------------------------------------------------------------------- --- | Returns the named 'Mixer'. Will throw an exception if the named mixer --- cannot be found. A mixer named \"default\" should always exist. -getMixerByName :: String -> IO Mixer -getMixerByName name = do - mix <- open - attach mix name - load mix - return mix - ------------------------------------------------------------------------ - -$(has "snd_mixer_selem_is_playback_mono" "isPlaybackMono") -$(has "snd_mixer_selem_is_capture_mono" "isCaptureMono") -$(has "snd_mixer_selem_has_common_volume" "hasCommonVolume") -$(has "snd_mixer_selem_has_playback_volume" "hasPlaybackVolume") -$(has "snd_mixer_selem_has_playback_volume_joined" "hasPlaybackVolumeJoined") -$(has "snd_mixer_selem_has_capture_volume" "hasCaptureVolume") -$(has "snd_mixer_selem_has_capture_volume_joined" "hasCaptureVolumeJoined") -$(has "snd_mixer_selem_has_common_switch" "hasCommonSwitch") -$(has "snd_mixer_selem_has_playback_switch" "hasPlaybackSwitch") -$(has "snd_mixer_selem_has_playback_switch_joined" "hasPlaybackSwitchJoined") -$(has "snd_mixer_selem_has_capture_switch" "hasCaptureSwitch") -$(has "snd_mixer_selem_has_capture_switch_joined" "hasCaptureSwitchJoined") - -has2 :: (Ptr SimpleElementT -> b -> IO CInt) -> SimpleElement -> b -> IO Bool -has2 f (fMix, pElem) y = do - h <- f pElem y - touchForeignPtr fMix - return $! h == 1 - -hasChannel :: (Ptr SimpleElementT -> CInt -> IO CInt) -> SimpleElement -> Channel -> IO Bool -hasChannel f x chan = has2 f x $ fromIntegral $ fromEnum chan - -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_has_playback_channel" - snd_mixer_selem_has_playback_channel :: Ptr SimpleElementT -> CInt -> IO CInt - -hasPlaybackChannel :: SimpleElement -> Channel -> IO Bool -hasPlaybackChannel = hasChannel snd_mixer_selem_has_playback_channel - -foreign import ccall "alsa/asoundlib.h snd_mixer_selem_has_capture_channel" - snd_mixer_selem_has_capture_channel :: Ptr SimpleElementT -> CInt -> IO CInt - -hasCaptureChannel :: SimpleElement -> Channel -> IO Bool -hasCaptureChannel = hasChannel snd_mixer_selem_has_capture_channel - -$(getVol "snd_mixer_selem_get_playback_volume" "getPlaybackVolume") -$(getVol "snd_mixer_selem_get_capture_volume" "getCaptureVolume") -$(getVol "snd_mixer_selem_get_playback_dB" "getPlaybackDb") -$(getVol "snd_mixer_selem_get_capture_dB" "getCaptureDb") - -$(getSwitch "snd_mixer_selem_get_playback_switch" "getPlaybackSwitch") -$(getSwitch "snd_mixer_selem_get_capture_switch" "getCaptureSwitch") - -$(setVol "snd_mixer_selem_set_playback_volume" "setPlaybackVolume") -$(setVol "snd_mixer_selem_set_capture_volume" "setCaptureVolume") - -$(setDb "snd_mixer_selem_set_playback_dB" "setPlaybackDb") -$(setDb "snd_mixer_selem_set_capture_dB" "setCaptureDb") - -$(setVolAll "snd_mixer_selem_set_playback_volume_all" "setPlaybackVolumeAll") -$(setVolAll "snd_mixer_selem_set_capture_volume_all" "setCaptureVolumeAll") - -$(setDbAll "snd_mixer_selem_set_playback_dB_all" "setPlaybackDbAll") -$(setDbAll "snd_mixer_selem_set_capture_dB_all" "setCaptureDbAll") - -$(setSwitch "snd_mixer_selem_set_playback_switch" "setPlaybackSwitch") -$(setSwitch "snd_mixer_selem_set_capture_switch" "setCaptureSwitch") - -$(setSwitchAll "snd_mixer_selem_set_playback_switch_all" "setPlaybackSwitchAll") -$(setSwitchAll "snd_mixer_selem_set_capture_switch_all" "setCaptureSwitchAll") - -$(getRange "snd_mixer_selem_get_playback_volume_range" "getPlaybackVolumeRange") -$(getRange "snd_mixer_selem_get_playback_dB_range" "getPlaybackDbRange") -$(getRange "snd_mixer_selem_get_capture_volume_range" "getCaptureVolumeRange") -$(getRange "snd_mixer_selem_get_capture_dB_range" "getCaptureDbRange") - -$(setRange "snd_mixer_selem_set_playback_volume_range" "setPlaybackVolumeRange") -$(setRange "snd_mixer_selem_set_capture_volume_range" "setCaptureVolumeRange") diff --git a/Sound/ALSA/Mixer/Templates.hs b/Sound/ALSA/Mixer/Templates.hs deleted file mode 100644 --- a/Sound/ALSA/Mixer/Templates.hs +++ /dev/null @@ -1,204 +0,0 @@ -{-# LANGUAGE TemplateHaskell, EmptyDataDecls #-} -module Sound.ALSA.Mixer.Templates where - -import Foreign -import Foreign.C.Types -import Language.Haskell.TH -import Sound.ALSA.Exception ( checkResult_ ) - -data MixerT -data ElemT -data SimpleElementIdT -data SimpleElementT - -type Mixer = ForeignPtr MixerT -type Element = Ptr ElemT -type SimpleElementId = ForeignPtr SimpleElementIdT -type SimpleElement = (Mixer, Ptr SimpleElementT) - -data Channel = Unknown - | FrontLeft - | FrontRight - | RearLeft - | RearRight - | FrontCenter - | Woofer - | SideLeft - | SideRight - | RearCenter - | OtherChannel Int - deriving (Read, Show, Eq) - -instance Enum Channel where - fromEnum Unknown = -1 - fromEnum FrontLeft = 0 - fromEnum FrontRight = 1 - fromEnum RearLeft = 2 - fromEnum RearRight = 3 - fromEnum FrontCenter = 4 - fromEnum Woofer = 5 - fromEnum SideLeft = 6 - fromEnum SideRight = 7 - fromEnum RearCenter = 8 - fromEnum (OtherChannel x) = x - - toEnum (-1) = Unknown - toEnum 0 = FrontLeft - toEnum 1 = FrontRight - toEnum 2 = RearLeft - toEnum 3 = RearRight - toEnum 4 = FrontCenter - toEnum 5 = Woofer - toEnum 6 = SideLeft - toEnum 7 = SideRight - toEnum 8 = RearCenter - toEnum x = OtherChannel x - --- | All channels understood by ALSA. -allChannels :: [Channel] -allChannels = map toEnum $ enumFromTo 0 31 - -has :: String -> String -> Q [Dec] -has = template frgn hask body - where frgn = [t| Ptr SimpleElementT -> IO CInt |] - hask = [t| SimpleElement -> IO Bool |] - body frgnName = [| \(fMix, pElem) -> do ret <- $(varE frgnName) pElem - touchForeignPtr fMix - return $ 1 == ret - |] - -getVol :: String -> String -> Q [Dec] -getVol frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> Ptr CLong -> IO CInt |] - hask = [t| SimpleElement -> Channel -> IO Integer |] - body frgnName = [| \(fMix, pElem) chan -> do - let iChan = fromIntegral $! fromEnum chan - vol <- alloca $ \pVol -> do - ret <- $(varE frgnName) pElem iChan pVol - checkResult_ frgnStr ret - peek pVol - touchForeignPtr fMix - return $! fromIntegral vol - |] - -getSwitch :: String -> String -> Q [Dec] -getSwitch frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> Ptr CInt -> IO CInt |] - hask = [t| SimpleElement -> Channel -> IO Bool |] - body frgnName = [| \(fMix, pElem) chan -> do - let iChan = fromIntegral $! fromEnum chan - iBool <- alloca $ \pBool -> do - ret <- $(varE frgnName) pElem iChan pBool - checkResult_ frgnStr ret - peek pBool - touchForeignPtr fMix - return $! iBool == 1 - |] - -setVol :: String -> String -> Q [Dec] -setVol frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> CLong -> IO CInt |] - hask = [t| SimpleElement -> Channel -> Integer -> IO () |] - body frgnName = [| \(fMix, pElem) chan vol -> do - let iChan = fromIntegral $! fromEnum chan - iVol = fromIntegral $! vol - ret <- $(varE frgnName) pElem iChan iVol - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -setDb :: String -> String -> Q [Dec] -setDb frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> CLong -> CInt -> IO CInt |] - hask = [t| SimpleElement -> Channel -> Integer -> IO () |] - body frgnName = [| \(fMix, pElem) chan vol -> do - let iChan = fromIntegral $! fromEnum chan - iVol = fromIntegral $! vol - ret <- $(varE frgnName) pElem iChan iVol (-1) - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -setVolAll :: String -> String -> Q [Dec] -setVolAll frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CLong -> IO CInt |] - hask = [t| SimpleElement -> Integer -> IO () |] - body frgnName = [| \(fMix, pElem) vol -> do - let iVol = fromIntegral $! vol - ret <- $(varE frgnName) pElem iVol - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -setDbAll :: String -> String -> Q [Dec] -setDbAll frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CLong -> CInt -> IO CInt |] - hask = [t| SimpleElement -> Integer -> IO () |] - body frgnName = [| \(fMix, pElem) vol -> do - let iVol = fromIntegral $! vol - ret <- $(varE frgnName) pElem iVol (-1) - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -setSwitch :: String -> String -> Q [Dec] -setSwitch frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> CInt -> IO CInt |] - hask = [t| SimpleElement -> Channel -> Bool -> IO () |] - body frgnName = [| \(fMix, pElem) chan bool -> do - let iChan = fromIntegral $! fromEnum chan - iBool = if bool then 1 else 0 - ret <- $(varE frgnName) pElem iChan iBool - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -setSwitchAll :: String -> String -> Q [Dec] -setSwitchAll frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CInt -> IO CInt |] - hask = [t| SimpleElement -> Bool -> IO () |] - body frgnName = [| \(fMix, pElem) bool -> do - let iBool = if bool then 1 else 0 - ret <- $(varE frgnName) pElem iBool - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -getRange :: String -> String -> Q [Dec] -getRange frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> Ptr CLong -> Ptr CLong -> IO CInt |] - hask = [t| SimpleElement -> IO (Integer, Integer) |] - body frgnName = [| \(fMix, pElem) -> - alloca $ \pMin -> - alloca $ \pMax -> do - ret <- $(varE frgnName) pElem pMin pMax - checkResult_ frgnStr ret - cMin <- peek pMin - cMax <- peek pMax - touchForeignPtr fMix - return (fromIntegral cMin, fromIntegral cMax) - |] - -setRange :: String -> String -> Q [Dec] -setRange frgnStr = template frgn hask body frgnStr - where frgn = [t| Ptr SimpleElementT -> CLong -> CLong -> IO CInt |] - hask = [t| SimpleElement -> (Integer, Integer) -> IO () |] - body frgnName = [| \(fMix, pElem) (cMin, cMax) -> do - let iMin = fromIntegral $! cMin - iMax = fromIntegral $! cMax - ret <- $(varE frgnName) pElem iMin iMax - touchForeignPtr fMix - checkResult_ frgnStr ret - |] - -template :: Q Type -> Q Type -> (Name -> Q Exp) -> String -> String -> Q [Dec] -template frgnType haskType body frgn hask = do - let frgnImp = "alsa/asoundlib.h " ++ frgn - frgnName = mkName frgn - haskName = mkName hask - frgnDec <- forImpD cCall safe frgnImp frgnName frgnType - let haskBody = normalB $ body frgnName - haskClause = clause [] haskBody [] - haskDec <- funD haskName [ haskClause ] - haskSig <- sigD haskName haskType - return [ frgnDec, haskSig, haskDec ] diff --git a/alsa-mixer.cabal b/alsa-mixer.cabal --- a/alsa-mixer.cabal +++ b/alsa-mixer.cabal @@ -1,5 +1,5 @@ Name: alsa-mixer -Version: 0.1 +Version: 0.1.1 Synopsis: Bindings to the ALSA simple mixer API. Description: This package provides bindings to the ALSA simple mixer API. License: BSD3 @@ -17,9 +17,7 @@ Library Exposed-modules: Sound.ALSA.Mixer - Other-modules: Sound.ALSA.Mixer.Internal, Sound.ALSA.Mixer.Templates + Other-modules: Sound.ALSA.Mixer.Internal Extra-libraries: asound Build-depends: base == 4.*, - alsa-core == 0.5.*, - bytestring == 0.9.*, - template-haskell + alsa-core == 0.5.*