-------------------------------------------------------------------------------- -- | -- Module : Sound.ALSA.Sequencer.Marshal.Event -- Copyright : (c) Henning Thielemann, 2010 -- (c) Iavor S. Diatchki, 2007 -- License : BSD3 -- -- Maintainer: Henning Thielemann -- Stability : provisional -- -- PRIVATE MODULE. -- -- Here we have the various types used by the library, -- and how they are imported\/exported to C. -- -- NOTE: In the translations bellow we make the following assumptions -- about the sizes of C types. -- CChar = 8 bits -- CShort = 16 bit -- CInt = 32 bits -------------------------------------------------------------------------------- module Sound.ALSA.Sequencer.Marshal.Event where #include import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime import Foreign.C.Types (CUInt, ) import Foreign.Storable (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, ) import Foreign.Marshal.Alloc (alloca, ) import Data.Bits ((.|.), (.&.), ) import Data.Int (Int16, Int32, ) import Data.Word (Word8, Word16, Word32, ) import Data.Array (Array, (!), accumArray, ) data Connect = Connect { connSource :: !Addr.T , connDest :: !Addr.T } deriving (Show,Eq,Ord) instance Storable Connect where sizeOf _ = #size snd_seq_connect_t alignment _ = 4 -- XXX peek p = do s <- #{peek snd_seq_connect_t, sender} p d <- #{peek snd_seq_connect_t, dest} p return Connect { connSource = s, connDest = d } poke p v = #{poke snd_seq_connect_t, sender} p (connSource v) >> #{poke snd_seq_connect_t, dest} p (connDest v) data TimeStamp = TickTime !Word32 | RealTime !RealTime.T deriving Show peekTimestamp :: Word8 -> Ptr TimeStamp -> IO TimeStamp peekTimestamp flags p = case flags .&. #{const SND_SEQ_TIME_STAMP_MASK} of { #{const SND_SEQ_TIME_STAMP_TICK} -> TickTime `fmap` peek (castPtr p) ; _ -> RealTime `fmap` peek (castPtr p) } pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO Word8 pokeTimestamp p ts = case ts of TickTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_TICK} RealTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_REAL} newtype InstrCluster = InstrCluster CUInt deriving (Show,Eq,Ord,Num,Enum,Storable) data Instr = Instr { instrCluster :: !InstrCluster -- XXX: perhaps use Sample? , instrStd :: !Word32 , instrBank :: !Word16 , instrPrg :: !Word16 } deriving (Show) {- instance Storable Instr where sizeOf _ = #{size snd_seq_instr_t} alignment _ = 4 -- XXX peek p = do cl <- #{peek snd_seq_instr_t, cluster} p st <- #{peek snd_seq_instr_t, std} p ba <- #{peek snd_seq_instr_t, bank} p pr <- #{peek snd_seq_instr_t, prg} p return Instr { instr_cluster = cl , instr_std = st , instr_bank = ba , instr_prg = pr } poke p v = #{poke snd_seq_instr_t, cluster} p (instr_cluster v) >> #{poke snd_seq_instr_t, std} p (instr_std v) >> #{poke snd_seq_instr_t, bank} p (instr_bank v) >> #{poke snd_seq_instr_t, prg} p (instr_prg v) -} data Note = Note { noteChannel :: !Word8 , noteNote :: !Word8 , noteVelocity :: !Word8 , noteOffVelocity :: !Word8 , noteDuration :: !Word32 } deriving (Show) instance Storable Note where sizeOf _ = #{size snd_seq_ev_note_t} alignment _ = 4 -- XXX peek p = do c <- #{peek snd_seq_ev_note_t, channel} p n <- #{peek snd_seq_ev_note_t, note} p v <- #{peek snd_seq_ev_note_t, velocity} p ov <- #{peek snd_seq_ev_note_t, off_velocity} p d <- #{peek snd_seq_ev_note_t, duration} p return Note { noteChannel = c , noteNote = n , noteVelocity = v , noteOffVelocity = ov , noteDuration = d } poke p v = #{poke snd_seq_ev_note_t, channel} p (noteChannel v) >> #{poke snd_seq_ev_note_t, note} p (noteNote v) >> #{poke snd_seq_ev_note_t, velocity} p (noteVelocity v) >> #{poke snd_seq_ev_note_t, off_velocity} p (noteOffVelocity v) >> #{poke snd_seq_ev_note_t, duration} p (noteDuration v) data Ctrl = Ctrl { ctrlChannel :: !Word8 , ctrlParam :: !Word32 , ctrlValue :: !Int32 } deriving (Show) instance Storable Ctrl where sizeOf _ = #{size snd_seq_ev_ctrl_t} alignment _ = 4 -- XXX peek p = do ct <- #{peek snd_seq_ev_ctrl_t, channel} p pa <- #{peek snd_seq_ev_ctrl_t, param} p va <- #{peek snd_seq_ev_ctrl_t, value} p return Ctrl { ctrlChannel = ct , ctrlParam = pa , ctrlValue = va } poke p v = #{poke snd_seq_ev_ctrl_t, channel} p (ctrlChannel v) >> #{poke snd_seq_ev_ctrl_t, param} p (ctrlParam v) >> #{poke snd_seq_ev_ctrl_t, value} p (ctrlValue v) data Sample = Sample { sampleStd :: !Word32 , sampleBank :: !Word16 , samplePrg :: !Word16 } deriving (Show) {- instance Storable Sample where sizeOf _ = #{size snd_seq_ev_sample_t} alignment _ = 4 -- XXX peek p = do st <- #{peek snd_seq_ev_sample_t, std} p ba <- #{peek snd_seq_ev_sample_t, bank} p pr <- #{peek snd_seq_ev_sample_t, prg} p return Sample { sample_std = st , sample_bank = ba , sample_prg = pr } poke p v = #{poke snd_seq_ev_sample_t, std} p (sampleStd v) >> #{poke snd_seq_ev_sample_t, bank} p (sampleBank v) >> #{poke snd_seq_ev_sample_t, prg} p (samplePrg v) -} newtype Cluster = Cluster { clusterCluster :: InstrCluster } deriving (Show, Eq, Storable) -- | These are all 14 bit values. data Volume = Volume { volumeVolume :: !Int16 , volumeLR :: !Int16 , volumeFR :: !Int16 , volumeDU :: !Int16 } deriving (Show) {- instance Storable Volume where sizeOf _ = #{size snd_seq_ev_volume_t} alignment _ = 4 -- XXX peek p = do v <- #{peek snd_seq_ev_volume_t, volume} p l <- #{peek snd_seq_ev_volume_t, lr} p f <- #{peek snd_seq_ev_volume_t, fr} p d <- #{peek snd_seq_ev_volume_t, du} p return Volume { volume_volume = v , volume_lr = l , volume_fr = f , volume_du = d } poke p v = #{poke snd_seq_ev_volume_t, volume} p (volumeVolume v) >> #{poke snd_seq_ev_volume_t, lr} p (volumeLR v) >> #{poke snd_seq_ev_volume_t, fr} p (volumeFR v) >> #{poke snd_seq_ev_volume_t, du} p (volumeDU v) -} data Custom = Custom { custom0, custom1, custom2 :: !Word32 } deriving (Show) instance Storable Custom where sizeOf _ = #{size snd_seq_ev_raw32_t} alignment _ = 4 -- XXX peek p = do d0 <- #{peek snd_seq_ev_raw32_t, d[0]} p d1 <- #{peek snd_seq_ev_raw32_t, d[1]} p d2 <- #{peek snd_seq_ev_raw32_t, d[2]} p return Custom { custom0 = d0 , custom1 = d1 , custom2 = d2 } poke p v = #{poke snd_seq_ev_raw32_t, d[0]} p (custom0 v) >> #{poke snd_seq_ev_raw32_t, d[1]} p (custom1 v) >> #{poke snd_seq_ev_raw32_t, d[2]} p (custom2 v) data T = Cons { highPriority :: !Bool , tag :: !Word8 , queue :: !Queue.T , timestamp :: !TimeStamp , source :: !Addr.T , dest :: !Addr.T , body :: !Data } deriving Show instance Storable T where sizeOf _ = #{size snd_seq_event_t} alignment _ = 4 -- XXX peek p = do ty <- #{peek snd_seq_event_t, type} p flags <- #{peek snd_seq_event_t, flags} p tg <- #{peek snd_seq_event_t, tag} p q <- #{peek snd_seq_event_t, queue} p time <- peekTimestamp flags (#{ptr snd_seq_event_t, time} p) src <- #{peek snd_seq_event_t, source} p dst <- #{peek snd_seq_event_t, dest} p d <- (peekData ! ty) (#{ptr snd_seq_event_t, data} p) return Cons { highPriority = (flags .&. #{const SND_SEQ_PRIORITY_MASK}) /= 0 , tag = tg , queue = q , timestamp = time , source = src , dest = dst , body = d } poke p e = do { ty <- pokeData (#{ptr snd_seq_event_t, data} p) (body e) ; #{poke snd_seq_event_t, type} p ty ; #{poke snd_seq_event_t, tag} p (tag e) ; #{poke snd_seq_event_t, queue} p (queue e) ; real <- pokeTimestamp (#{ptr snd_seq_event_t, time} p) (timestamp e) ; #{poke snd_seq_event_t, source} p (source e) ; #{poke snd_seq_event_t, dest} p (dest e) ; let flags = (if highPriority e then #{const SND_SEQ_PRIORITY_HIGH} else #{const SND_SEQ_PRIORITY_NORMAL}) .|. real .|. #{const SND_SEQ_EVENT_LENGTH_FIXED} -- XXX ; #{poke snd_seq_event_t, flags} p flags } allocaEv :: T -> (Ptr T -> IO a) -> IO a allocaEv e h = alloca (\p -> poke p e >> h p) allocaMaybeEv :: Maybe T -> (Ptr T -> IO a) -> IO a allocaMaybeEv me h = maybe (h nullPtr) (\e -> allocaEv e h) me pokeData :: Ptr Data -> Data -> IO Word8 pokeData p dt = case dt of NoteEv e d -> poke (castPtr p) d >> return (expNoteEv e) CtrlEv e d -> poke (castPtr p) d >> return (expCtrlEv e) AddrEv e d -> poke (castPtr p) d >> return (expAddrEv e) ConnEv e d -> poke (castPtr p) d >> return (expConnEv e) CustomEv e d -> poke (castPtr p) d >> return (expCustomEv e) EmptyEv e -> return (expEmptyEv e) peekData :: Array Word8 (Ptr Data -> IO Data) peekData = accumArray (const id) unknown (0,255) [ -- result events (2) (#{const SND_SEQ_EVENT_SYSTEM}, unknown) , (#{const SND_SEQ_EVENT_RESULT}, unknown) -- note events (4) , (#{const SND_SEQ_EVENT_NOTE}, peekNoteEv ANote) , (#{const SND_SEQ_EVENT_NOTEON}, peekNoteEv NoteOn) , (#{const SND_SEQ_EVENT_NOTEOFF}, peekNoteEv NoteOff) , (#{const SND_SEQ_EVENT_KEYPRESS}, peekNoteEv KeyPress) -- control events (12) , (#{const SND_SEQ_EVENT_CONTROLLER}, peekCtrlEv Controller) , (#{const SND_SEQ_EVENT_PGMCHANGE}, peekCtrlEv PgmChange) , (#{const SND_SEQ_EVENT_CHANPRESS}, peekCtrlEv ChanPress) , (#{const SND_SEQ_EVENT_PITCHBEND}, peekCtrlEv PitchBend) , (#{const SND_SEQ_EVENT_CONTROL14}, peekCtrlEv Control14) , (#{const SND_SEQ_EVENT_NONREGPARAM}, peekCtrlEv NonRegParam) , (#{const SND_SEQ_EVENT_REGPARAM}, peekCtrlEv RegParam) , (#{const SND_SEQ_EVENT_SONGPOS}, peekCtrlEv SongPos) , (#{const SND_SEQ_EVENT_SONGSEL}, peekCtrlEv SongSel) , (#{const SND_SEQ_EVENT_QFRAME}, peekCtrlEv QFrame) , (#{const SND_SEQ_EVENT_TIMESIGN}, peekCtrlEv TimeSign) , (#{const SND_SEQ_EVENT_KEYSIGN}, peekCtrlEv KeySign) -- queue control (10) , (#{const SND_SEQ_EVENT_START}, unknown) , (#{const SND_SEQ_EVENT_CONTINUE}, unknown) , (#{const SND_SEQ_EVENT_STOP}, unknown) , (#{const SND_SEQ_EVENT_SETPOS_TICK}, unknown) , (#{const SND_SEQ_EVENT_SETPOS_TIME}, unknown) , (#{const SND_SEQ_EVENT_TEMPO}, unknown) , (#{const SND_SEQ_EVENT_CLOCK}, unknown) , (#{const SND_SEQ_EVENT_TICK}, unknown) , (#{const SND_SEQ_EVENT_QUEUE_SKEW}, unknown) , (#{const SND_SEQ_EVENT_SYNC_POS}, unknown) -- misc (3) , (#{const SND_SEQ_EVENT_TUNE_REQUEST}, peekEmptyEv TuneRequest) , (#{const SND_SEQ_EVENT_RESET}, peekEmptyEv Reset) , (#{const SND_SEQ_EVENT_SENSING}, peekEmptyEv Sensing) , (#{const SND_SEQ_EVENT_ECHO}, peekCustomEv Echo) , (#{const SND_SEQ_EVENT_OSS}, peekCustomEv OSS) -- networking (8) , (#{const SND_SEQ_EVENT_CLIENT_START}, peekAddrEv ClientStart) , (#{const SND_SEQ_EVENT_CLIENT_EXIT}, peekAddrEv ClientExit) , (#{const SND_SEQ_EVENT_CLIENT_CHANGE}, peekAddrEv ClientChange) , (#{const SND_SEQ_EVENT_PORT_START}, peekAddrEv PortStart) , (#{const SND_SEQ_EVENT_PORT_EXIT}, peekAddrEv PortExit) , (#{const SND_SEQ_EVENT_PORT_CHANGE}, peekAddrEv PortChange) , (#{const SND_SEQ_EVENT_PORT_SUBSCRIBED}, peekConnEv PortSubscribed) , (#{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}, peekConnEv PortUnsubscribed) {- , (#{const SND_SEQ_EVENT_SAMPLE}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_CLUSTER}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_START}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_STOP}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_FREQ}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_VOLUME}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_LOOP}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_POSITION}, unknown) , (#{const SND_SEQ_EVENT_SAMPLE_PRIVATE1}, unknown) -} , (#{const SND_SEQ_EVENT_USR0}, peekCustomEv User0) , (#{const SND_SEQ_EVENT_USR1}, peekCustomEv User1) , (#{const SND_SEQ_EVENT_USR2}, peekCustomEv User2) , (#{const SND_SEQ_EVENT_USR3}, peekCustomEv User3) , (#{const SND_SEQ_EVENT_USR4}, peekCustomEv User4) , (#{const SND_SEQ_EVENT_USR5}, peekCustomEv User5) , (#{const SND_SEQ_EVENT_USR6}, peekCustomEv User6) , (#{const SND_SEQ_EVENT_USR7}, peekCustomEv User7) , (#{const SND_SEQ_EVENT_USR8}, peekCustomEv User8) , (#{const SND_SEQ_EVENT_USR9}, peekCustomEv User9) {- , (#{const SND_SEQ_EVENT_INSTR_BEGIN}, unknown) , (#{const SND_SEQ_EVENT_INSTR_END}, unknown) , (#{const SND_SEQ_EVENT_INSTR_INFO}, unknown) , (#{const SND_SEQ_EVENT_INSTR_INFO_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_FINFO}, unknown) , (#{const SND_SEQ_EVENT_INSTR_FINFO_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_RESET}, unknown) , (#{const SND_SEQ_EVENT_INSTR_STATUS}, unknown) , (#{const SND_SEQ_EVENT_INSTR_STATUS_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_PUT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_GET}, unknown) , (#{const SND_SEQ_EVENT_INSTR_GET_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_FREE}, unknown) , (#{const SND_SEQ_EVENT_INSTR_LIST}, unknown) , (#{const SND_SEQ_EVENT_INSTR_LIST_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_CLUSTER}, unknown) , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_GET}, unknown) , (#{const SND_SEQ_EVENT_INSTR_CLUSTER_RESULT}, unknown) , (#{const SND_SEQ_EVENT_INSTR_CHANGE}, unknown) -} , (#{const SND_SEQ_EVENT_SYSEX}, unknown) , (#{const SND_SEQ_EVENT_BOUNCE}, unknown) , (#{const SND_SEQ_EVENT_USR_VAR0}, unknown) , (#{const SND_SEQ_EVENT_USR_VAR1}, unknown) , (#{const SND_SEQ_EVENT_USR_VAR2}, unknown) , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown) , (#{const SND_SEQ_EVENT_USR_VAR3}, unknown) , (#{const SND_SEQ_EVENT_NONE}, peekEmptyEv None) ] where unknown = peekEmptyEv Unknown data NoteEv = ANote | NoteOn | NoteOff | KeyPress deriving Show data CtrlEv = Controller | PgmChange | ChanPress | PitchBend | Control14 | NonRegParam | RegParam | SongPos | SongSel | QFrame | TimeSign | KeySign deriving Show data QueueEv = QueueStart | QueueContinue | QueueStop | QueueSetPosTick | QueueSetPosTime | QueueTempo | QueueClock | QueueTick | QueueSkew | QueueSyncPos deriving Show data EmptyEv = TuneRequest | Reset | Sensing | None | Unknown deriving Show data CustomEv = Echo | OSS | User0 | User1 | User2 | User3 | User4 | User5 | User6 | User7 | User8 | User9 deriving Show data AddrEv = ClientStart | ClientExit | ClientChange | PortStart | PortExit | PortChange deriving Show data ConnEv = PortSubscribed | PortUnsubscribed deriving Show expNoteEv :: NoteEv -> Word8 expNoteEv e = case e of ANote -> #{const SND_SEQ_EVENT_NOTE} NoteOn -> #{const SND_SEQ_EVENT_NOTEON} NoteOff -> #{const SND_SEQ_EVENT_NOTEOFF} KeyPress -> #{const SND_SEQ_EVENT_KEYPRESS} expCtrlEv :: CtrlEv -> Word8 expCtrlEv e = case e of Controller -> #{const SND_SEQ_EVENT_CONTROLLER} PgmChange -> #{const SND_SEQ_EVENT_PGMCHANGE} ChanPress -> #{const SND_SEQ_EVENT_CHANPRESS} PitchBend -> #{const SND_SEQ_EVENT_PITCHBEND} Control14 -> #{const SND_SEQ_EVENT_CONTROL14} NonRegParam -> #{const SND_SEQ_EVENT_NONREGPARAM} RegParam -> #{const SND_SEQ_EVENT_REGPARAM} SongPos -> #{const SND_SEQ_EVENT_SONGPOS} SongSel -> #{const SND_SEQ_EVENT_SONGSEL} QFrame -> #{const SND_SEQ_EVENT_QFRAME} TimeSign -> #{const SND_SEQ_EVENT_TIMESIGN} KeySign -> #{const SND_SEQ_EVENT_KEYSIGN} expQueueEv :: QueueEv -> Word8 expQueueEv e = case e of QueueStart -> #{const SND_SEQ_EVENT_START} QueueContinue -> #{const SND_SEQ_EVENT_CONTINUE} QueueStop -> #{const SND_SEQ_EVENT_STOP} QueueSetPosTick -> #{const SND_SEQ_EVENT_SETPOS_TICK} QueueSetPosTime -> #{const SND_SEQ_EVENT_SETPOS_TIME} QueueTempo -> #{const SND_SEQ_EVENT_TEMPO} QueueClock -> #{const SND_SEQ_EVENT_CLOCK} QueueTick -> #{const SND_SEQ_EVENT_TICK} QueueSkew -> #{const SND_SEQ_EVENT_QUEUE_SKEW} QueueSyncPos -> #{const SND_SEQ_EVENT_SYNC_POS} expEmptyEv :: EmptyEv -> Word8 expEmptyEv e = case e of TuneRequest -> #{const SND_SEQ_EVENT_TUNE_REQUEST} Reset -> #{const SND_SEQ_EVENT_RESET} Sensing -> #{const SND_SEQ_EVENT_SENSING} None -> #{const SND_SEQ_EVENT_NONE} Unknown -> #{const SND_SEQ_EVENT_NONE} expCustomEv :: CustomEv -> Word8 expCustomEv e = case e of Echo -> #{const SND_SEQ_EVENT_ECHO} OSS -> #{const SND_SEQ_EVENT_OSS} User0 -> #{const SND_SEQ_EVENT_USR0} User1 -> #{const SND_SEQ_EVENT_USR1} User2 -> #{const SND_SEQ_EVENT_USR2} User3 -> #{const SND_SEQ_EVENT_USR3} User4 -> #{const SND_SEQ_EVENT_USR4} User5 -> #{const SND_SEQ_EVENT_USR5} User6 -> #{const SND_SEQ_EVENT_USR6} User7 -> #{const SND_SEQ_EVENT_USR7} User8 -> #{const SND_SEQ_EVENT_USR8} User9 -> #{const SND_SEQ_EVENT_USR9} expAddrEv :: AddrEv -> Word8 expAddrEv e = case e of ClientStart -> #{const SND_SEQ_EVENT_CLIENT_START} ClientExit -> #{const SND_SEQ_EVENT_CLIENT_EXIT} ClientChange -> #{const SND_SEQ_EVENT_CLIENT_CHANGE} PortStart -> #{const SND_SEQ_EVENT_PORT_START} PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT} PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE} expConnEv :: ConnEv -> Word8 expConnEv e = case e of PortSubscribed -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED} PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED} peekNoteEv :: NoteEv -> Ptr Data -> IO Data peekNoteEv e p = NoteEv e `fmap` peek (castPtr p) peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data peekCtrlEv e p = CtrlEv e `fmap` peek (castPtr p) peekAddrEv :: AddrEv -> Ptr Data -> IO Data peekAddrEv e p = AddrEv e `fmap` peek (castPtr p) peekConnEv :: ConnEv -> Ptr Data -> IO Data peekConnEv e p = ConnEv e `fmap` peek (castPtr p) peekEmptyEv :: EmptyEv -> Ptr Data -> IO Data peekEmptyEv e _ = return (EmptyEv e) peekCustomEv :: CustomEv -> Ptr Data -> IO Data peekCustomEv e p = CustomEv e `fmap` peek (castPtr p) data Data = NoteEv NoteEv Note | CtrlEv CtrlEv Ctrl | AddrEv AddrEv Addr.T | ConnEv ConnEv Connect | EmptyEv EmptyEv | CustomEv CustomEv Custom deriving Show