{-# LINE 1 "./Sound/ALSA/Mixer/Internal.chs" #-}
{-# 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 qualified Foreign.C.String as C2HSImp
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.ForeignPtr as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
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)
{-# LINE 62 "./Sound/ALSA/Mixer/Internal.chs" #-}
newtype Mixer = Mixer (C2HSImp.Ptr (Mixer))
{-# LINE 64 "./Sound/ALSA/Mixer/Internal.chs" #-}
type Element = C2HSImp.Ptr (())
{-# LINE 65 "./Sound/ALSA/Mixer/Internal.chs" #-}
type SimpleElementId = C2HSImp.ForeignPtr (())
{-# LINE 66 "./Sound/ALSA/Mixer/Internal.chs" #-}
type SimpleElement = (Mixer, Element)
data Channel = Unknown
| FrontLeft
| SND_MIXER_SCHN_MONO
| FrontRight
| RearLeft
| RearRight
| FrontCenter
| Woofer
| SideLeft
| SideRight
| RearCenter
| Last
deriving (Eq,Read,Show)
instance Enum Channel where
succ Unknown = FrontLeft
succ FrontLeft = FrontRight
succ SND_MIXER_SCHN_MONO = FrontRight
succ FrontRight = RearLeft
succ RearLeft = RearRight
succ RearRight = FrontCenter
succ FrontCenter = Woofer
succ Woofer = SideLeft
succ SideLeft = SideRight
succ SideRight = RearCenter
succ RearCenter = Last
succ Last = error "Channel.succ: Last has no successor"
pred :: Channel -> Channel
pred Channel
FrontLeft = Channel
Unknown
pred Channel
SND_MIXER_SCHN_MONO = Channel
Unknown
pred FrontRight = FrontLeft
pred RearLeft = FrontRight
pred Channel
RearRight = Channel
RearLeft
pred FrontCenter = RearRight
pred Woofer = FrontCenter
pred Channel
SideLeft = Channel
Woofer
pred Channel
SideRight = Channel
SideLeft
pred Channel
RearCenter = Channel
SideRight
pred Channel
Last = Channel
RearCenter
pred Channel
Unknown = String -> Channel
forall a. HasCallStack => String -> a
error String
"Channel.pred: Unknown has no predecessor"
enumFromTo from to = go from
where
end = fromEnum to
go v = case compare (fromEnum v) end of
LT -> v : go (succ v)
EQ -> [v]
GT -> []
enumFrom from = enumFromTo from Last
fromEnum Unknown = (-1)
fromEnum FrontLeft = 0
fromEnum SND_MIXER_SCHN_MONO = 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 Last = 31
toEnum :: Int -> Channel
toEnum (-1) = Channel
Unknown
toEnum Int
0 = Channel
FrontLeft
toEnum Int
1 = Channel
FrontRight
toEnum Int
2 = Channel
RearLeft
toEnum Int
3 = Channel
RearRight
toEnum Int
4 = Channel
FrontCenter
toEnum 5 = Woofer
toEnum 6 = SideLeft
toEnum 7 = SideRight
toEnum 8 = RearCenter
toEnum 31 = Last
toEnum unmatched = error ("Channel.toEnum: Cannot match " ++ show unmatched)
{-# LINE 81 "./Sound/ALSA/Mixer/Internal.chs" #-}
allChannels :: [Channel]
allChannels = map toEnum $ enumFromTo (fromEnum FrontLeft) (fromEnum RearCenter)
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 :: (Mixer) -> (String) -> IO ()
attach a1 a2 =
let {a1' = id a1} in
C2HSImp.withCString a2 $ \a2' ->
attach'_ a1' a2' >>= \res ->
checkAttach res >>
return ()
{-# LINE 109 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkAttach = checkResult_ "snd_mixer_attach"
sndMixerLoad :: (Mixer) -> IO ()
sndMixerLoad a1 =
let {a1' = id a1} in
sndMixerLoad'_ a1' >>= \res ->
checkSndMixerLoad res >>
return ()
{-# LINE 118 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSndMixerLoad = checkResult_ "snd_mixer_load"
sndMixerSelemRegister :: (Mixer) -> (Ptr ()) -> (Ptr (Ptr ())) -> IO ()
sndMixerSelemRegister a1 a2 a3 =
let {a1' = id a1} in
let {a2' = id a2} in
let {a3' = id a3} in
sndMixerSelemRegister'_ a1' a2' a3' >>= \res ->
checkSndMixerSelemRegister res >>
return ()
{-# LINE 125 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSndMixerSelemRegister = checkResult_ "snd_mixer_selem_register"
load :: Mixer -> IO ()
load fmix = do
sndMixerSelemRegister fmix nullPtr nullPtr
sndMixerLoad fmix
sndMixerSelemIdMalloc :: IO ((SimpleElementId))
sndMixerSelemIdMalloc =
alloca $ \a1' ->
sndMixerSelemIdMalloc'_ a1' >>
peekSimpleElementId a1'>>= \a1'' ->
return (a1'')
{-# LINE 139 "./Sound/ALSA/Mixer/Internal.chs" #-}
sndMixerSelemGetId :: (Element) -> (SimpleElementId) -> IO ()
sndMixerSelemGetId a1 a2 =
let {a1' = id a1} in
withForeignPtr a2 $ \a2' ->
sndMixerSelemGetId'_ a1' a2' >>
return ()
{-# LINE 142 "./Sound/ALSA/Mixer/Internal.chs" #-}
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 :: Ptr () -> IO SimpleElementId
getId Ptr ()
e = do
newSid <- IO SimpleElementId
sndMixerSelemIdMalloc
sndMixerSelemGetId e newSid
return newSid
sndMixerFirstElem :: (Mixer) -> IO ((Element))
sndMixerFirstElem :: Mixer -> IO (Ptr ())
sndMixerFirstElem Mixer
a1 =
let {a1' :: Mixer
a1' = Mixer -> Mixer
forall a. a -> a
id Mixer
a1} in
Mixer -> IO (Ptr ())
sndMixerFirstElem'_ Mixer
a1' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')
{-# LINE 160 "./Sound/ALSA/Mixer/Internal.chs" #-}
sndMixerLastElem :: (Mixer) -> IO ((Element))
sndMixerLastElem a1 =
let {a1' = id a1} in
sndMixerLastElem'_ a1' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 163 "./Sound/ALSA/Mixer/Internal.chs" #-}
sndMixerElemNext :: (Element) -> IO ((Element))
sndMixerElemNext a1 =
let {a1' = id a1} in
sndMixerElemNext'_ a1' >>= \res ->
let {res' = id res} in
return (res')
{-# LINE 166 "./Sound/ALSA/Mixer/Internal.chs" #-}
elements :: Mixer -> IO [(SimpleElementId, SimpleElement)]
elements fMix = do
pFirst <- sndMixerFirstElem fMix
es <- elements' pFirst []
mapM (simpleElement fMix) es
where elements' pThis xs | pThis == nullPtr = return xs
| otherwise = do
pNext <- sndMixerElemNext pThis
elements' pNext (pThis : xs)
sndMixerFindSelem :: (Mixer) -> (SimpleElementId) -> IO ((Element))
sndMixerFindSelem :: Mixer -> SimpleElementId -> IO (Ptr ())
sndMixerFindSelem Mixer
a1 SimpleElementId
a2 =
let {a1' :: Mixer
a1' = Mixer -> Mixer
forall a. a -> a
id Mixer
a1} in
SimpleElementId -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SimpleElementId
a2 ((Ptr () -> IO (Ptr ())) -> IO (Ptr ()))
-> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a2' ->
Mixer -> Ptr () -> IO (Ptr ())
sndMixerFindSelem'_ Mixer
a1' Ptr ()
a2' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr ()
res ->
let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
Ptr () -> IO (Ptr ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')
{-# LINE 184 "./Sound/ALSA/Mixer/Internal.chs" #-}
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 :: (SimpleElementId) -> IO ((String))
getName :: SimpleElementId -> IO String
getName SimpleElementId
a1 =
SimpleElementId -> (Ptr () -> IO String) -> IO String
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SimpleElementId
a1 ((Ptr () -> IO String) -> IO String)
-> (Ptr () -> IO String) -> IO String
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
Ptr () -> IO (Ptr CChar)
getName'_ Ptr ()
a1' IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr CChar
res ->
Ptr CChar -> IO String
C2HSImp.peekCString Ptr CChar
res IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
res' ->
String -> IO String
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String
res')
{-# LINE 199 "./Sound/ALSA/Mixer/Internal.chs" #-}
getIndex :: (SimpleElementId) -> IO ((CUInt))
getIndex :: SimpleElementId -> IO CUInt
getIndex SimpleElementId
a1 =
SimpleElementId -> (Ptr () -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr SimpleElementId
a1 ((Ptr () -> IO CUInt) -> IO CUInt)
-> (Ptr () -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
Ptr () -> IO CUInt
getIndex'_ Ptr ()
a1' IO CUInt -> (CUInt -> IO CUInt) -> IO CUInt
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CUInt
res ->
let {res' :: CUInt
res' = CUInt -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
res} in
CUInt -> IO CUInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CUInt
res')
{-# LINE 206 "./Sound/ALSA/Mixer/Internal.chs" #-}
withMixer :: String -> (Mixer -> IO a) -> IO a
withMixer :: forall a. String -> (Mixer -> IO a) -> IO a
withMixer String
name Mixer -> IO a
f = IO (ProcessID, Mixer)
-> ((ProcessID, Mixer) -> IO ())
-> ((ProcessID, Mixer) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (do m <- IO Mixer
open
attach m name
load m
pid <- getProcessID
return (pid, m))
(\(ProcessID
creatorPID, Mixer Ptr Mixer
m) ->
do myPID <- IO ProcessID
getProcessID
when (myPID == creatorPID) $ freeMixer m)
(Mixer -> IO a
f (Mixer -> IO a)
-> ((ProcessID, Mixer) -> Mixer) -> (ProcessID, Mixer) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProcessID, Mixer) -> Mixer
forall a b. (a, b) -> b
snd)
cToBool :: CInt -> Bool
cToBool = CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool
cFromBool :: Bool -> Integer
cFromBool = Bool -> Integer
forall a. Num a => Bool -> a
fromBool
withSimpleElement :: SimpleElement -> (Element -> IO a) -> IO a
withSimpleElement :: forall a. SimpleElement -> (Ptr () -> IO a) -> IO a
withSimpleElement (Mixer
m, Ptr ()
s) Ptr () -> IO a
f = Ptr () -> IO a
f Ptr ()
s
channelToC :: Channel -> CInt
channelToC = Int -> CInt
forall a. Enum a => Int -> a
toEnum (Int -> CInt) -> (Channel -> Int) -> Channel -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Channel -> Int
forall a. Enum a => a -> Int
fromEnum
negOne :: (a -> b) -> b
negOne a -> b
f = a -> b
f (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$! a -> a
forall a. Num a => a -> a
negate a
1
isPlaybackMono :: (SimpleElement) -> IO ((Bool))
isPlaybackMono :: SimpleElement -> IO Bool
isPlaybackMono SimpleElement
a1 =
SimpleElement -> (Ptr () -> IO Bool) -> IO Bool
forall a. SimpleElement -> (Ptr () -> IO a) -> IO a
withSimpleElement SimpleElement
a1 ((Ptr () -> IO Bool) -> IO Bool) -> (Ptr () -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
Ptr () -> IO CInt
isPlaybackMono'_ Ptr ()
a1' IO CInt -> (CInt -> IO Bool) -> IO Bool
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 246 "./Sound/ALSA/Mixer/Internal.chs" #-}
isCaptureMono :: (SimpleElement) -> IO ((Bool))
isCaptureMono a1 =
withSimpleElement a1 $ \a1' ->
isCaptureMono'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 249 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCommonVolume :: (SimpleElement) -> IO ((Bool))
hasCommonVolume a1 =
withSimpleElement a1 $ \a1' ->
hasCommonVolume'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 252 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasPlaybackVolume :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolume a1 =
withSimpleElement a1 $ \a1' ->
hasPlaybackVolume'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 255 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasPlaybackVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackVolumeJoined a1 =
withSimpleElement a1 $ \a1' ->
hasPlaybackVolumeJoined'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 258 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCaptureVolume :: (SimpleElement) -> IO ((Bool))
hasCaptureVolume a1 =
withSimpleElement a1 $ \a1' ->
hasCaptureVolume'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 261 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCaptureVolumeJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureVolumeJoined a1 =
withSimpleElement a1 $ \a1' ->
hasCaptureVolumeJoined'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 264 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCommonSwitch :: (SimpleElement) -> IO ((Bool))
hasCommonSwitch a1 =
withSimpleElement a1 $ \a1' ->
hasCommonSwitch'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 267 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasPlaybackSwitch :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitch a1 =
withSimpleElement a1 $ \a1' ->
hasPlaybackSwitch'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 270 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasPlaybackSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasPlaybackSwitchJoined a1 =
withSimpleElement a1 $ \a1' ->
hasPlaybackSwitchJoined'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 273 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCaptureSwitch :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitch a1 =
withSimpleElement a1 $ \a1' ->
hasCaptureSwitch'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 276 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCaptureSwitchJoined :: (SimpleElement) -> IO ((Bool))
hasCaptureSwitchJoined a1 =
withSimpleElement a1 $ \a1' ->
hasCaptureSwitchJoined'_ a1' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 279 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasPlaybackChannel :: (SimpleElement) -> (Channel) -> IO ((Bool))
hasPlaybackChannel a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
hasPlaybackChannel'_ a1' a2' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 283 "./Sound/ALSA/Mixer/Internal.chs" #-}
hasCaptureChannel :: (SimpleElement) -> (Channel) -> IO ((Bool))
hasCaptureChannel a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
hasCaptureChannel'_ a1' a2' >>= \res ->
let {res' = C2HSImp.toBool res} in
return (res')
{-# LINE 287 "./Sound/ALSA/Mixer/Internal.chs" #-}
getPlaybackVolume :: (SimpleElement) -> (Channel) -> IO ((CLong))
getPlaybackVolume :: SimpleElement -> Channel -> IO CLong
getPlaybackVolume SimpleElement
a1 Channel
a2 =
SimpleElement -> (Ptr () -> IO CLong) -> IO CLong
forall a. SimpleElement -> (Ptr () -> IO a) -> IO a
withSimpleElement SimpleElement
a1 ((Ptr () -> IO CLong) -> IO CLong)
-> (Ptr () -> IO CLong) -> IO CLong
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
let {a2' :: CInt
a2' = Channel -> CInt
channelToC Channel
a2} in
(Ptr CLong -> IO CLong) -> IO CLong
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CLong -> IO CLong) -> IO CLong)
-> (Ptr CLong -> IO CLong) -> IO CLong
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
a3' ->
Ptr () -> CInt -> Ptr CLong -> IO CInt
getPlaybackVolume'_ Ptr ()
a1' CInt
a2' Ptr CLong
a3' IO CInt -> (CInt -> IO CLong) -> IO CLong
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
CInt -> IO ()
checkGetPlaybackVolume CInt
res IO () -> IO CLong -> IO CLong
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Ptr CLong -> IO CLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CLong
a3'IO CLong -> (CLong -> IO CLong) -> IO CLong
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CLong
a3'' ->
CLong -> IO CLong
return (a3'')
{-# LINE 296 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetPlaybackVolume = checkResult_ "snd_mixer_selem_get_playback_volume"
getCaptureVolume :: (SimpleElement) -> (Channel) -> IO ((CLong))
getCaptureVolume a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
(Ptr CLong -> IO CLong) -> IO CLong
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CLong -> IO CLong) -> IO CLong)
-> (Ptr CLong -> IO CLong) -> IO CLong
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
a3' ->
Ptr () -> CInt -> Ptr CLong -> IO CInt
getCaptureVolume'_ Ptr ()
a1' CInt
a2' Ptr CLong
a3' IO CInt -> (CInt -> IO CLong) -> IO CLong
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
CInt -> IO ()
checkGetCaptureVolume CInt
res IO () -> IO CLong -> IO CLong
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Ptr CLong -> IO CLong
forall a. Storable a => Ptr a -> IO a
peek Ptr CLong
a3'IO CLong -> (CLong -> IO CLong) -> IO CLong
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CLong
a3'' ->
return (a3'')
{-# LINE 303 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetCaptureVolume = checkResult_ "snd_mixer_selem_get_capture_volume"
getPlaybackDb :: (SimpleElement) -> (Channel) -> IO ((CLong))
getPlaybackDb a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
alloca $ \a3' ->
getPlaybackDb'_ a1' a2' a3' >>= \res ->
checkPlaybackDb res >>
peek a3'>>= \a3'' ->
return (a3'')
{-# LINE 310 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkPlaybackDb = checkResult_ "snd_mixer_selem_get_playback_dB"
getCaptureDb :: (SimpleElement) -> (Channel) -> IO ((CLong))
getCaptureDb a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
alloca $ \a3' ->
getCaptureDb'_ a1' a2' a3' >>= \res ->
checkCaptureDb res >>
peek a3'>>= \a3'' ->
return (a3'')
{-# LINE 317 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkCaptureDb = checkResult_ "snd_mixer_selem_get_capture_dB"
peekBool = (>>= return . cToBool) . peek
getPlaybackSwitch :: (SimpleElement) -> (Channel) -> IO ((Bool))
getPlaybackSwitch a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
alloca $ \a3' ->
getPlaybackSwitch'_ a1' a2' a3' >>= \res ->
checkPlaybackSwitch res >>
peekBool a3'>>= \a3'' ->
return (a3'')
{-# LINE 326 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkPlaybackSwitch = checkResult_ "snd_mixer_selem_get_playback_switch"
getCaptureSwitch :: (SimpleElement) -> (Channel) -> IO ((Bool))
getCaptureSwitch a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
alloca $ \a3' ->
getCaptureSwitch'_ a1' a2' a3' >>= \res ->
checkCaptureSwitch res >>
peekBool a3'>>= \a3'' ->
return (a3'')
{-# LINE 333 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkCaptureSwitch = checkResult_ "snd_mixer_selem_get_capture_switch"
getPlaybackVolumeRange :: (SimpleElement) -> IO ((CLong), (CLong))
getPlaybackVolumeRange a1 =
withSimpleElement a1 $ \a1' ->
alloca $ \a2' ->
alloca $ \a3' ->
getPlaybackVolumeRange'_ a1' a2' a3' >>= \res ->
checkGetPlaybackVolumeRange res >>
peek a2'>>= \a2'' ->
peek a3'>>= \a3'' ->
return (a2'', a3'')
{-# LINE 340 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_get_playback_volume_range"
getCaptureVolumeRange :: (SimpleElement) -> IO ((CLong), (CLong))
getCaptureVolumeRange a1 =
withSimpleElement a1 $ \a1' ->
alloca $ \a2' ->
alloca $ \a3' ->
getCaptureVolumeRange'_ a1' a2' a3' >>= \res ->
checkGetCaptureVolumeRange res >>
peek a2'>>= \a2'' ->
peek a3'>>= \a3'' ->
return (a2'', a3'')
{-# LINE 347 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetCaptureVolumeRange = checkResult_ "snd_mixer_selem_get_capture_volume_range"
getPlaybackDbRange :: (SimpleElement) -> IO ((CLong), (CLong))
getPlaybackDbRange a1 =
withSimpleElement a1 $ \a1' ->
alloca $ \a2' ->
alloca $ \a3' ->
getPlaybackDbRange'_ a1' a2' a3' >>= \res ->
checkGetPlaybackDbRange res >>
peek a2'>>= \a2'' ->
peek a3'>>= \a3'' ->
return (a2'', a3'')
{-# LINE 354 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetPlaybackDbRange = checkResult_ "snd_mixer_selem_get_playback_dB_range"
getCaptureDbRange :: (SimpleElement) -> IO ((CLong), (CLong))
getCaptureDbRange a1 =
withSimpleElement a1 $ \a1' ->
alloca $ \a2' ->
alloca $ \a3' ->
getCaptureDbRange'_ a1' a2' a3' >>= \res ->
checkGetCaptureDbRange res >>
peek a2'>>= \a2'' ->
peek a3'>>= \a3'' ->
return (a2'', a3'')
{-# LINE 361 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkGetCaptureDbRange = checkResult_ "snd_mixer_selem_get_capture_dB_range"
setPlaybackVolume :: (SimpleElement) -> (Channel) -> (CLong) -> IO ()
setPlaybackVolume :: SimpleElement -> Channel -> CLong -> IO ()
setPlaybackVolume SimpleElement
a1 Channel
a2 CLong
a3 =
SimpleElement -> (Ptr () -> IO ()) -> IO ()
forall a. SimpleElement -> (Ptr () -> IO a) -> IO a
withSimpleElement SimpleElement
a1 ((Ptr () -> IO ()) -> IO ()) -> (Ptr () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ()
a1' ->
let {a2' :: CInt
a2' = Channel -> CInt
channelToC Channel
a2} in
let {a3' :: CLong
a3' = CLong -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
a3} in
Ptr () -> CInt -> CLong -> IO CInt
setPlaybackVolume'_ Ptr ()
a1' CInt
a2' CLong
a3' IO CInt -> (CInt -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
res ->
CInt -> IO ()
checkSetPlaybackVolume CInt
res IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# LINE 372 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackVolume = checkResult_ "snd_mixer_selem_set_playback_volume"
setCaptureVolume :: (SimpleElement) -> (Channel) -> (CLong) -> IO ()
setCaptureVolume a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
let {a3' = fromIntegral a3} in
setCaptureVolume'_ a1' a2' a3' >>= \res ->
checkSetCaptureVolume res >>
return ()
{-# LINE 379 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureVolume = checkResult_ "snd_mixer_selem_set_capture_volume"
setPlaybackDb :: (SimpleElement) -> (Channel) -> (CLong) -> IO ()
setPlaybackDb a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
let {a3' = fromIntegral a3} in
negOne $ \a4' ->
setPlaybackDb'_ a1' a2' a3' a4' >>= \res ->
checkSetPlaybackDb res >>
return ()
{-# LINE 387 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackDb = checkResult_ "snd_mixer_selem_set_playback_dB"
setCaptureDb :: (SimpleElement) -> (Channel) -> (CLong) -> IO ()
setCaptureDb a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
let {a3' = fromIntegral a3} in
negOne $ \a4' ->
setCaptureDb'_ a1' a2' a3' a4' >>= \res ->
checkSetCaptureDb res >>
return ()
{-# LINE 395 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureDb = checkResult_ "snd_mixer_selem_set_capture_dB"
setPlaybackVolumeAll :: (SimpleElement) -> (CLong) -> IO ()
setPlaybackVolumeAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
setPlaybackVolumeAll'_ a1' a2' >>= \res ->
checkSetPlaybackVolumeAll res >>
return ()
{-# LINE 401 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackVolumeAll = checkResult_ "snd_mixer_selem_set_playback_volume_all"
setCaptureVolumeAll :: (SimpleElement) -> (CLong) -> IO ()
setCaptureVolumeAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
setCaptureVolumeAll'_ a1' a2' >>= \res ->
checkSetCaptureVolumeAll res >>
return ()
{-# LINE 407 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureVolumeAll = checkResult_ "snd_mixer_selem_set_capture_volume_all"
setPlaybackDbAll :: (SimpleElement) -> (CLong) -> IO ()
setPlaybackDbAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
negOne $ \a3' ->
setPlaybackDbAll'_ a1' a2' a3' >>= \res ->
checkSetPlaybackDbAll res >>
return ()
{-# LINE 414 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackDbAll = checkResult_ "snd_mixer_selem_set_playback_dB_all"
setCaptureDbAll :: (SimpleElement) -> (CLong) -> IO ()
setCaptureDbAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
negOne $ \a3' ->
setCaptureDbAll'_ a1' a2' a3' >>= \res ->
checkSetCaptureDbAll res >>
return ()
{-# LINE 421 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureDbAll = checkResult_ "snd_mixer_selem_set_capture_dB_all"
setPlaybackSwitch :: (SimpleElement) -> (Channel) -> (Bool) -> IO ()
setPlaybackSwitch a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
let {a3' = C2HSImp.fromBool a3} in
setPlaybackSwitch'_ a1' a2' a3' >>= \res ->
checkSetPlaybackSwitch res >>
return ()
{-# LINE 428 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackSwitch = checkResult_ "snd_mixer_selem_set_playback_switch"
setCaptureSwitch :: (SimpleElement) -> (Channel) -> (Bool) -> IO ()
setCaptureSwitch a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = channelToC a2} in
let {a3' = C2HSImp.fromBool a3} in
setCaptureSwitch'_ a1' a2' a3' >>= \res ->
checkSetCaptureSwitch res >>
return ()
{-# LINE 435 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureSwitch = checkResult_ "snd_mixer_selem_set_capture_switch"
setPlaybackSwitchAll :: (SimpleElement) -> (Bool) -> IO ()
setPlaybackSwitchAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = C2HSImp.fromBool a2} in
setPlaybackSwitchAll'_ a1' a2' >>= \res ->
checkSetPlaybackSwitchAll res >>
return ()
{-# LINE 441 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackSwitchAll = checkResult_ "snd_mixer_selem_set_playback_switch_all"
setCaptureSwitchAll :: (SimpleElement) -> (Bool) -> IO ()
setCaptureSwitchAll a1 a2 =
withSimpleElement a1 $ \a1' ->
let {a2' = C2HSImp.fromBool a2} in
setCaptureSwitchAll'_ a1' a2' >>= \res ->
checkSetCaptureSwitchAll res >>
return ()
{-# LINE 447 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureSwitchAll = checkResult_ "snd_mixer_selem_set_capture_switch_all"
setPlaybackVolumeRange' :: (SimpleElement) -> (CLong) -> (CLong) -> IO ()
setPlaybackVolumeRange' a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
setPlaybackVolumeRange''_ a1' a2' a3' >>= \res ->
checkSetPlaybackVolumeRange res >>
return ()
{-# LINE 454 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetPlaybackVolumeRange = checkResult_ "snd_mixer_selem_set_playback_volume_range"
setCaptureVolumeRange' :: (SimpleElement) -> (CLong) -> (CLong) -> IO ()
setCaptureVolumeRange' a1 a2 a3 =
withSimpleElement a1 $ \a1' ->
let {a2' = fromIntegral a2} in
let {a3' = fromIntegral a3} in
setCaptureVolumeRange''_ a1' a2' a3' >>= \res ->
checkSetCaptureVolumeRange res >>
return ()
{-# LINE 461 "./Sound/ALSA/Mixer/Internal.chs" #-}
checkSetCaptureVolumeRange = checkResult_ "snd_mixer_selem_set_capture_volume_range"
setPlaybackVolumeRange m = uncurry (setPlaybackVolumeRange' m)
setCaptureVolumeRange m = uncurry (setCaptureVolumeRange' m)
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_attach"
attach'_ :: ((Mixer) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_load"
sndMixerLoad'_ :: ((Mixer) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_register"
sndMixerSelemRegister'_ :: ((Mixer) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr ())) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_malloc"
sndMixerSelemIdMalloc'_ :: ((C2HSImp.Ptr (C2HSImp.Ptr (()))) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_id"
sndMixerSelemGetId'_ :: ((Element) -> ((C2HSImp.Ptr (())) -> (IO ())))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_first_elem"
sndMixerFirstElem'_ :: ((Mixer) -> (IO (Element)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_last_elem"
sndMixerLastElem'_ :: ((Mixer) -> (IO (Element)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_elem_next"
sndMixerElemNext'_ :: ((Element) -> (IO (Element)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_find_selem"
sndMixerFindSelem'_ :: ((Mixer) -> ((C2HSImp.Ptr (())) -> (IO (Element))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_get_name"
getName'_ :: ((C2HSImp.Ptr (())) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_id_get_index"
getIndex'_ :: ((C2HSImp.Ptr (())) -> (IO C2HSImp.CUInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_is_playback_mono"
isPlaybackMono'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_is_capture_mono"
isCaptureMono'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_common_volume"
hasCommonVolume'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_volume"
hasPlaybackVolume'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_volume_joined"
hasPlaybackVolumeJoined'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_volume"
hasCaptureVolume'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_volume_joined"
hasCaptureVolumeJoined'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_common_switch"
hasCommonSwitch'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_switch"
hasPlaybackSwitch'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_switch_joined"
hasPlaybackSwitchJoined'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_switch"
hasCaptureSwitch'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_switch_joined"
hasCaptureSwitchJoined'_ :: ((Element) -> (IO C2HSImp.CInt))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_playback_channel"
hasPlaybackChannel'_ :: ((Element) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_has_capture_channel"
hasCaptureChannel'_ :: ((Element) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_volume"
getPlaybackVolume'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_volume"
getCaptureVolume'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_dB"
getPlaybackDb'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_dB"
getCaptureDb'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_switch"
getPlaybackSwitch'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_switch"
getCaptureSwitch'_ :: ((Element) -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CInt) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_volume_range"
getPlaybackVolumeRange'_ :: ((Element) -> ((C2HSImp.Ptr C2HSImp.CLong) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_volume_range"
getCaptureVolumeRange'_ :: ((Element) -> ((C2HSImp.Ptr C2HSImp.CLong) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_playback_dB_range"
getPlaybackDbRange'_ :: ((Element) -> ((C2HSImp.Ptr C2HSImp.CLong) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_get_capture_dB_range"
getCaptureDbRange'_ :: ((Element) -> ((C2HSImp.Ptr C2HSImp.CLong) -> ((C2HSImp.Ptr C2HSImp.CLong) -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume"
setPlaybackVolume'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume"
setCaptureVolume'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_dB"
setPlaybackDb'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_dB"
setCaptureDb'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume_all"
setPlaybackVolumeAll'_ :: ((Element) -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume_all"
setCaptureVolumeAll'_ :: ((Element) -> (C2HSImp.CLong -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_dB_all"
setPlaybackDbAll'_ :: ((Element) -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_dB_all"
setCaptureDbAll'_ :: ((Element) -> (C2HSImp.CLong -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_switch"
setPlaybackSwitch'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_switch"
setCaptureSwitch'_ :: ((Element) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_switch_all"
setPlaybackSwitchAll'_ :: ((Element) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_switch_all"
setCaptureSwitchAll'_ :: ((Element) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_playback_volume_range"
setPlaybackVolumeRange''_ :: ((Element) -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))
foreign import ccall safe "Sound/ALSA/Mixer/Internal.chs.h snd_mixer_selem_set_capture_volume_range"
setCaptureVolumeRange''_ :: ((Element) -> (C2HSImp.CLong -> (C2HSImp.CLong -> (IO C2HSImp.CInt))))