{-# OPTIONS -fffi #-} module Sound.ALSA.Sequencer.FFI where import Foreign.C import Foreign import Control.Monad (liftM, liftM2, zipWithM_) import Data.Array (inRange, Ix) import Data.List (find) newtype T = Cons (Ptr ()) instance Storable T where sizeOf (Cons x) = sizeOf x alignment (Cons x) = alignment x peek = liftM Cons . peek . castPtr poke ptr (Cons x) = poke (castPtr ptr) x -- size: 12 bytes data EventDataUnion = DataUnknown CUInt CUInt CUInt | Note { noteChannel :: CUChar, notePitch :: CUChar, noteVelocity :: CUChar, noteOffVelocity :: CUChar, noteDuration :: CUInt } | Control { controlChannel :: CUChar, controlParameter :: CUInt, controlValue :: CInt } | QueueEv { queueId :: Queue, queueControl :: QueueControl } | Connect { connectSender :: Address, connectDest :: Address } | Fixed deriving Show isConnect :: EventDataUnion -> Bool isConnect Connect{} = True isConnect _ = False isFixed :: EventDataUnion -> Bool isFixed Fixed{} = True isFixed _ = False isNote :: EventDataUnion -> Bool isNote Note{} = True isNote _ = False isController :: EventDataUnion -> Bool isController Control{} = True isController _ = False {- instance Storable EventDataUnion where sizeOf _ = 12 alignment _ = 4 peek ptr = liftM3 DataUnknown (peekByteOff ptr 0) (peekByteOff ptr 4) (peekByteOff ptr 8) poke = pokeEventData -} peekEventData :: Ptr EventDataUnion -> EventType -> IO EventDataUnion peekEventData ptr t = select -- (fail ("peekEventData: " ++ show t)) $ (return Fixed) $ (t == EventPortSubscribed, peekConnect ptr) : (inRange (EventNote, EventKeyPressure) t, peekNote ptr) : (inRange (EventController, EventRegisteredParameter) t, peekControl ptr) : (t == EventSensing, return Fixed) : [] peekConnect :: Ptr EventDataUnion -> IO EventDataUnion peekConnect ptr = liftM2 Connect (peekByteOff ptr 0) (peekByteOff ptr 2) peekNote :: Ptr EventDataUnion -> IO EventDataUnion peekNote ptr = do channel <- peekByteOff ptr 0 note <- peekByteOff ptr 1 velocity <- peekByteOff ptr 2 offVelocity <- peekByteOff ptr 3 duration <- peekByteOff ptr 4 return $ Note channel note velocity offVelocity duration peekControl :: Ptr EventDataUnion -> IO EventDataUnion peekControl ptr = do channel <- peekByteOff ptr 0 param <- peekByteOff ptr 4 value <- peekByteOff ptr 8 return $ Control channel param value pokeEventData :: Ptr EventDataUnion -> EventDataUnion -> IO () pokeEventData ptr dat = case dat of Note { noteChannel = channel, notePitch = pitch, noteVelocity = velocity, noteOffVelocity = offVelocity, noteDuration = duration} -> do pokeByteOff ptr 0 channel pokeByteOff ptr 1 pitch pokeByteOff ptr 2 velocity pokeByteOff ptr 3 offVelocity pokeByteOff ptr 4 duration Control { controlChannel = channel, controlParameter = param, controlValue = value} -> do pokeByteOff ptr 0 channel pokeByteOff ptr 4 param pokeByteOff ptr 8 value QueueEv { queueId = q, queueControl = qc} -> do pokeByteOff ptr 0 q pokeQueueControl (plusPtr ptr 4) qc DataUnknown a b c -> let intPtr = castPtr ptr in do pokeElemOff intPtr 0 a pokeElemOff intPtr 1 b pokeElemOff intPtr 2 c Connect { connectSender = src, connectDest = dst} -> let addrPtr = castPtr ptr in do pokeElemOff addrPtr 0 src pokeElemOff addrPtr 1 dst Fixed -> return () class TimeValue a -- size: 8 bytes data RealTime = RealTime { tv_sec :: CUInt, tv_nsec :: CUInt } deriving Show instance TimeValue RealTime instance Storable RealTime where sizeOf (RealTime a b) = sizeOf a + sizeOf b alignment (RealTime a _) = alignment a peek ptr = liftM2 RealTime (peekByteOff ptr 0) (peekByteOff ptr 4) poke ptr (RealTime a b) = do pokeByteOff ptr 0 a pokeByteOff ptr 4 b newtype TickTime = TickTime { tv_ticks :: CUInt } deriving Show instance TimeValue TickTime instance Storable TickTime where sizeOf (TickTime a) = sizeOf a alignment (TickTime a) = alignment a peek ptr = liftM TickTime (peekByteOff ptr 0) poke ptr (TickTime a) = pokeByteOff ptr 0 a data TimeUnit = TimeUnitReal | TimeUnitTick deriving (Eq, Ord, Enum, Show) data TimeMode = TimeModeAbsolute | TimeModeRelative deriving (Eq, Ord, Enum, Show) -- size: 8 bytes data TimeStamp = TimeStampTick TickTime | TimeStampReal RealTime deriving Show peekTimeStamp :: TimeUnit -> Ptr TimeStamp -> IO TimeStamp peekTimeStamp unit ptr = case unit of TimeUnitReal -> liftM TimeStampReal (peekByteOff ptr 0) TimeUnitTick -> liftM TimeStampTick (peekByteOff ptr 0) pokeTimeStamp :: Ptr TimeStamp -> TimeStamp -> IO TimeUnit pokeTimeStamp ptr ts = case ts of TimeStampReal t -> pokeByteOff ptr 0 t >> return TimeUnitReal TimeStampTick t -> pokeByteOff ptr 0 t >> return TimeUnitTick newtype ClientId = ClientId CUInt deriving (Eq, Show) instance Enum ClientId where toEnum = ClientId . fromIntegral fromEnum (ClientId x) = fromIntegral x instance Storable ClientId where sizeOf = sizeOf . enumToChar alignment = alignment . enumToChar peek = liftM enumFromChar . peek . castPtr poke ptr = poke (castPtr ptr) . enumToChar {- known client numbers -} {- | system client -} clientSystem :: ClientId clientSystem = ClientId 0 {- | dummy ports -} clientDummy :: ClientId clientDummy = ClientId 62 {- | OSS sequencer emulator -} clientOSS :: ClientId clientOSS = ClientId 63 newtype Port = Port CUInt deriving (Eq, Show) instance Enum Port where toEnum = Port . fromIntegral fromEnum (Port x) = fromIntegral x instance Storable Port where sizeOf = sizeOf . enumToChar alignment = alignment . enumToChar peek = liftM enumFromChar . peek . castPtr poke ptr = poke (castPtr ptr) . enumToChar {- | system timer port -} portSystemTimer :: Port portSystemTimer = Port 0 {- | system announce port -} portSystemAnnounce :: Port portSystemAnnounce = Port 1 -- size: 2 bytes data Address = Address { client :: ClientId, port :: Port } deriving Show instance Storable Address where sizeOf _ = 2 alignment _ = 4 peek ptr = liftM2 Address (peekByteOff ptr 0) (peekByteOff ptr 1) poke ptr (Address a b) = do pokeByteOff ptr 0 a pokeByteOff ptr 1 b addressTimer :: Address addressTimer = Address clientSystem portSystemTimer newtype Queue = Queue CUInt deriving (Eq, Show) instance Enum Queue where toEnum = Queue . fromIntegral fromEnum (Queue x) = fromIntegral x instance Storable Queue where sizeOf = sizeOf . enumToChar alignment = alignment . enumToChar peek = liftM enumFromChar . peek . castPtr poke ptr = poke (castPtr ptr) . enumToChar queueDirect :: Queue queueDirect = Queue 253 data QueueControl = QueueControlValue CInt | QueueControlTime TimeStamp | QueueControlPosition CUInt -- | QueueControlSkew QueueSkew | QueueControlData32 CUInt CUInt | QueueControlData8 CUChar CUChar CUChar CUChar CUChar CUChar CUChar CUChar deriving Show {- instance Storable QueueControl where sizeOf _ = 8 alignment _ = 4 peek ptr = liftM2 QueueControlData32 (peekByteOff ptr 0) (peekByteOff ptr 4) poke ptr qc = case qc of QueueControlValue val -> pokeByteOff ptr 0 val QueueControlTime ts -> pokeByteOff ptr 0 ts QueueControlPosition pos -> pokeByteOff ptr 0 pos -- QueueControlSkew skew -> pokeByteOff ptr 0 skew QueueControlData32 d0 d1 -> pokeByteOff ptr 0 d0 >> pokeByteOff ptr 4 d1 QueueControlData8 d0 d1 d2 d3 d4 d5 d6 d7 -> zipWithM_ (pokeByteOff ptr) [0..] [d0, d1, d2, d3, d4, d5, d6, d7] -} {- peekQueueControl :: EventType -> TimeUnit -> Ptr QueueControl -> IO QueueControl peekQueueControl et tu ptr = -} pokeQueueControl :: Ptr QueueControl -> QueueControl -> IO () pokeQueueControl ptr qc = case qc of QueueControlValue val -> pokeByteOff ptr 0 val QueueControlTime ts -> pokeTimeStamp (castPtr ptr) ts >> return () QueueControlPosition pos -> pokeByteOff ptr 0 pos -- QueueControlSkew skew -> pokeByteOff ptr 0 skew QueueControlData32 d0 d1 -> pokeByteOff ptr 0 d0 >> pokeByteOff ptr 4 d1 QueueControlData8 d0 d1 d2 d3 d4 d5 d6 d7 -> zipWithM_ (pokeByteOff ptr) [0..] [d0, d1, d2, d3, d4, d5, d6, d7] data EventType = {- system status; event data type = 'Result' -} EventSystem {- 0 -} {- returned result status; event data type = 'Result' -} | EventResult | EventPad002 | EventPad003 | EventPad004 {- note on and off with duration; event data type = 'Note' -} | EventNote {- 5 -} {- note on; event data type = 'Note' -} | EventNoteOn {- note off; event data type = 'Note' -} | EventNoteOff {- key pressure change (aftertouch); event data type = 'Note' -} | EventKeyPressure | EventPad009 {- controller; event data type = 'Control' -} | EventController {- 10 -} {- program change; event data type = 'Control' -} | EventProgramChange {- channel pressure; event data type = 'Control' -} | EventChannelPressure {- pitchwheel; event data type = 'Control'; data is from -8192 to 8191) -} | EventPitchBend {- 14 bit controller value; event data type = 'Control' -} | EventControl14 {- 14 bit NRPN; event data type = 'Control' -} | EventNonRegisteredParameter {- 14 bit RPN; event data type = 'Control' -} | EventRegisteredParameter | EventPad017 | EventPad018 | EventPad019 {- SPP with LSB and MSB values; event data type = 'Control' -} | EventSongPosition {- 20 -} {- Song Select with song ID number; event data type = 'Control' -} | EventSongSelect {- midi time code quarter frame; event data type = 'Control' -} | EventQuarterFrame {- SMF Time Signature event; event data type = 'Control' -} | EventTimeSign {- SMF Key Signature event; event data type = 'Control' -} | EventKeySign | EventPad025 | EventPad026 | EventPad027 | EventPad028 | EventPad029 {- MIDI Real Time Start message; event data type = 'QueueControl' -} | EventStart {- 30 -} {- MIDI Real Time Continue message; event data type = 'QueueControl' -} | EventContinue {- MIDI Real Time Stop message; event data type = 'QueueControl' -} | EventStop {- Set tick queue position; event data type = 'QueueControl' -} | EventSetPositionTick {- Set real-time queue position; event data type = 'QueueControl' -} | EventSetPositionTime {- (SMF) Tempo event; event data type = 'QueueControl' -} | EventTempo {- MIDI Real Time Clock message; event data type = 'QueueControl' -} | EventClock {- MIDI Real Time Tick message; event data type = 'QueueControl' -} | EventTick {- Queue timer skew; event data type = 'QueueControl' -} | EventQueueSkew {- Sync position changed; event data type = 'QueueControl' -} | EventSyncPos {- Tune request; event data type = none -} | EventTuneRequest {- 40 -} {- Reset to power-on state; event data type = none -} | EventReset {- Active sensing event; event data type = none -} | EventSensing | EventPad043 | EventPad044 | EventPad045 | EventPad046 | EventPad047 | EventPad048 | EventPad049 {- Echo-back event; event data type = any type -} | EventEcho {- 50 -} {- OSS emulation raw event; event data type = any type -} | EventOSS | EventPad052 | EventPad053 | EventPad054 | EventPad055 | EventPad056 | EventPad057 | EventPad058 | EventPad059 {- New client has connected; event data type = 'T' -} | EventClientStart {- 60 -} {- Client has left the system; event data type = 'T' -} | EventClientExit {- Client status/info has changed; event data type = 'T' -} | EventClientChange {- New port was created; event data type = 'T' -} | EventPortStart {- Port was deleted from system; event data type = 'T' -} | EventPortExit {- Port status/info has changed; event data type = 'T' -} | EventPortChange {- Ports connected; event data type = 'Connect' -} | EventPortSubscribed {- Ports disconnected; event data type = 'Connect' -} | EventPortUnsubscribed | EventPad068 | EventPad069 {- Sample select; event data type = 'SampleControl' -} | EventSample {- 70 -} {- Sample cluster select; event data type = 'SampleControl' -} | EventSampleCluster {- voice start -} | EventSampleStart {- voice stop -} | EventSampleStop {- playback frequency -} | EventSampleFrequency {- volume and balance -} | EventSampleVolume {- sample loop -} | EventSampleLoop {- sample position -} | EventSamplePosition {- private (hardware dependent) event -} | EventSamplePrivate1 | EventPad079 | EventPad080 | EventPad081 | EventPad082 | EventPad083 | EventPad084 | EventPad085 | EventPad086 | EventPad087 | EventPad088 | EventPad089 {- user-defined event; event data type = any (fixed size) -} | EventUser0 {- 90 -} {- user-defined event; event data type = any (fixed size) -} | EventUser1 {- user-defined event; event data type = any (fixed size) -} | EventUser2 {- user-defined event; event data type = any (fixed size) -} | EventUser3 {- user-defined event; event data type = any (fixed size) -} | EventUser4 {- user-defined event; event data type = any (fixed size) -} | EventUser5 {- user-defined event; event data type = any (fixed size) -} | EventUser6 {- user-defined event; event data type = any (fixed size) -} | EventUser7 {- user-defined event; event data type = any (fixed size) -} | EventUser8 {- user-defined event; event data type = any (fixed size) -} | EventUser9 {- begin of instrument management -} | EventInstrumentBegin {- 100 -} {- end of instrument management -} | EventInstrumentEnd {- query instrument interface info -} | EventInstrumentInfo {- result of instrument interface info -} | EventInstrumentInfoResult {- query instrument format info -} | EventInstrumentFormatInfo {- result of instrument format info -} | EventInstrumentFormatInfoResult {- reset instrument instrument memory -} | EventInstrumentReset {- get instrument interface status -} | EventInstrumentStatus {- result of instrument interface status -} | EventInstrumentStatusResult {- put an instrument to port -} | EventInstrumentPut {- get an instrument from port -} | EventInstrumentGet {- result of instrument query -} | EventInstrumentGetResult {- free instrument(s) -} | EventInstrumentFree {- get instrument list -} | EventInstrumentList {- result of instrument list -} | EventInstrumentListResult {- set cluster parameters -} | EventInstrumentCluster {- get cluster parameters -} | EventInstrumentClusterGet {- result of cluster parameters -} | EventInstrumentClusterResult {- instrument change -} | EventInstrumentChange | EventPad119 | EventPad120 | EventPad121 | EventPad122 | EventPad123 | EventPad124 | EventPad125 | EventPad126 | EventPad127 | EventPad128 | EventPad129 {- system exclusive data (variable length); event data type = 'Exclusive' -} | EventSystemExclusive {- 130 -} {- error event; event data type = 'Exclusive' -} | EventBounce | EventPad132 | EventPad133 | EventPad134 {- reserved for user apps; event data type = 'Exclusive' -} | EventUserVar0 {- 135 -} {- reserved for user apps; event data type = 'Exclusive' -} | EventUserVar1 {- reserved for user apps; event data type = 'Exclusive' -} | EventUserVar2 {- reserved for user apps; event data type = 'Exclusive' -} | EventUserVar3 {- reserved for user apps; event data type = 'Exclusive' -} | EventUserVar4 {- NOP; ignored in any case -} -- EventNone {- 255 -} deriving (Eq, Ord, Enum, Ix, Show) instance Storable EventType where sizeOf = sizeOf . enumToChar alignment = alignment . enumToChar peek = liftM enumFromChar . peek . castPtr poke ptr = poke (castPtr ptr) . enumToChar data EventLength = EventLengthFixed | EventLengthVariable | EventLengthVariableUser deriving (Eq, Ord, Enum, Show) data Priority = PriorityNormal | PriorityHigh deriving (Eq, Ord, Enum, Show) data Event = Event { typ :: EventType, tag :: CUChar, queue :: Queue, time :: TimeStamp, timeMode :: TimeMode, eventLength :: EventLength, priority :: Priority, source :: Address, dest :: Address, eventData :: EventDataUnion } deriving Show instance Storable Event where sizeOf _ = 16+12 alignment _ = 4 peek ptr = do typ_ <- peekByteOff ptr 0 flags <- peekByteOff ptr 1 :: IO CUChar tag_ <- peekByteOff ptr 2 queue_ <- peekByteOff ptr 3 time_ <- peekTimeStamp (unpackEnum 1 timeUnitBit flags) (plusPtr ptr 4) source_ <- peekByteOff ptr 12 dest_ <- peekByteOff ptr 14 eventData_ <- peekEventData (plusPtr ptr 16) typ_ return $ Event typ_ tag_ queue_ time_ (unpackEnum 1 timeModeBit flags) (unpackEnum 3 eventLengthBit flags) (unpackEnum 1 priorityBit flags) source_ dest_ eventData_ poke ptr ev = do timeUnitSet <- pokeTimeStamp (plusPtr ptr 4) (time ev) let timeModeSet = packEnum timeModeBit (timeMode ev) let eventLengthSet = packEnum eventLengthBit (eventLength ev) let prioritySet = packEnum priorityBit (priority ev) pokeByteOff ptr 0 (typ ev) pokeByteOff ptr 1 (packEnum timeUnitBit timeUnitSet .|. timeModeSet .|. eventLengthSet .|. prioritySet :: CUChar) pokeByteOff ptr 2 (tag ev) pokeByteOff ptr 3 (queue ev) pokeByteOff ptr 12 (source ev) pokeByteOff ptr 14 (dest ev) pokeEventData (plusPtr ptr 16) (eventData ev) newtype EnumBitPos a = EnumBitPos Int timeUnitBit :: EnumBitPos TimeUnit timeUnitBit = EnumBitPos 0 timeModeBit :: EnumBitPos TimeMode timeModeBit = EnumBitPos 1 eventLengthBit :: EnumBitPos EventLength eventLengthBit = EnumBitPos 2 priorityBit :: EnumBitPos Priority priorityBit = EnumBitPos 4 newtype ReturnCode = ReturnCode CInt check :: String -> IO ReturnCode -> IO CUInt check name act = do ReturnCode c <- act if c<0 then str_error c >>= peekCString >>= \str -> fail ("ALSA.Sequencer." ++ name ++ ": exception " ++ show (-c) ++ ": " ++ str) else return $ fromIntegral c -- * FFI stuff -- ** Error handling -- | should be in a more general ALSA module foreign import ccall "static alsa/asoundlib.h snd_strerror" str_error :: CInt -> IO CString -- ** Sequencer foreign import ccall "static alsa/asoundlib.h snd_seq_open" open :: Ptr T -> CString -> OpenMode -> CUInt -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_close" close :: T -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_set_client_name" set_client_name :: T -> CString -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_id" client_id :: T -> ClientId foreign import ccall "static alsa/asoundlib.h snd_seq_event_output" event_output :: T -> Ptr Event -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_drain_output" drain_output :: T -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_event_input" event_input :: T -> Ptr (Ptr Event) -> IO ReturnCode -- snd_seq_ev_clear(&ev); macro for memset -- ** Port foreign import ccall "static alsa/asoundlib.h snd_seq_create_simple_port" create_simple_port :: T -> Ptr CChar -> PortCapabilitySet -> PortTypeSet -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_delete_simple_port" delete_simple_port :: T -> Port -> IO ReturnCode -- ** Queue foreign import ccall "static alsa/asoundlib.h snd_seq_alloc_named_queue" alloc_named_queue :: T -> CString -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_alloc_queue" alloc_queue :: T -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_free_queue" free_queue :: T -> Queue -> IO ReturnCode -- ** Tempo newtype Tempo = Tempo (Ptr ()) instance Storable Tempo where sizeOf (Tempo x) = sizeOf x alignment (Tempo x) = alignment x peek = liftM Tempo . peek . castPtr poke ptr (Tempo x) = poke (castPtr ptr) x foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_malloc" queue_tempo_malloc :: Ptr Tempo -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_free" queue_tempo_free :: Tempo -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_tempo" queue_tempo_set_tempo :: Tempo -> CUInt -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_ppq" queue_tempo_set_ppq :: Tempo -> CUInt -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_tempo" get_queue_tempo :: T -> Queue -> Tempo -> IO ReturnCode foreign import ccall "static alsa/asoundlib.h snd_seq_set_queue_tempo" set_queue_tempo :: T -> Queue -> Tempo -> IO ReturnCode {- /* */ foreign import ccall "static alsa/asoundlib.h snd_seq_open" open :: snd_seq_t **handle, const char *name, int streams, int mode) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_open_lconf" open_lconf :: snd_seq_t **handle, const char *name, int streams, int mode, snd_config_t *lconf) IO CInt const char *snd_seq_name(snd_seq_t *seq); foreign import ccall "static alsa/asoundlib.h snd_seq_type" type :: snd_seq_t *seq) IO snd_seq_type_t foreign import ccall "static alsa/asoundlib.h snd_seq_close" close :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_poll_descriptors_count" poll_descriptors_count :: T -> short events) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_poll_descriptors" poll_descriptors :: T -> struct pollfd *pfds, unsigned int space, short events) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_poll_descriptors_revents" poll_descriptors_revents :: T -> struct pollfd *pfds, unsigned int nfds, unsigned short *revents) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_nonblock" nonblock :: T -> int nonblock) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_id" client_id :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_output_buffer_size" get_output_buffer_size :: snd_seq_t *handle) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_get_input_buffer_size" get_input_buffer_size :: snd_seq_t *handle) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_set_output_buffer_size" set_output_buffer_size :: T -> size_t size) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_input_buffer_size" set_input_buffer_size :: T -> size_t size) IO CInt {- | system information container -} typedef struct _snd_seq_system_info snd_seq_system_info_t; foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_sizeof" system_info_sizeof :: void) IO size_t {- | allocate a #snd_seq_system_info_t container on stack -} #define snd_seq_system_info_alloca(ptr) \ SND_ALLOCA(snd_seq_system_info, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_malloc" system_info_malloc :: snd_seq_system_info_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_free" system_info_free :: snd_seq_system_info_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_copy" system_info_copy :: snd_seq_system_info_t *dst, const snd_seq_system_info_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_queues" system_info_get_queues :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_clients" system_info_get_clients :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_ports" system_info_get_ports :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_channels" system_info_get_channels :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_cur_clients" system_info_get_cur_clients :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info_get_cur_queues" system_info_get_cur_queues :: const snd_seq_system_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_system_info" system_info :: T -> snd_seq_system_info_t *info) IO CInt /** \} */ /** * \defgroup SeqClient Sequencer Client Interface * Sequencer Client Interface * \ingroup Sequencer * \{ */ {- | client information container -} typedef struct _snd_seq_client_info snd_seq_client_info_t; {- | client types -} typedef enum snd_seq_client_type { SND_SEQ_USER_CLIENT = 1, {- | user client -} SND_SEQ_KERNEL_CLIENT = 2 {- | kernel client -} } snd_seq_client_type_t; foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_sizeof" client_info_sizeof :: void) IO size_t {- | allocate a #snd_seq_client_info_t container on stack -} #define snd_seq_client_info_alloca(ptr) \ SND_ALLOCA(snd_seq_client_info, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_malloc" client_info_malloc :: snd_seq_client_info_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_free" client_info_free :: snd_seq_client_info_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_copy" client_info_copy :: snd_seq_client_info_t *dst, const snd_seq_client_info_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_client" client_info_get_client :: const snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_type" client_info_get_type :: const snd_seq_client_info_t *info) IO snd_seq_client_type_t const char *snd_seq_client_info_get_name(snd_seq_client_info_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_broadcast_filter" client_info_get_broadcast_filter :: const snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_error_bounce" client_info_get_error_bounce :: const snd_seq_client_info_t *info) IO CInt const unsigned char *snd_seq_client_info_get_event_filter(const snd_seq_client_info_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_num_ports" client_info_get_num_ports :: const snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_get_event_lost" client_info_get_event_lost :: const snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_set_client" client_info_set_client :: snd_seq_client_info_t *info, int client) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_set_name" client_info_set_name :: snd_seq_client_info_t *info, const char *name) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_set_broadcast_filter" client_info_set_broadcast_filter :: snd_seq_client_info_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_set_error_bounce" client_info_set_error_bounce :: snd_seq_client_info_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_info_set_event_filter" client_info_set_event_filter :: snd_seq_client_info_t *info, unsigned char *filter) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_client_info" get_client_info :: T -> snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_any_client_info" get_any_client_info :: T -> int client, snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_client_info" set_client_info :: T -> snd_seq_client_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_next_client" query_next_client :: T -> snd_seq_client_info_t *info) IO CInt /* */ {- | client pool information container -} typedef struct _snd_seq_client_pool snd_seq_client_pool_t; foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_sizeof" client_pool_sizeof :: void) IO size_t {- | allocate a #snd_seq_client_pool_t container on stack -} #define snd_seq_client_pool_alloca(ptr) \ SND_ALLOCA(snd_seq_client_pool, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_malloc" client_pool_malloc :: snd_seq_client_pool_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_free" client_pool_free :: snd_seq_client_pool_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_copy" client_pool_copy :: snd_seq_client_pool_t *dst, const snd_seq_client_pool_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_client" client_pool_get_client :: const snd_seq_client_pool_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_output_pool" client_pool_get_output_pool :: const snd_seq_client_pool_t *info) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_input_pool" client_pool_get_input_pool :: const snd_seq_client_pool_t *info) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_output_room" client_pool_get_output_room :: const snd_seq_client_pool_t *info) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_output_free" client_pool_get_output_free :: const snd_seq_client_pool_t *info) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_get_input_free" client_pool_get_input_free :: const snd_seq_client_pool_t *info) IO size_t foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_set_output_pool" client_pool_set_output_pool :: snd_seq_client_pool_t *info, size_t size) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_set_input_pool" client_pool_set_input_pool :: snd_seq_client_pool_t *info, size_t size) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_client_pool_set_output_room" client_pool_set_output_room :: snd_seq_client_pool_t *info, size_t size) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_client_pool" get_client_pool :: T -> snd_seq_client_pool_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_client_pool" set_client_pool :: T -> snd_seq_client_pool_t *info) IO CInt /** \} */ /** * \defgroup SeqPort Sequencer Port Interface * Sequencer Port Interface * \ingroup Sequencer * \{ */ {- | port information container -} typedef struct _snd_seq_port_info snd_seq_port_info_t; {- | known port numbers -} #define SND_SEQ_PORT_SYSTEM_TIMER 0 {- | system timer port -} #define SND_SEQ_PORT_SYSTEM_ANNOUNCE 1 {- | system announce port -} {- | port capabilities (32 bits) -} #define SND_SEQ_PORT_CAP_READ (1<<0) {- | readable from this port -} #define SND_SEQ_PORT_CAP_WRITE (1<<1) {- | writable to this port -} #define SND_SEQ_PORT_CAP_SYNC_READ (1<<2) {- | allow read subscriptions -} #define SND_SEQ_PORT_CAP_SYNC_WRITE (1<<3) {- | allow write subscriptions -} #define SND_SEQ_PORT_CAP_DUPLEX (1<<4) {- | allow read/write duplex -} #define SND_SEQ_PORT_CAP_SUBS_READ (1<<5) {- | allow read subscription -} #define SND_SEQ_PORT_CAP_SUBS_WRITE (1<<6) {- | allow write subscription -} #define SND_SEQ_PORT_CAP_NO_EXPORT (1<<7) {- | routing not allowed -} {- | port type -} #define SND_SEQ_PORT_TYPE_SPECIFIC (1<<0) {- | hardware specific -} #define SND_SEQ_PORT_TYPE_MIDI_GENERIC (1<<1) {- | generic MIDI device -} #define SND_SEQ_PORT_TYPE_MIDI_GM (1<<2) {- | General MIDI compatible device -} #define SND_SEQ_PORT_TYPE_MIDI_GS (1<<3) {- | GS compatible device -} #define SND_SEQ_PORT_TYPE_MIDI_XG (1<<4) {- | XG compatible device -} #define SND_SEQ_PORT_TYPE_MIDI_MT32 (1<<5) {- | MT-32 compatible device -} #define SND_SEQ_PORT_TYPE_SYNTH (1<<10) {- | Synth device -} #define SND_SEQ_PORT_TYPE_DIRECT_SAMPLE (1<<11) {- | Sampling device (support sample download) -} #define SND_SEQ_PORT_TYPE_SAMPLE (1<<12) {- | Sampling device (sample can be downloaded at any time) -} #define SND_SEQ_PORT_TYPE_APPLICATION (1<<20) {- | application (sequencer/editor) -} foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_sizeof" port_info_sizeof :: void) IO size_t {- | allocate a #snd_seq_port_info_t container on stack -} #define snd_seq_port_info_alloca(ptr) \ SND_ALLOCA(snd_seq_port_info, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_malloc" port_info_malloc :: snd_seq_port_info_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_free" port_info_free :: snd_seq_port_info_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_copy" port_info_copy :: snd_seq_port_info_t *dst, const snd_seq_port_info_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_client" port_info_get_client :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_port" port_info_get_port :: const snd_seq_port_info_t *info) IO CInt const snd_seq_addr_t *snd_seq_port_info_get_addr(const snd_seq_port_info_t *info); const char *snd_seq_port_info_get_name(const snd_seq_port_info_t *info); unsigned int snd_seq_port_info_get_capability(const snd_seq_port_info_t *info); unsigned int snd_seq_port_info_get_type(const snd_seq_port_info_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_midi_channels" port_info_get_midi_channels :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_midi_voices" port_info_get_midi_voices :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_synth_voices" port_info_get_synth_voices :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_read_use" port_info_get_read_use :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_write_use" port_info_get_write_use :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_port_specified" port_info_get_port_specified :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_timestamping" port_info_get_timestamping :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_timestamp_real" port_info_get_timestamp_real :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_get_timestamp_queue" port_info_get_timestamp_queue :: const snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_client" port_info_set_client :: snd_seq_port_info_t *info, int client) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_port" port_info_set_port :: snd_seq_port_info_t *info, int port) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_addr" port_info_set_addr :: snd_seq_port_info_t *info, const snd_seq_addr_t *addr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_name" port_info_set_name :: snd_seq_port_info_t *info, const char *name) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_capability" port_info_set_capability :: snd_seq_port_info_t *info, unsigned int capability) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_type" port_info_set_type :: snd_seq_port_info_t *info, unsigned int type) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_midi_channels" port_info_set_midi_channels :: snd_seq_port_info_t *info, int channels) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_midi_voices" port_info_set_midi_voices :: snd_seq_port_info_t *info, int voices) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_synth_voices" port_info_set_synth_voices :: snd_seq_port_info_t *info, int voices) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_port_specified" port_info_set_port_specified :: snd_seq_port_info_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_timestamping" port_info_set_timestamping :: snd_seq_port_info_t *info, int enable) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_timestamp_real" port_info_set_timestamp_real :: snd_seq_port_info_t *info, int realtime) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_info_set_timestamp_queue" port_info_set_timestamp_queue :: snd_seq_port_info_t *info, int queue) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_create_port" create_port :: T -> snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_delete_port" delete_port :: T -> int port) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_port_info" get_port_info :: T -> int port, snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_any_port_info" get_any_port_info :: T -> int client, int port, snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_port_info" set_port_info :: T -> int port, snd_seq_port_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_next_port" query_next_port :: T -> snd_seq_port_info_t *info) IO CInt /** \} */ /** * \defgroup SeqSubscribe Sequencer Port Subscription * Sequencer Port Subscription * \ingroup Sequencer * \{ */ {- | port subscription container -} typedef struct _snd_seq_port_subscribe snd_seq_port_subscribe_t; foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_sizeof" port_subscribe_sizeof :: void) IO size_t {- | allocate a #snd_seq_port_subscribe_t container on stack -} #define snd_seq_port_subscribe_alloca(ptr) \ SND_ALLOCA(snd_seq_port_subscribe, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_malloc" port_subscribe_malloc :: snd_seq_port_subscribe_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_free" port_subscribe_free :: snd_seq_port_subscribe_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_copy" port_subscribe_copy :: snd_seq_port_subscribe_t *dst, const snd_seq_port_subscribe_t *src) IO () const snd_seq_addr_t *snd_seq_port_subscribe_get_sender(const snd_seq_port_subscribe_t *info); const snd_seq_addr_t *snd_seq_port_subscribe_get_dest(const snd_seq_port_subscribe_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_get_queue" port_subscribe_get_queue :: const snd_seq_port_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_get_exclusive" port_subscribe_get_exclusive :: const snd_seq_port_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_get_time_update" port_subscribe_get_time_update :: const snd_seq_port_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_get_time_real" port_subscribe_get_time_real :: const snd_seq_port_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_sender" port_subscribe_set_sender :: snd_seq_port_subscribe_t *info, const snd_seq_addr_t *addr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_dest" port_subscribe_set_dest :: snd_seq_port_subscribe_t *info, const snd_seq_addr_t *addr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_queue" port_subscribe_set_queue :: snd_seq_port_subscribe_t *info, int q) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_exclusive" port_subscribe_set_exclusive :: snd_seq_port_subscribe_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_time_update" port_subscribe_set_time_update :: snd_seq_port_subscribe_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_port_subscribe_set_time_real" port_subscribe_set_time_real :: snd_seq_port_subscribe_t *info, int val) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_port_subscription" get_port_subscription :: T -> snd_seq_port_subscribe_t *sub) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_subscribe_port" subscribe_port :: T -> snd_seq_port_subscribe_t *sub) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_unsubscribe_port" unsubscribe_port :: T -> snd_seq_port_subscribe_t *sub) IO CInt /* */ {- | subscription query container -} typedef struct _snd_seq_query_subscribe snd_seq_query_subscribe_t; {- | type of query subscription -} typedef enum { SND_SEQ_QUERY_SUBS_READ, {- | query read subscriptions -} SND_SEQ_QUERY_SUBS_WRITE {- | query write subscriptions -} } snd_seq_query_subs_type_t; foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_sizeof" query_subscribe_sizeof :: void) IO size_t {- | allocate a #snd_seq_query_subscribe_t container on stack -} #define snd_seq_query_subscribe_alloca(ptr) \ SND_ALLOCA(snd_seq_query_subscribe, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_malloc" query_subscribe_malloc :: snd_seq_query_subscribe_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_free" query_subscribe_free :: snd_seq_query_subscribe_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_copy" query_subscribe_copy :: snd_seq_query_subscribe_t *dst, const snd_seq_query_subscribe_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_client" query_subscribe_get_client :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_port" query_subscribe_get_port :: const snd_seq_query_subscribe_t *info) IO CInt const snd_seq_addr_t *snd_seq_query_subscribe_get_root(const snd_seq_query_subscribe_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_type" query_subscribe_get_type :: const snd_seq_query_subscribe_t *info) IO snd_seq_query_subs_type_t foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_index" query_subscribe_get_index :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_num_subs" query_subscribe_get_num_subs :: const snd_seq_query_subscribe_t *info) IO CInt const snd_seq_addr_t *snd_seq_query_subscribe_get_addr(const snd_seq_query_subscribe_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_queue" query_subscribe_get_queue :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_exclusive" query_subscribe_get_exclusive :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_time_update" query_subscribe_get_time_update :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_get_time_real" query_subscribe_get_time_real :: const snd_seq_query_subscribe_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_set_client" query_subscribe_set_client :: snd_seq_query_subscribe_t *info, int client) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_set_port" query_subscribe_set_port :: snd_seq_query_subscribe_t *info, int port) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_set_root" query_subscribe_set_root :: snd_seq_query_subscribe_t *info, const snd_seq_addr_t *addr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_set_type" query_subscribe_set_type :: snd_seq_query_subscribe_t *info, snd_seq_query_subs_type_t type) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_subscribe_set_index" query_subscribe_set_index :: snd_seq_query_subscribe_t *info, int _index) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_query_port_subscribers" query_port_subscribers :: T -> snd_seq_query_subscribe_t * subs) IO CInt /** \} */ /** * \defgroup SeqQueue Sequencer Queue Interface * Sequencer Queue Interface * \ingroup Sequencer * \{ */ {- | queue information container -} typedef struct _snd_seq_queue_info snd_seq_queue_info_t; {- | queue status container -} typedef struct _snd_seq_queue_status snd_seq_queue_status_t; {- | queue tempo container -} typedef struct _snd_seq_queue_tempo snd_seq_queue_tempo_t; {- | queue timer information container -} typedef struct _snd_seq_queue_timer snd_seq_queue_timer_t; {- | special queue ids -} #define SND_SEQ_QUEUE_DIRECT 253 {- | direct dispatch -} foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_sizeof" queue_info_sizeof :: void) IO size_t {- | allocate a #snd_seq_queue_info_t container on stack -} #define snd_seq_queue_info_alloca(ptr) \ SND_ALLOCA(snd_seq_queue_info, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_malloc" queue_info_malloc :: snd_seq_queue_info_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_free" queue_info_free :: snd_seq_queue_info_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_copy" queue_info_copy :: snd_seq_queue_info_t *dst, const snd_seq_queue_info_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_get_queue" queue_info_get_queue :: const snd_seq_queue_info_t *info) IO CInt const char *snd_seq_queue_info_get_name(const snd_seq_queue_info_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_get_owner" queue_info_get_owner :: const snd_seq_queue_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_get_locked" queue_info_get_locked :: const snd_seq_queue_info_t *info) IO CInt unsigned int snd_seq_queue_info_get_flags(const snd_seq_queue_info_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_set_name" queue_info_set_name :: snd_seq_queue_info_t *info, const char *name) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_set_owner" queue_info_set_owner :: snd_seq_queue_info_t *info, int owner) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_set_locked" queue_info_set_locked :: snd_seq_queue_info_t *info, int locked) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_info_set_flags" queue_info_set_flags :: snd_seq_queue_info_t *info, unsigned int flags) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_create_queue" create_queue :: T -> snd_seq_queue_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_alloc_named_queue" alloc_named_queue :: T -> const char *name) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_alloc_queue" alloc_queue :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_free_queue" free_queue :: T -> int q) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_info" get_queue_info :: T -> Queue -> snd_seq_queue_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_queue_info" set_queue_info :: T -> Queue -> snd_seq_queue_info_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_query_named_queue" query_named_queue :: T -> const char *name) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_usage" get_queue_usage :: T -> Queue -> IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_queue_usage" set_queue_usage :: T -> Queue -> int used) IO CInt /* */ foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_sizeof" queue_status_sizeof :: void) IO size_t {- | allocate a #snd_seq_queue_status_t container on stack -} #define snd_seq_queue_status_alloca(ptr) \ SND_ALLOCA(snd_seq_queue_status, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_malloc" queue_status_malloc :: snd_seq_queue_status_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_free" queue_status_free :: snd_seq_queue_status_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_copy" queue_status_copy :: snd_seq_queue_status_t *dst, const snd_seq_queue_status_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_get_queue" queue_status_get_queue :: const snd_seq_queue_status_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_get_events" queue_status_get_events :: const snd_seq_queue_status_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_status_get_tick_time" queue_status_get_tick_time :: const snd_seq_queue_status_t *info) IO snd_seq_tick_time_t const snd_seq_real_time_t *snd_seq_queue_status_get_real_time(const snd_seq_queue_status_t *info); unsigned int snd_seq_queue_status_get_status(const snd_seq_queue_status_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_status" get_queue_status :: T -> Queue -> snd_seq_queue_status_t *status) IO CInt /* */ foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_sizeof" queue_tempo_sizeof :: void) IO size_t {- | allocate a #snd_seq_queue_tempo_t container on stack -} #define snd_seq_queue_tempo_alloca(ptr) \ SND_ALLOCA(snd_seq_queue_tempo, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_malloc" queue_tempo_malloc :: Ptr Tempo -> IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_free" queue_tempo_free :: Tempo -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_copy" queue_tempo_copy :: Tempo -> const Tempo -> IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_get_queue" queue_tempo_get_queue :: const Tempo -> IO CInt unsigned int snd_seq_queue_tempo_get_tempo(const Tempo ->; foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_get_ppq" queue_tempo_get_ppq :: const Tempo -> IO CInt unsigned int snd_seq_queue_tempo_get_skew(const Tempo ->; unsigned int snd_seq_queue_tempo_get_skew_base(const Tempo ->; foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_tempo" queue_tempo_set_tempo :: Tempo -> unsigned int tempo) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_ppq" queue_tempo_set_ppq :: Tempo -> int ppq) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_skew" queue_tempo_set_skew :: Tempo -> unsigned int skew) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_tempo_set_skew_base" queue_tempo_set_skew_base :: Tempo -> unsigned int base) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_tempo" get_queue_tempo :: T -> Queue -> Tempo -> IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_queue_tempo" set_queue_tempo :: T -> Queue -> Tempo -> IO CInt /* */ {- | sequencer timer sources -} typedef enum { SND_SEQ_TIMER_ALSA = 0, /* ALSA timer */ SND_SEQ_TIMER_MIDI_CLOCK = 1, /* Midi Clock (CLOCK event) */ SND_SEQ_TIMER_MIDI_TICK = 2 /* Midi Timer Tick (TICK event */ } snd_seq_queue_timer_type_t; foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_sizeof" queue_timer_sizeof :: void) IO size_t {- | allocate a #snd_seq_queue_timer_t container on stack -} #define snd_seq_queue_timer_alloca(ptr) \ SND_ALLOCA(snd_seq_queue_timer, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_malloc" queue_timer_malloc :: snd_seq_queue_timer_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_free" queue_timer_free :: snd_seq_queue_timer_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_copy" queue_timer_copy :: snd_seq_queue_timer_t *dst, const snd_seq_queue_timer_t *src) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_get_queue" queue_timer_get_queue :: const snd_seq_queue_timer_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_get_type" queue_timer_get_type :: const snd_seq_queue_timer_t *info) IO snd_seq_queue_timer_type_t const snd_timer_id_t *snd_seq_queue_timer_get_id(const snd_seq_queue_timer_t *info); unsigned int snd_seq_queue_timer_get_resolution(const snd_seq_queue_timer_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_set_type" queue_timer_set_type :: snd_seq_queue_timer_t *info, snd_seq_queue_timer_type_t type) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_set_id" queue_timer_set_id :: snd_seq_queue_timer_t *info, const snd_timer_id_t *id) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_queue_timer_set_resolution" queue_timer_set_resolution :: snd_seq_queue_timer_t *info, unsigned int resolution) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_get_queue_timer" get_queue_timer :: T -> Queue -> snd_seq_queue_timer_t *timer) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_set_queue_timer" set_queue_timer :: T -> Queue -> snd_seq_queue_timer_t *timer) IO CInt /** \} */ /** * \defgroup SeqEvent Sequencer Event API * Sequencer Event API * \ingroup Sequencer * \{ */ foreign import ccall "static alsa/asoundlib.h snd_seq_free_event" free_event :: snd_seq_event_t *ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_length" event_length :: snd_seq_event_t *ev) IO ssize_t foreign import ccall "static alsa/asoundlib.h snd_seq_event_output" event_output :: T -> snd_seq_event_t *ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_output_buffer" event_output_buffer :: T -> snd_seq_event_t *ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_output_direct" event_output_direct :: T -> snd_seq_event_t *ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_input" event_input :: T -> snd_seq_event_t **ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_input_pending" event_input_pending :: T -> int fetch_sequencer) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_drain_output" drain_output :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_event_output_pending" event_output_pending :: snd_seq_t *seq) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_extract_output" extract_output :: T -> snd_seq_event_t **ev) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_drop_output" drop_output :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_drop_output_buffer" drop_output_buffer :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_drop_input" drop_input :: snd_seq_t *handle) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_drop_input_buffer" drop_input_buffer :: snd_seq_t *handle) IO CInt {- | event removal conditionals -} typedef struct _snd_seq_remove_events snd_seq_remove_events_t; {- | Remove conditional flags -} #define SND_SEQ_REMOVE_INPUT (1<<0) {- | Flush input queues -} #define SND_SEQ_REMOVE_OUTPUT (1<<1) {- | Flush output queues -} #define SND_SEQ_REMOVE_DEST (1<<2) {- | Restrict by destination q:client:port -} #define SND_SEQ_REMOVE_DEST_CHANNEL (1<<3) {- | Restrict by channel -} #define SND_SEQ_REMOVE_TIME_BEFORE (1<<4) {- | Restrict to before time -} #define SND_SEQ_REMOVE_TIME_AFTER (1<<5) {- | Restrict to time or after -} #define SND_SEQ_REMOVE_TIME_TICK (1<<6) {- | Time is in ticks -} #define SND_SEQ_REMOVE_EVENT_TYPE (1<<7) {- | Restrict to event type -} #define SND_SEQ_REMOVE_IGNORE_OFF (1<<8) {- | Do not flush off events -} #define SND_SEQ_REMOVE_TAG_MATCH (1<<9) {- | Restrict to events with given tag -} foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_sizeof" remove_events_sizeof :: void) IO size_t {- | allocate a #snd_seq_remove_events_t container on stack -} #define snd_seq_remove_events_alloca(ptr) \ SND_ALLOCA(snd_seq_remove_events, ptr) foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_malloc" remove_events_malloc :: snd_seq_remove_events_t **ptr) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_free" remove_events_free :: snd_seq_remove_events_t *ptr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_copy" remove_events_copy :: snd_seq_remove_events_t *dst, const snd_seq_remove_events_t *src) IO () unsigned int snd_seq_remove_events_get_condition(const snd_seq_remove_events_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_get_queue" remove_events_get_queue :: const snd_seq_remove_events_t *info) IO CInt const snd_seq_timestamp_t *snd_seq_remove_events_get_time(const snd_seq_remove_events_t *info); const snd_seq_addr_t *snd_seq_remove_events_get_dest(const snd_seq_remove_events_t *info); foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_get_channel" remove_events_get_channel :: const snd_seq_remove_events_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_get_event_type" remove_events_get_event_type :: const snd_seq_remove_events_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_get_tag" remove_events_get_tag :: const snd_seq_remove_events_t *info) IO CInt foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_condition" remove_events_set_condition :: snd_seq_remove_events_t *info, unsigned int flags) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_queue" remove_events_set_queue :: snd_seq_remove_events_t *info, int queue) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_time" remove_events_set_time :: snd_seq_remove_events_t *info, const snd_seq_timestamp_t *time) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_dest" remove_events_set_dest :: snd_seq_remove_events_t *info, const snd_seq_addr_t *addr) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_channel" remove_events_set_channel :: snd_seq_remove_events_t *info, int channel) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_event_type" remove_events_set_event_type :: snd_seq_remove_events_t *info, int type) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events_set_tag" remove_events_set_tag :: snd_seq_remove_events_t *info, int tag) IO () foreign import ccall "static alsa/asoundlib.h snd_seq_remove_events" remove_events :: T -> snd_seq_remove_events_t *info) IO CInt -} type OpenMode = FlagSet CUInt Open data Open = OpenOutput | OpenInput deriving (Enum, Eq, Ord, Show, Ix) openOutput :: OpenMode openOutput = flagToWord OpenOutput openInput :: OpenMode openInput = flagToWord OpenInput openDuplex :: OpenMode openDuplex = flagsToWord [OpenOutput, OpenInput] type PortTypeSet = FlagSet CUInt PortType data PortType = PortTypeSpecific {- hardware specific -} | PortTypeMIDIGeneric {- generic MIDI device -} | PortTypeMIDIGM {- General MIDI compatible device -} | PortTypeMIDIGS {- GS compatible device -} | PortTypeMIDIXG {- XG compatible device -} | PortTypeMIDIMT32 {- MT-32 compatible device -} | PortType06 | PortType07 | PortType08 | PortType09 | PortTypeSynth {- Synth device -} | PortTypeDirectSample {- Sampling device (support sample download) -} | PortTypeSample {- Sampling device (sample can be downloaded at any time) -} | PortType13 | PortType14 | PortType15 | PortType16 | PortType17 | PortType18 | PortType19 | PortTypeApplication {- application (sequencer/editor) -} deriving (Enum, Eq, Ord, Show, Ix) portTypeSpecific, portTypeMIDIGeneric, portTypeMIDIGM, portTypeMIDIGS, portTypeMIDIXG, portTypeMIDIMT32, portTypeSynth, portTypeDirectSample, portTypeSample, portTypeApplication :: PortTypeSet portTypeSpecific = flagToWord PortTypeSpecific portTypeMIDIGeneric = flagToWord PortTypeMIDIGeneric portTypeMIDIGM = flagToWord PortTypeMIDIGM portTypeMIDIGS = flagToWord PortTypeMIDIGS portTypeMIDIXG = flagToWord PortTypeMIDIXG portTypeMIDIMT32 = flagToWord PortTypeMIDIMT32 portTypeSynth = flagToWord PortTypeSynth portTypeDirectSample = flagToWord PortTypeDirectSample portTypeSample = flagToWord PortTypeSample portTypeApplication = flagToWord PortTypeApplication type PortCapabilitySet = FlagSet CUInt PortCapability data PortCapability = PortCapRead {- readable from this port -} | PortCapWrite {- writable to this port -} | PortCapSyncRead {- allow read subscriptions -} | PortCapSyncWrite {- allow write subscriptions -} | PortCapDuplex {- allow read/write duplex -} | PortCapSubsRead {- allow read subscription -} | PortCapSubsWrite {- allow write subscription -} | PortCapNoExport {- routing not allowed -} deriving (Enum, Eq, Ord, Show, Ix) portCapRead, portCapWrite, portCapSyncRead, portCapSyncWrite, portCapDuplex, portCapSubsRead, portCapSubsWrite, portCapNoExport :: PortCapabilitySet portCapRead : portCapWrite : portCapSyncRead : portCapSyncWrite : portCapDuplex : portCapSubsRead : portCapSubsWrite : portCapNoExport : [] = map flagToWord [PortCapRead ..] -- * Utility functions {-| From a list of expressions choose the one, whose condition holds. -} select :: a -> [(Bool, a)] -> a select def = maybe def snd . find fst newtype FlagSet word enum = FlagSet {unFlagSet :: word} -- looks like we are duplicating work from Edison EnumSet flagToWord :: (Enum a, Bits w) => a -> FlagSet w a flagToWord = FlagSet . bit . fromEnum flagsToWord :: (Enum a, Bits w) => [a] -> FlagSet w a flagsToWord = FlagSet . foldl setBit 0 . map fromEnum wordToFlags :: (Enum a, Bits w) => FlagSet w a -> [a] wordToFlags = map fst . filter (flip testBit 0 . snd) . zip [toEnum 0 ..] . iterate (flip shiftR 1) . unFlagSet intToFlags :: (Enum a, Integral w) => FlagSet w a -> [a] intToFlags = map fst . filter (odd . snd) . zip [toEnum 0 ..] . iterate (flip div 2) . unFlagSet unpackEnum :: (Enum a, Integral b, Bits b) => b -> EnumBitPos a -> b -> a unpackEnum mask (EnumBitPos pos) = toEnum . fromIntegral . (mask .&.) . flip shiftR pos packEnum :: (Bits b, Enum a) => EnumBitPos a -> a -> b packEnum (EnumBitPos pos) = flip shiftL pos . fromIntegral . fromEnum enumToChar :: Enum a => a -> CUChar enumToChar = fromIntegral . fromEnum enumFromChar :: Enum a => CUChar -> a enumFromChar = toEnum . fromIntegral