module Monky.Alsa
( VOLHandle
, destroyVOLHandle
, getMute
, getVolumeRaw
, getVolumePercent
, updateVOLH
, getVOLHandle
, isLoaded
, getPollFDs
)
where
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Data.IORef
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CInt(..), CShort, CLong)
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import Monky.Template
import System.Posix.Types
import Control.Applicative ((<$>))
data PollFD = POLLFD CInt CShort CShort
instance Storable PollFD where
sizeOf _ = (8)
alignment _ = alignment (undefined :: CLong)
peek p = do
fd <- (\hsc_ptr -> peekByteOff hsc_ptr 0) p
events <- (\hsc_ptr -> peekByteOff hsc_ptr 4) p
revents <- (\hsc_ptr -> peekByteOff hsc_ptr 6) p
return (POLLFD fd events revents)
poke p (POLLFD fd events revents) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p fd
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p events
(\hsc_ptr -> pokeByteOff hsc_ptr 6) p revents
type PollFDPtr = Ptr PollFD
liftExceptT :: ((a -> m (Either e b)) -> m (Either e b)) -> (a -> ExceptT e m b) -> ExceptT e m b
liftExceptT g f = ExceptT (g (runExceptT . f))
data RegOpt
data MClass
data Mixer
type MixerHandle = Ptr Mixer
type MixerHandleAlloc = Ptr MixerHandle
data Sid
type SidHandle = Ptr Sid
type SidHandleAlloc = Ptr SidHandle
data Elem
type ElemHandle = Ptr Elem
importLib "LibAlsa" "libasound.so"
[ ("mixer_open", "snd_mixer_open", "MixerHandleAlloc -> Int -> IO CInt")
, ("mixer_attach", "snd_mixer_attach", "MixerHandle -> CString -> IO CInt")
, ("mixer_register", "snd_mixer_selem_register", "MixerHandle -> Ptr RegOpt -> Ptr MClass -> IO CInt")
, ("mixer_load", "snd_mixer_load", "MixerHandle -> IO CInt")
, ("sid_sindex", "snd_mixer_selem_id_set_index", "SidHandle -> CInt -> IO ()")
, ("sid_sname", "snd_mixer_selem_id_set_name", "SidHandle -> CString -> IO ()")
, ("sid_alloc", "snd_mixer_selem_id_malloc", "SidHandleAlloc -> IO CInt")
, ("sid_free", "snd_mixer_selem_id_free", "SidHandle -> IO ()")
, ("elem_gvrange", "snd_mixer_selem_get_playback_volume_range", "ElemHandle -> Ptr CInt -> Ptr CInt -> IO CInt")
, ("elem_gvol", "snd_mixer_selem_get_playback_volume", "ElemHandle -> CInt -> Ptr CInt -> IO CInt")
, ("elem_gmute", "snd_mixer_selem_get_playback_switch", "ElemHandle -> CInt -> Ptr CInt -> IO CInt")
, ("elem_find", "snd_mixer_find_selem", "MixerHandle -> SidHandle -> IO ElemHandle")
, ("mixer_handle_events", "snd_mixer_handle_events", "MixerHandle -> IO ()")
, ("get_pdescs", "snd_mixer_poll_descriptors", "MixerHandle -> PollFDPtr -> CInt -> IO CInt")
, ("get_pdescc", "snd_mixer_poll_descriptors_count", "MixerHandle -> IO CInt")
, ("mixer_close", "snd_mixer_close", "MixerHandle -> IO Int")
]
getPollDescs :: MixerHandle -> LibAlsa -> IO [CInt]
getPollDescs h l = do
count <- get_pdescc l h
allocaArray (fromIntegral count) $ \ptr -> do
c2 <- get_pdescs l h ptr count
if count == c2
then map (\(POLLFD fd _ _) -> fd) <$> (peekArray (fromIntegral c2) ptr)
else error "libalsa returned more (or less) fds than it adveritses!"
openMixer :: LibAlsa -> ExceptT Int IO MixerHandle
openMixer l = liftExceptT alloca $ \ptr -> do
rval <- liftIO (mixer_open l ptr 0)
if rval < 0
then throwE $ fromIntegral rval
else liftIO (peek ptr)
mixerAttach :: MixerHandle -> String -> LibAlsa -> ExceptT Int IO ()
mixerAttach handle card l = do
rval <- liftIO (withCString card $ mixer_attach l handle)
if rval < 0
then throwE $ fromIntegral rval
else liftIO (return ())
mixerRegister :: MixerHandle -> LibAlsa -> ExceptT Int IO ()
mixerRegister handle l = do
rval <- liftIO (mixer_register l handle nullPtr nullPtr)
if rval < 0
then throwE $ fromIntegral rval
else liftIO (return ())
mixerLoad :: MixerHandle -> LibAlsa -> ExceptT Int IO ()
mixerLoad handle l = do
rval <- liftIO (mixer_load l handle)
if rval < 0
then throwE $ fromIntegral rval
else liftIO (return ())
withSid :: LibAlsa -> (SidHandle -> IO a) -> IO a
withSid l fun = alloca $ \ptr -> do
rval <- sid_alloc l ptr
if rval < 0
then error "Failed to allocate sid"
else do
handle <- peek ptr
comp <- fun handle
sid_free l handle
return comp
sidSet :: SidHandle -> Int -> String -> LibAlsa -> IO ()
sidSet handle index name l = do
withCString name $ sid_sname l handle
sid_sindex l handle $ fromIntegral index
getElem :: MixerHandle -> String -> Int -> LibAlsa -> IO ElemHandle
getElem handle name index l = withSid l $ \sid -> do
sidSet sid index name l
elem_find l handle sid
isMute :: ElemHandle -> LibAlsa -> IO Bool
isMute handle l = alloca $ \ptr -> do
_ <- elem_gmute l handle 0 ptr
val <- peek ptr
return $ val == 0
getVolumeRange :: ElemHandle -> LibAlsa -> IO (Int, Int)
getVolumeRange handle l = alloca $ \lower -> alloca $ \upper -> do
_ <- elem_gvrange l handle lower upper
lowerv <- peek lower
upperv <- peek upper
return (fromIntegral lowerv, fromIntegral upperv)
getVolume :: ElemHandle -> LibAlsa -> IO Int
getVolume handle l = alloca $ \ptr -> do
_ <- elem_gvol l handle 0 ptr
val <- peek ptr
return $ fromIntegral val
getMixerHandle :: String -> LibAlsa -> ExceptT Int IO MixerHandle
getMixerHandle card l = do
handle <- openMixer l
mixerAttach handle card l
mixerRegister handle l
mixerLoad handle l
return handle
percentize :: Int -> Int -> Int -> Int
percentize val lower upper = 100 * (val lower) `div` (upperlower)
data VOLHandle = VOLH LibAlsa MixerHandle ElemHandle (IORef Int) (IORef Bool) Int Int | Err
updateVOLH :: VOLHandle -> IO ()
updateVOLH (VOLH l handle ehandle valr muter _ _) = do
mixer_handle_events l handle
val <- getVolume ehandle l
mute <- isMute ehandle l
writeIORef valr val
writeIORef muter mute
updateVOLH Err = return ()
getVolumeRaw :: VOLHandle -> IO Int
getVolumeRaw (VOLH _ _ _ valr _ _ _) = readIORef valr
getVolumeRaw Err = return 0
getVolumePercent :: VOLHandle -> IO Int
getVolumePercent (VOLH _ _ _ valr _ lower upper) = do
val <- readIORef valr
return $ percentize val lower upper
getVolumePercent Err = return 0
getMute :: VOLHandle -> IO Bool
getMute (VOLH _ _ _ _ muter _ _) = readIORef muter
getMute Err = return True
getVOLHandleInt :: Either Int MixerHandle -> LibAlsa -> IO VOLHandle
getVOLHandleInt (Right handle) l = do
ehandle <- getElem handle "Master" 0 l
if ehandle == nullPtr
then return Err
else do
(lower, upper) <- getVolumeRange ehandle l
val <- getVolume ehandle l
mute <- isMute ehandle l
volref <- newIORef val
muteref <- newIORef mute
return (VOLH l handle ehandle volref muteref lower upper)
getVOLHandleInt _ _ = return Err
isLoaded :: VOLHandle -> Bool
isLoaded Err = False
isLoaded _ = True
getPollFDs :: VOLHandle -> IO [Fd]
getPollFDs (VOLH l h _ _ _ _ _) = map Fd <$> getPollDescs h l
getPollFDs Err = return []
destroyVOLHandle :: VOLHandle -> IO ()
destroyVOLHandle (VOLH a m _ _ _ _ _) =
mixer_close a m >> destroyLibAlsa a
destroyVOLHandle Err = return ()
getVOLHandle :: String
-> IO VOLHandle
getVOLHandle card = do
l <- getLibAlsa
handle <- runExceptT (getMixerHandle card l)
getVOLHandleInt handle l