alsa-mixer (empty) → 0.1
raw patch · 6 files changed
+845/−0 lines, 6 filesdep +alsa-coredep +basedep +bytestringsetup-changed
Dependencies added: alsa-core, base, bytestring, template-haskell
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Sound/ALSA/Mixer.hs +318/−0
- Sound/ALSA/Mixer/Internal.hs +266/−0
- Sound/ALSA/Mixer/Templates.hs +204/−0
- alsa-mixer.cabal +25/−0
+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Sound/ALSA/Mixer.hs view
@@ -0,0 +1,318 @@+-----------------------------------------------------------------------------+-- |+-- Module : Sound.ALSA.Mixer+-- Copyright : (c) Thomas Tuegel 2011+-- License : BSD+--+-- Maintainer : Thomas Tuegel <ttuegel@gmail.com>+-- 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++-}
+ Sound/ALSA/Mixer/Internal.hs view
@@ -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")
+ Sound/ALSA/Mixer/Templates.hs view
@@ -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 ]
+ alsa-mixer.cabal view
@@ -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 <ttuegel@gmail.com>+Maintainer: Thomas Tuegel <ttuegel@gmail.com>+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