module Sound.ALSA.Sequencer.Client.Info
( T
, get
, getAny
, queryFirst
, queryNext
, set
, modify
, copy
, clone
, getClient
, getType
, getName
, getBroadcastFilter
, getErrorBounce
, getNumPorts
, getEventLost
, setClient
, setName
, setBroadcastFilter
, setErrorBounce
, filterClear
, filterAdd
, filterDel
, filterCheck
) where
import qualified Sound.ALSA.Sequencer.Client.Info.EventFilter as Filter
import qualified Sound.ALSA.Sequencer.Marshal.Client as Client
import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq
import qualified Sound.ALSA.Sequencer.Area as Area
import qualified Sound.ALSA.Sequencer.Marshal.Event as Event
import qualified Sound.ALSA.Exception as Exc
import Foreign.C.Types(CInt, )
import Foreign.Ptr(Ptr, )
import Data.Word (Word, )
import Control.Monad (guard, )
type T = Area.ClientInfo
type T_ = Area.ClientInfo_
get :: Seq.T mode -> IO T
get (Seq.Cons h) =
do info <- Area.client_info_malloc
Exc.checkResult_ "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h)
return info
foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_client_info"
snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt
getAny :: Seq.T mode -> Client.T -> IO T
getAny (Seq.Cons h) c =
do info <- Area.client_info_malloc
Exc.checkResult_ "get_any_client_info" =<< Area.with_client_info info
(snd_seq_get_any_client_info h (Client.exp c))
return info
foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_client_info"
snd_seq_get_any_client_info
:: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt
queryFirst :: Seq.T mode -> IO T
queryFirst h =
do x <- Area.client_info_malloc
Area.with_client_info x (`Area.snd_seq_client_info_set_client` (1))
_b <- queryNext h x
return x
queryNext :: Seq.T mode -> T
-> IO Bool
queryNext (Seq.Cons h) info =
Exc.checkResultMaybe "query_next_client"
(const True) (\x -> guard (x == 2) >> return False)
=<< Area.with_client_info info (snd_seq_query_next_client h)
foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_client"
snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt
set :: Seq.T mode -> T -> IO ()
set (Seq.Cons h) info =
Exc.checkResult_ "set_client_info" =<< Area.with_client_info info (snd_seq_set_client_info h)
foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_info"
snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt
modify :: Seq.T mode -> (T -> IO T) -> IO ()
modify ss f = set ss =<< f =<< get ss
filterClear :: T -> IO ()
filterAdd :: Event.Type e => T -> e -> IO ()
filterDel :: Event.Type e => T -> e -> IO ()
filterCheck :: Event.Type e => T -> e -> IO Bool
filterClear = Filter.clear
filterAdd = Filter.add
filterDel = Filter.delete
filterCheck = Filter.check
copy :: T -> T -> IO ()
clone :: T -> IO T
getClient :: T -> IO Client.T
getType :: T -> IO Client.Type
getName :: T -> IO String
getBroadcastFilter :: T -> IO Bool
getErrorBounce :: T -> IO Bool
getNumPorts :: T -> IO Word
getEventLost :: T -> IO Word
setClient :: T -> Client.T -> IO ()
setName :: T -> String -> IO ()
setBroadcastFilter :: T -> Bool -> IO ()
setErrorBounce :: T -> Bool -> IO ()
copy = Area.client_info_copy
clone = Area.client_info_clone
getClient = Area.client_info_get_client
getType = Area.client_info_get_type
getName = Area.client_info_get_name
getBroadcastFilter = Area.client_info_get_broadcast_filter
getErrorBounce = Area.client_info_get_error_bounce
getNumPorts = Area.client_info_get_num_ports
getEventLost = Area.client_info_get_event_lost
setClient = Area.client_info_set_client
setName = Area.client_info_set_name
setBroadcastFilter = Area.client_info_set_broadcast_filter
setErrorBounce = Area.client_info_set_error_bounce