alsa-mixer-0.3.0/0000755000000000000000000000000007346545000011745 5ustar0000000000000000alsa-mixer-0.3.0/LICENSE0000644000000000000000000000276307346545000012762 0ustar0000000000000000Copyright (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. alsa-mixer-0.3.0/Setup.hs0000644000000000000000000000005607346545000013402 0ustar0000000000000000import Distribution.Simple main = defaultMain alsa-mixer-0.3.0/Sound/ALSA/0000755000000000000000000000000007346545000013555 5ustar0000000000000000alsa-mixer-0.3.0/Sound/ALSA/Mixer.hs0000644000000000000000000003311207346545000015175 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- 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). The functions in this library -- throw errors of type 'Sound.ALSA.Exception.T' on failure. -- ----------------------------------------------------------------------------- module Sound.ALSA.Mixer ( -- * Types Control(..) , Mixer() , Channel(..) , PerChannel(..) , Volume(..) , Switch() , CUInt , CLong -- * Functions -- ** Mixers , controls , withMixer -- ** 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 Foreign.C.Types 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 :: CUInt , 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 (CLong, CLong) -- ^ Returns the minimum and maximum volumes (unitless). , setRange :: (CLong, CLong) -> IO () -- ^ Sets the minimum and maximum volumes (unitless). , getRangeDb :: IO (CLong, CLong) -- ^ Returns the minimum and maximum volumes in -- hundredths of a decibel. , value :: PerChannel CLong -- ^ Volume values for each channel. , dB :: PerChannel CLong -- ^ 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 cChans , captJoinedDb cChans ) | otherwise = ( captPerChannelVol cChans , captPerChannelDb cChans ) 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'. getControlByName :: Mixer -- ^ Mixer -> String -- ^ Control name -> IO (Maybe Control) getControlByName mix controlName = do 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 :: CLong -> IO () > changeVolumeBy i = > withMixer "default" $ \mixer -> > do Just control <- getControlByName mixer "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 = > withMixer "default" $ \mixer -> > do Just control <- getControlByName mixer "Master" > let Just playbackSwitch = playback $ switch control > Just sw <- getChannel FrontLeft playbackSwitch > setChannel FrontLeft playbackSwitch $ not sw -} alsa-mixer-0.3.0/Sound/ALSA/Mixer/0000755000000000000000000000000007346545000014641 5ustar0000000000000000alsa-mixer-0.3.0/Sound/ALSA/Mixer/Internal.chs0000644000000000000000000003774507346545000017134 0ustar0000000000000000{-# LANGUAGE CPP, ForeignFunctionInterface #-} module Sound.ALSA.Mixer.Internal ( Mixer() , SimpleElement() , SimpleElementId() , Channel(..) , allChannels , elements , withMixer , 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 Control.Monad (liftM, when) import Control.Exception (bracket) import Foreign import Foreign.C.Error ( eNOENT ) import Foreign.C.String import Foreign.C.Types import Sound.ALSA.Exception ( checkResult_, throw ) import System.Posix.Process (getProcessID) #include "alsa/asoundlib.h" {#context lib = "asoundlib" #} {#pointer *snd_mixer_t as Mixer newtype#} {#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 -- -------------------------------------------------------------------- foreign import ccall safe "alsa/asoundlib.h snd_mixer_open" open_ :: Ptr (Ptr Mixer) -> CInt -> IO CInt open :: IO Mixer open = withPtr $ \ppm -> do open_ ppm (fromIntegral 0) >>= checkResult_ "snd_mixer_open" liftM Mixer $ peek ppm withPtr :: (Ptr (Ptr a) -> IO a) -> IO a withPtr = bracket malloc free foreign import ccall "alsa/asoundlib.h snd_mixer_close" freeMixer :: Ptr Mixer -> IO () ----------------------------------------------------------------------- -- attach -- -------------------------------------------------------------------- {#fun snd_mixer_attach as attach { id `Mixer', `String' } -> `Int' checkAttach*- #} checkAttach = checkResult_ "snd_mixer_attach" ----------------------------------------------------------------------- -- load -- -------------------------------------------------------------------- {#fun snd_mixer_load as ^ { id `Mixer' } -> `Int' checkSndMixerLoad*- #} checkSndMixerLoad = checkResult_ "snd_mixer_load" {#fun snd_mixer_selem_register as ^ { id `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 ^ { id `Mixer' } -> `Element' id #} {#fun snd_mixer_last_elem as ^ { id `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 ^ { id `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' } -> `CUInt' #} ----------------------------------------------------------------------- -- getMixerByName -- -------------------------------------------------------------------- -- | Perform an 'IO' action with the named mixer. An exception of type -- 'Sound.ALSA.Exception.T' will be thrown if the named mixer cannot be -- found. A mixer named \"default\" should always exist. withMixer :: String -> (Mixer -> IO a) -> IO a withMixer name f = bracket (do m <- open attach m name load m pid <- getProcessID return (pid, m)) (\(creatorPID, Mixer m) -> do myPID <- getProcessID when (myPID == creatorPID) $ freeMixer m) (f . snd) ----------------------------------------------------------------------- -- utilities -- -------------------------------------------------------------------- cToBool = toBool cFromBool = fromBool withSimpleElement :: SimpleElement -> (Element -> IO a) -> IO a withSimpleElement (m, s) f = f s channelToC = toEnum . fromEnum 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- `CLong' peek* } -> `Int' checkGetPlaybackVolume*- #} checkGetPlaybackVolume = checkResult_ "snd_mixer_selem_get_playback_volume" {#fun snd_mixer_selem_get_capture_volume as getCaptureVolume { withSimpleElement* `SimpleElement' , channelToC `Channel' , alloca- `CLong' peek* } -> `Int' checkGetCaptureVolume*- #} checkGetCaptureVolume = checkResult_ "snd_mixer_selem_get_capture_volume" {#fun snd_mixer_selem_get_playback_dB as getPlaybackDb { withSimpleElement* `SimpleElement' , channelToC `Channel' , alloca- `CLong' peek* } -> `Int' checkPlaybackDb*- #} checkPlaybackDb = checkResult_ "snd_mixer_selem_get_playback_dB" {#fun snd_mixer_selem_get_capture_dB as getCaptureDb { withSimpleElement* `SimpleElement' , channelToC `Channel' , alloca- `CLong' peek* } -> `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- `CLong' peek* , alloca- `CLong' peek* } -> `Int' checkGetPlaybackVolumeRange*- #} checkGetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_get_playback_volume_range" {#fun snd_mixer_selem_get_capture_volume_range as getCaptureVolumeRange { withSimpleElement* `SimpleElement' , alloca- `CLong' peek* , alloca- `CLong' peek* } -> `Int' checkGetCaptureVolumeRange*- #} checkGetCaptureVolumeRange = checkResult_ "snd_mixer_selem_get_capture_volume_range" {#fun snd_mixer_selem_get_playback_dB_range as getPlaybackDbRange { withSimpleElement* `SimpleElement' , alloca- `CLong' peek* , alloca- `CLong' peek* } -> `Int' checkGetPlaybackDbRange*- #} checkGetPlaybackDbRange = checkResult_ "snd_mixer_selem_get_playback_dB_range" {#fun snd_mixer_selem_get_capture_dB_range as getCaptureDbRange { withSimpleElement* `SimpleElement' , alloca- `CLong' peek* , alloca- `CLong' peek* } -> `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' , `CLong' } -> `Int' checkSetPlaybackVolume*- #} checkSetPlaybackVolume = checkResult_ "snd_mixer_selem_set_playback_volume" {#fun snd_mixer_selem_set_capture_volume as setCaptureVolume { withSimpleElement* `SimpleElement' , channelToC `Channel' , `CLong' } -> `Int' checkSetCaptureVolume*- #} checkSetCaptureVolume = checkResult_ "snd_mixer_selem_set_capture_volume" {#fun snd_mixer_selem_set_playback_dB as setPlaybackDb { withSimpleElement* `SimpleElement' , channelToC `Channel' , `CLong' , 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' , `CLong' , negOne- `Int' } -> `Int' checkSetCaptureDb*- #} checkSetCaptureDb = checkResult_ "snd_mixer_selem_set_capture_dB" {#fun snd_mixer_selem_set_playback_volume_all as setPlaybackVolumeAll { withSimpleElement* `SimpleElement' , `CLong' } -> `Int' checkSetPlaybackVolumeAll*- #} checkSetPlaybackVolumeAll = checkResult_ "snd_mixer_selem_set_playback_volume_all" {#fun snd_mixer_selem_set_capture_volume_all as setCaptureVolumeAll { withSimpleElement* `SimpleElement' , `CLong' } -> `Int' checkSetCaptureVolumeAll*- #} checkSetCaptureVolumeAll = checkResult_ "snd_mixer_selem_set_capture_volume_all" {#fun snd_mixer_selem_set_playback_dB_all as setPlaybackDbAll { withSimpleElement* `SimpleElement' , `CLong' , 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' , `CLong' , 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' , `CLong' , `CLong' } -> `Int' checkSetPlaybackVolumeRange*- #} checkSetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_set_playback_volume_range" {#fun snd_mixer_selem_set_capture_volume_range as setCaptureVolumeRange' { withSimpleElement* `SimpleElement' , `CLong' , `CLong' } -> `Int' checkSetCaptureVolumeRange*- #} checkSetCaptureVolumeRange = checkResult_ "snd_mixer_selem_set_capture_volume_range" setPlaybackVolumeRange m = uncurry (setPlaybackVolumeRange' m) setCaptureVolumeRange m = uncurry (setCaptureVolumeRange' m) alsa-mixer-0.3.0/alsa-mixer.cabal0000644000000000000000000000200007346545000014763 0ustar0000000000000000Name: alsa-mixer Version: 0.3.0 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: 2014-2018 Thomas Tuegel Category: Sound Build-type: Simple Cabal-version: >=1.6 Homepage: https://github.com/ttuegel/alsa-mixer Bug-reports: https://github.com/ttuegel/alsa-mixer/issues Extra-source-files: changelog Source-repository head Type: git Location: https://github.com/ttuegel/alsa-mixer.git Library Exposed-modules: Sound.ALSA.Mixer Other-modules: Sound.ALSA.Mixer.Internal Build-tools: c2hs Extra-libraries: asound Build-depends: base == 4.*, alsa-core == 0.5.*, unix >= 2.6 && < 3 alsa-mixer-0.3.0/changelog0000755000000000000000000000111007346545000013613 0ustar00000000000000000.3.0 Thomas Tuegel 2018-12-09 * Use C types in exported interface (#6) 0.2.0.3 Thomas Tuegel 2016-01-06 * Use capture channel to get capture volume (#4) 0.2.0.2 Thomas Tuegel 2014-04-15 * Relax version constraint on `unix' dependency 0.2.0.1 Thomas Tuegel 2014-03-08 * Correct documentation 0.2.0 Thomas Tuegel 2014-03-02 * Only release mixer from creating process * Use 'withMixer' to manage resource usage * Remove old TemplateHaskell definitions