diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c)2010, Thomas Tuegel + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Thomas Tuegel nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/Sound/ALSA/Mixer.hs b/Sound/ALSA/Mixer.hs new file mode 100644 --- /dev/null +++ b/Sound/ALSA/Mixer.hs @@ -0,0 +1,318 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Sound.ALSA.Mixer +-- Copyright : (c) Thomas Tuegel 2011 +-- License : BSD +-- +-- Maintainer : Thomas Tuegel +-- Stability : experimental +-- Portability : non-portable (Linux only) +-- +-- This library provides bindings to the Advanced Linux Sound Architecture +-- (ALSA) library API. The portability of this library is limited to +-- systems with ALSA (i.e., Linux systems). +-- +----------------------------------------------------------------------------- + +module Sound.ALSA.Mixer + ( -- * Types + Control(..) + , Mixer() + , Channel(..) + , PerChannel(..) + , Volume(..) + , Switch() + -- * Functions + -- ** Mixers + , controls + , getMixerByName + -- ** Controls + , getControlByName + , common + , playback + , capture + -- ** PerChannels + , channels + , allChannels + , joined + , perChannel + , getChannel + , setChannel + -- * Examples + + -- ** Getting and setting the volume of a Control + -- $exampleVolume + + -- ** Getting and setting the switch of a Control + -- $exampleSwitch + ) where + +import Control.Monad ( forM, liftM, when ) +import Data.Maybe ( catMaybes ) +import Foreign.C.Error ( Errno(..) ) +import Sound.ALSA.Exception ( catchErrno ) +import Sound.ALSA.Mixer.Internal + +-- | 'Control' represents one of the controls belonging to an ALSA mixer +-- element. Each control has a number of playback and capture channels. +-- The control may also have a switch and/or a volume capability associated +-- with it. The capability can be common to both playback and capture, or +-- there can be separate capabilities for each. +data Control = Control { index :: Integer + , name :: String + , switch :: Either Switch (Maybe Switch, Maybe Switch) + , volume :: Either Volume (Maybe Volume, Maybe Volume) + } + +-- | 'PerChannel' represents a capability that with either a separate value for +-- each channel or with a common value for all channels. +data PerChannel e = Joined { getJoined :: IO e + , setJoined :: e -> IO () + , joinedChannels :: [Channel] + } + | PerChannel { getPerChannel :: IO [(Channel, e)] + , setPerChannel :: [(Channel, e)] -> IO () + , perChannels :: [Channel] + } + +-- | True if the 'PerChannel' object has a common value for all channels. +joined :: PerChannel e -> Bool +joined j@(Joined _ _ _) = True +joined _ = False + +-- | True if the 'PerChannel' object has a separate value for each channel. +perChannel :: PerChannel e -> Bool +perChannel p@(PerChannel _ _ _) = True +perChannel _ = False + +-- | All channels supported by a 'PerChannel' object. +channels :: PerChannel e -> [Channel] +channels p | joined p = joinedChannels p + | otherwise = perChannels p + +-- | 'Switch' represents a switch capability for controls and channels that can +-- be muted and unmuted. +type Switch = PerChannel Bool + +-- | 'Volume' represents a volume capability. There may be a separate value per +-- channel, but each capability has only one range. +data Volume = Volume { getRange :: IO (Integer, Integer) + -- ^ Returns the minimum and maximum volumes (unitless). + , setRange :: (Integer, Integer) -> IO () + -- ^ Sets the minimum and maximum volumes (unitless). + , getRangeDb :: IO (Integer, Integer) + -- ^ Returns the minimum and maximum volumes in + -- hundredths of a decibel. + , value :: PerChannel Integer + -- ^ Volume values for each channel. + , dB :: PerChannel Integer + -- ^ Volume values for each channel in hundredths of + -- a decibel. + } + +-- | Get the value associated with a particular channel, if that channel exists. +getChannel :: Channel -> PerChannel x -> IO (Maybe x) +getChannel c p | joined p = let r | c `elem` channels p = + liftM Just $ getJoined p + | otherwise = return Nothing + in r + | otherwise = liftM (lookup c) $ getPerChannel p + +-- | Set the value associated with a particular channel, if that channel exists. +setChannel :: Channel -> PerChannel x -> x -> IO () +setChannel c p v | joined p = when (c `elem` channels p) $ setJoined p v + | otherwise = setPerChannel p [(c, v)] + +-- | For a given capability, which may be for either playback or capture, or +-- common to both, return the playback capability if it exists. +playback :: Either a (Maybe a, Maybe a) -> Maybe a +playback (Left _) = Nothing +playback (Right (x, _)) = x + +-- | For a given capability, which may be for either playback or capture, or +-- common to both, return the capture capability if it exists. +capture :: Either a (Maybe a, Maybe a) -> Maybe a +capture (Left _) = Nothing +capture (Right (_, x)) = x + +-- | For a given capability, which may be for either playback or capture, or +-- common to both, return the common capability if it exists. +common :: Either a (Maybe a, Maybe a) -> Maybe a +common (Left x) = Just x +common (Right _) = Nothing + +mkSwitch :: SimpleElement -> IO (Either Switch (Maybe Switch, Maybe Switch)) +mkSwitch se = do + hasPlayChan <- mapM (hasPlaybackChannel se) allChannels + hasCaptChan <- mapM (hasCaptureChannel se) allChannels + let pChans = map fst $ filter snd $ zip allChannels hasPlayChan + cChans = map fst $ filter snd $ zip allChannels hasCaptChan + hasComSw <- hasCommonSwitch se + hasPlaySw <- hasPlaybackSwitch se + hasPlaySwJ <- hasPlaybackSwitchJoined se + hasCaptSw <- hasCaptureSwitch se + hasCaptSwJ <- hasCaptureSwitchJoined se + return $ if hasComSw + then Left $ if hasPlaySwJ + then comJoinedSwitch pChans + else comPerChannelSwitch pChans + else let playSw | not hasPlaySw = Nothing + | otherwise = Just + $ if hasPlaySwJ + then playJoinedSwitch pChans + else playPerChannelSwitch pChans + captSw | not hasCaptSw = Nothing + | otherwise = Just + $ if hasCaptSwJ + then captJoinedSwitch cChans + else captPerChannelSwitch cChans + in Right (playSw, captSw) + where joined fGet fSet chans = + Joined { getJoined = fGet se (head chans) + , setJoined = fSet se (head chans) + , joinedChannels = chans + } + perChannel fGet fSet chans = + PerChannel { getPerChannel = liftM (zip chans) + $ mapM (fGet se) chans + , setPerChannel = mapM_ (uncurry (fSet se)) + , perChannels = chans + } + comJoinedSwitch = joined getPlaybackSwitch setPlaybackSwitch + comPerChannelSwitch = perChannel getPlaybackSwitch setPlaybackSwitch + playJoinedSwitch = comJoinedSwitch + playPerChannelSwitch = comPerChannelSwitch + captJoinedSwitch = joined getCaptureSwitch setCaptureSwitch + captPerChannelSwitch = perChannel getCaptureSwitch setCaptureSwitch + +mkVolume :: SimpleElement -> IO (Either Volume (Maybe Volume, Maybe Volume)) +mkVolume se = do + hasPlayChan <- mapM (hasPlaybackChannel se) allChannels + hasCaptChan <- mapM (hasCaptureChannel se) allChannels + let pChans = map fst $ filter snd $ zip allChannels hasPlayChan + cChans = map fst $ filter snd $ zip allChannels hasCaptChan + hasComV <- hasCommonVolume se + hasPlayV <- hasPlaybackVolume se + hasPlayVJ <- hasPlaybackVolumeJoined se + hasCaptV <- hasCaptureVolume se + hasCaptVJ <- hasCaptureVolumeJoined se + return $ + if hasComV + then let (v, d) | hasPlayVJ = ( comJoinedVol pChans + , comJoinedDb pChans + ) + | otherwise = ( comPerChannelVol pChans + , comPerChannelDb pChans + ) + in Left $ playVolume { value = v, dB = d } + else let playVol | not hasPlayV = Nothing + | otherwise = + let (v, d) | hasPlayVJ = + ( playJoinedVol pChans + , playJoinedDb pChans + ) + | otherwise = + ( playPerChannelVol pChans + , playPerChannelDb pChans + ) + in Just playVolume { value = v, dB = d } + captVol | not hasCaptV = Nothing + | otherwise = + let (v, d) | hasCaptVJ = + ( captJoinedVol pChans + , captJoinedDb pChans + ) + | otherwise = + ( captPerChannelVol pChans + , captPerChannelDb pChans + ) + in Just $ captVolume { value = v, dB = d } + in Right (playVol, captVol) + where j fGet fSet chans = + Joined { getJoined = fGet se (head chans) + , setJoined = fSet se (head chans) + , joinedChannels = chans + } + pc fGet fSet chans = + PerChannel { getPerChannel = liftM (zip chans) + $ mapM (fGet se) chans + , setPerChannel = mapM_ (uncurry (fSet se)) + , perChannels = chans + } + playVolume = Volume { getRange = getPlaybackVolumeRange se + , setRange = setPlaybackVolumeRange se + , getRangeDb = getPlaybackDbRange se + , value = undefined + , dB = undefined + } + captVolume = Volume { getRange = getCaptureVolumeRange se + , setRange = setCaptureVolumeRange se + , getRangeDb = getCaptureDbRange se + , value = undefined + , dB = undefined + } + comJoinedVol = j getPlaybackVolume setPlaybackVolume + comJoinedDb = j getPlaybackDb setPlaybackDb + comPerChannelVol = pc getPlaybackVolume setPlaybackVolume + comPerChannelDb = pc getPlaybackDb setPlaybackDb + playJoinedVol = comJoinedVol + playPerChannelVol = comPerChannelVol + playJoinedDb = comJoinedDb + playPerChannelDb = comPerChannelDb + captJoinedVol = j getCaptureVolume setCaptureVolume + captPerChannelVol = pc getCaptureVolume setCaptureVolume + captJoinedDb = j getCaptureDb setCaptureDb + captPerChannelDb = pc getCaptureDb setCaptureDb + +-- | All the 'Control' objects associated with a particular 'Mixer'. +controls :: Mixer -> IO [Control] +controls mix = do + es <- elements mix + forM es $ \(idN, se) -> do + n <- getName idN + i <- getIndex idN + sw <- mkSwitch se + v <- mkVolume se + return $! Control { name = n + , index = i + , switch = sw + , volume = v + } + +-- | Get the named 'Control', if it exists, from the named 'Mixer'. Will +-- throw an exception if the named 'Mixer' does not exist. +getControlByName :: String -- ^ Mixer name + -> String -- ^ Control name + -> IO (Maybe Control) +getControlByName mixerName controlName = do + mix <- getMixerByName mixerName + cs <- controls mix + return $ lookup controlName $ zip (map name cs) cs + +{- $exampleVolume +This example demonstrates the method of accessing the volume of a Control. +The example function reads the volume and increases it by the value supplied. + +> changeVolumeBy :: Integer -> IO () +> changeVolumeBy i = do +> Just control <- getControlByName "default" "Master" +> let Just playbackVolume = playback $ volume control +> (min, max) <- getRange playbackVolume +> Just vol <- getChannel FrontLeft $ value $ playbackVolume +> when ((i > 0 && vol < max) || (i < 0 && vol > min)) +> $ setChannel FrontLeft (value $ playbackVolume) $ vol + i + +-} + +{- $exampleSwitch +This example demonstrates the method of accessing the switch of a Control. +The example function reads the value of the switch and toggles it. + +> toggleMute :: IO () +> toggleMute = do +> Just control <- getControlByName "default" "Master" +> let Just playbackSwitch = playback $ switch control +> Just sw <- getChannel FrontLeft playbackSwitch +> setChannel FrontLeft playbackSwitch $ not sw + +-} diff --git a/Sound/ALSA/Mixer/Internal.hs b/Sound/ALSA/Mixer/Internal.hs new file mode 100644 --- /dev/null +++ b/Sound/ALSA/Mixer/Internal.hs @@ -0,0 +1,266 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/Sound/ALSA/Mixer/Templates.hs @@ -0,0 +1,204 @@ +{-# 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 new file mode 100644 --- /dev/null +++ b/alsa-mixer.cabal @@ -0,0 +1,25 @@ +Name: alsa-mixer +Version: 0.1 +Synopsis: Bindings to the ALSA simple mixer API. +Description: This package provides bindings to the ALSA simple mixer API. +License: BSD3 +License-file: LICENSE +Author: Thomas Tuegel +Maintainer: Thomas Tuegel +Copyright: Thomas Tuegel +Category: Sound +Build-type: Simple +Cabal-version: >=1.6 + +Source-repository head + Type: darcs + Location: http://community.haskell.org/~ttuegel/alsa-mixer + +Library + Exposed-modules: Sound.ALSA.Mixer + Other-modules: Sound.ALSA.Mixer.Internal, Sound.ALSA.Mixer.Templates + Extra-libraries: asound + Build-depends: base == 4.*, + alsa-core == 0.5.*, + bytestring == 0.9.*, + template-haskell