-------------------------------------------------------------------------------- -- | -- Module : Sound.ALSA.Sequencer.Port -- Copyright : (c) Henning Thielemann, 2010 -- (c) Iavor S. Diatchki, 2007 -- License : BSD3 -- -- Maintainer: Henning Thielemann -- Stability : provisional -- -- This module contains functions for working with ports. -- Reference: -- -------------------------------------------------------------------------------- module Sound.ALSA.Sequencer.Port.Info ( T , get , getAny , queryFirst , queryNext , set , copy , clone , getPort , getClient , getAddr , getName , getCapability , getMidiChannels , getMidiVoices , getSynthVoices , getPortSpecified , getTimestamping , getTimestampReal , getTimestampQueue , getReadUse , getWriteUse , setPort , setClient , setAddr , setName , setCapability , setMidiChannels , setSynthVoices , setMidiVoices , setPortSpecified , setTimestamping , setTimestampReal , setTimestampQueue ) where import qualified Sound.ALSA.Sequencer.Marshal.Client as Client import qualified Sound.ALSA.Sequencer.Marshal.Port as Port import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import qualified Sound.ALSA.Sequencer.Area as Area import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr import qualified Sound.ALSA.Exception as Exc import Foreign.C.Types (CInt, ) import Foreign.Ptr (Ptr, ) import Foreign.Marshal.Alloc (alloca, ) import Foreign.Storable (poke, peek, ) import Data.Word (Word, ) type T = Area.PortInfo type T_ = Area.PortInfo_ -- | Create a new information area filled with data about a specific -- port on our client. get :: Seq.T mode -> Port.T -> IO T get (Seq.Cons h) p = do info <- Area.port_info_malloc Exc.checkResult "get_port_info" =<< Area.with_port_info info (snd_seq_get_port_info h (Port.exp p)) return info foreign import ccall "alsa/asoundlib.h snd_seq_get_port_info" snd_seq_get_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt -- | Create a new information area filled with data about an given -- port on a given client. getAny :: Seq.T mode -> Client.T -> Port.T -> IO T getAny (Seq.Cons h) c p = do info <- Area.port_info_malloc Exc.checkResult "get_any_port_info" =<< Area.with_port_info info (snd_seq_get_any_port_info h (Client.exp c) (Port.exp p)) return info foreign import ccall "alsa/asoundlib.h snd_seq_get_any_port_info" snd_seq_get_any_port_info :: Ptr Seq.Core -> CInt -> CInt -> Ptr T_ -> IO CInt -- | Get information about the first port on our client. queryFirst :: Seq.T mode -> IO T queryFirst s = do x <- Area.port_info_malloc Area.with_port_info x (`Area.snd_seq_port_info_set_port` (-1)) queryNext s x return x -- | Get information about the port with the next biggest identifier. -- If a matching port is found, then its information is stored in the -- given area, otherwise we throw an error. queryNext :: Seq.T mode -> T -> IO () queryNext (Seq.Cons h) info = Exc.checkResult_ "query_next_port" =<< Area.with_port_info info (snd_seq_query_next_port h) foreign import ccall "alsa/asoundlib.h snd_seq_query_next_port" snd_seq_query_next_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt -- | Set the information for the sequencer port based on the data -- in the given information area. set :: Seq.T mode -> Port.T -> T -> IO () set (Seq.Cons h) p info = Exc.checkResult_ "set_port_info" =<< Area.with_port_info info (snd_seq_set_port_info h (Port.exp p)) foreign import ccall "alsa/asoundlib.h snd_seq_set_port_info" snd_seq_set_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt -- | Get the address of the information area. getAddr :: T -> IO Addr.T getAddr i = peek =<< Area.with_port_info i snd_seq_port_info_get_addr foreign import ccall "alsa/asoundlib.h snd_seq_port_info_get_addr" snd_seq_port_info_get_addr :: Ptr T_ -> IO (Ptr Addr.T) -- | Set the port address. setAddr :: T -> Addr.T -> IO () setAddr i c = alloca $ \p -> poke p c >> Area.with_port_info i (`snd_seq_port_info_set_addr` p) foreign import ccall "alsa/asoundlib.h snd_seq_port_info_set_addr" snd_seq_port_info_set_addr :: Ptr T_ -> Ptr Addr.T -> IO () copy :: T -> T -> IO () clone :: T -> IO T getPort :: T -> IO Port.T getClient :: T -> IO Client.T getName :: T -> IO String getCapability :: T -> IO Port.Cap getMidiChannels :: T -> IO Word getMidiVoices :: T -> IO Word getSynthVoices :: T -> IO Word getPortSpecified :: T -> IO Bool getTimestamping :: T -> IO Bool getTimestampReal :: T -> IO Bool getTimestampQueue :: T -> IO Queue.T getReadUse :: T -> IO Word getWriteUse :: T -> IO Word setPort :: T -> Port.T -> IO () setClient :: T -> Client.T -> IO () setName :: T -> String -> IO () setCapability :: T -> Port.Cap -> IO () setMidiChannels :: T -> Word -> IO () setSynthVoices :: T -> Word -> IO () setMidiVoices :: T -> Word -> IO () setPortSpecified :: T -> Bool -> IO () setTimestamping :: T -> Bool -> IO () setTimestampReal :: T -> Bool -> IO () setTimestampQueue :: T -> Queue.T -> IO () copy = Area.port_info_copy clone = Area.port_info_clone getPort = Area.port_info_get_port getClient = Area.port_info_get_client getName = Area.port_info_get_name getCapability = Area.port_info_get_capability getMidiChannels = Area.port_info_get_midi_channels getMidiVoices = Area.port_info_get_midi_voices getSynthVoices = Area.port_info_get_synth_voices getPortSpecified = Area.port_info_get_port_specified getTimestamping = Area.port_info_get_timestamping getTimestampReal = Area.port_info_get_timestamp_real getTimestampQueue = Area.port_info_get_timestamp_queue getReadUse = Area.port_info_get_read_use getWriteUse = Area.port_info_get_write_use setPort = Area.port_info_set_port setClient = Area.port_info_set_client setName = Area.port_info_set_name setCapability = Area.port_info_set_capability setMidiChannels = Area.port_info_set_midi_channels setSynthVoices = Area.port_info_set_synth_voices setMidiVoices = Area.port_info_set_midi_voices setPortSpecified = Area.port_info_set_port_specified setTimestamping = Area.port_info_set_timestamping setTimestampReal = Area.port_info_set_timestamp_real setTimestampQueue = Area.port_info_set_timestamp_queue