diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,27 +0,0 @@ - -import Distribution.Simple -import Distribution.Simple.Utils -import Directory -import Monad -import System - -neededHeaders = ["alsa/asoundlib.h"] - -main = do - args <- getArgs - when ((head args) == "configure") (checkHeaders neededHeaders) - defaultMainWithHooks defaultUserHooks - - -checkHeaders ll = do - mapM checkHeader ll - return () - -includeDirs = ["/usr/local/include", "/usr/include"] - -checkHeader name = do - putStr ("Searching for " ++ name ++ "...") - bools <- mapM (\ p -> doesFileExist (p ++ "/" ++ name)) includeDirs - when (not $ or bools) (fail ("ERROR: " ++ name ++ " not found")) - putStrLn "found" - diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,3 @@ +#! /usr/bin/env runhaskell +> import Distribution.Simple +> main = defaultMain diff --git a/alsa-midi.cabal b/alsa-midi.cabal --- a/alsa-midi.cabal +++ b/alsa-midi.cabal @@ -1,11 +1,11 @@ Name: alsa-midi -Version: 0.3.1 +Version: 0.3.2 License: GPL License-File: LICENSE Author: Soenke Hahn Maintainer: Henning Thielemann -Homepage: http://open-projects.net/~shahn/index.php?seite=code -Repository: http://darcs.haskell.org/alsa-midi/ +Homepage: http://www.haskell.org/haskellwiki/ALSA +Package-URL: http://darcs.haskell.org/alsa-midi/ Category: Sound Build-Type: Simple Synopsis: Bindings for the ALSA sequencer API (MIDI stuff) @@ -15,6 +15,8 @@ which aims at a more complete interface to ALSA we will no longer maintain this one. + . + See "Sound.ALSA.Sequencer.Play" for how to play Haskore songs in realtime via ALSA. Tested-With: GHC==6.4.1, GHC==6.8.2 Cabal-Version: >=1.2 Build-Type: Simple @@ -26,17 +28,21 @@ description: Choose the new smaller, split-up base package. Library + Build-Depends: midi >=0.0.5 && <0.1, event-list >=0.0.6 && < 0.1, non-negative>=0.0.1 && <0.1 + Build-Depends: mtl >=1 && <2, QuickCheck >=1 && <2 If flag(splitBase) - Build-Depends: base >= 2, midi==0.0.5, event-list==0.0.6, non-negative==0.0.1, array + Build-Depends: base >= 2, array Else - Build-Depends: base >= 1.0 && < 2, midi==0.0.5, event-list==0.0.6, non-negative==0.0.1 + Build-Depends: base >= 1.0 && < 2 -- jack for SimpleSynth example Hs-Source-Dirs: src Exposed-Modules: Sound.ALSA.Sequencer + Sound.ALSA.Sequencer.Play -- Other-Modules: Sound.ALSA.SequencerFFI + Sound.ALSA.Sequencer.FFI GHC-Options: -Wall -threaded extensions: ForeignFunctionInterface extra-libraries: asound @@ -64,10 +70,11 @@ Extra-Libraries: asound Main-Is: examples/MidiDump.hs --- needs Jack package --- Executable: simplesynth --- Hs-source-dirs: src, . --- GHC-Options: -Wall -threaded --- Extensions: ForeignFunctionInterface --- Extra-Libraries: asound --- Main-Is: examples/SimpleSynth.hs +-- Executable simplesynth +-- Buildable: False +-- Hs-source-dirs: src, . +-- Build-Depends: jack +-- GHC-Options: -Wall -threaded +-- Extensions: ForeignFunctionInterface +-- Extra-Libraries: asound +-- Main-Is: examples/SimpleSynth.hs diff --git a/examples/PlayMIDI.hs b/examples/PlayMIDI.hs --- a/examples/PlayMIDI.hs +++ b/examples/PlayMIDI.hs @@ -1,74 +1,23 @@ module Main where -import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.SequencerFFI as SndSeqFFI +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Sequencer.FFI as SndSeqFFI +import qualified Sound.ALSA.Sequencer.Play as SndSeqPlay -import qualified Sound.MIDI.File as MIDIFile import qualified Sound.MIDI.File.Load as MIDILoad -import qualified Data.EventList.Relative.TimeBody as EventList -import qualified Numeric.NonNegative.Wrapper as NonNeg - -import Control.Concurrent (threadDelay) -import Control.Exception (bracket) +-- import Control.Exception (bracket) -- import Control.Monad.Error () -- Monad instance for Either import Control.Monad (when) import System.Console.GetOpt (getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..), usageInfo) import System.Environment (getArgs) - - -mkEvent :: - SndSeqFFI.Queue -> - SndSeqFFI.Address -> SndSeqFFI.Address -> - MIDIFile.Event -> SndSeqFFI.Event -mkEvent queue srcAddress dstAddress ev = - let (typ, dat) = SndSeq.eventFromMIDIEvent queue ev - in SndSeqFFI.Event { - SndSeqFFI.typ = typ, - SndSeqFFI.tag = 0, - SndSeqFFI.queue = SndSeqFFI.queueDirect, - SndSeqFFI.time = SndSeqFFI.TimeStampTick (SndSeqFFI.TickTime 0), - SndSeqFFI.timeMode = SndSeqFFI.TimeModeRelative, - SndSeqFFI.eventLength = SndSeqFFI.EventLengthFixed, - SndSeqFFI.priority = SndSeqFFI.PriorityNormal, - SndSeqFFI.source = srcAddress, - SndSeqFFI.dest = dstAddress, - SndSeqFFI.eventData = dat} +import System.Exit (exitWith, ExitCode(..)) play :: SndSeqFFI.Address -> FilePath -> IO () play dstAddress fileName = - do MIDIFile.Cons typ _div tracks <- MIDILoad.fromFile fileName - -- print midi - - let track = - case typ of - MIDIFile.Parallel -> foldl EventList.merge EventList.empty tracks - MIDIFile.Serial -> EventList.concat tracks - MIDIFile.Mixed -> EventList.concat tracks - - bracket - (SndSeq.createClient SndSeqFFI.openOutput "midi player") - SndSeq.deleteClient $ - \ client -> - SndSeq.withNamedQueue client "playmidi out queue" $ - \ queue -> - do putStrLn "playing" - port <- SndSeq.createOutputPort client "player output" - let srcAddress = SndSeq.portAddress client port - EventList.mapM_ - (threadDelay . (5000*) . fromInteger . NonNeg.toNumber) - (\ev -> - (SndSeq.sendPlainEvent client $ - let seqEv = mkEvent queue srcAddress dstAddress ev - in case ev of - MIDIFile.MetaEvent (MIDIFile.SetTempo _) -> - seqEv{SndSeqFFI.dest = SndSeqFFI.addressTimer} - _ -> seqEv) - >> SndSeq.drainOutput client) - track - + MIDILoad.fromFile fileName >>= SndSeqPlay.run dstAddress parseAddress :: String -> Either String SndSeqFFI.Address @@ -111,7 +60,8 @@ (Flags {optHelp = False, optPort = Left "no port specified"}) opts when (optHelp flags) - (putStrLn (usageInfo "Usage: playmidi [OPTIONS] FILES ..." options)) + (putStrLn (usageInfo "Usage: playmidi [OPTIONS] FILES ..." options) >> + exitWith ExitSuccess) port <- either (ioError . userError) diff --git a/examples/PlayNote.hs b/examples/PlayNote.hs --- a/examples/PlayNote.hs +++ b/examples/PlayNote.hs @@ -1,7 +1,7 @@ module Main where -import qualified Sound.ALSA.Sequencer as SndSeq -import qualified Sound.ALSA.SequencerFFI as SndSeqFFI +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Sequencer.FFI as SndSeqFFI import Control.Exception (bracket) diff --git a/src/Sound/ALSA/Sequencer.hs b/src/Sound/ALSA/Sequencer.hs --- a/src/Sound/ALSA/Sequencer.hs +++ b/src/Sound/ALSA/Sequencer.hs @@ -24,7 +24,7 @@ eventFromMIDIEvent, ) where -import qualified Sound.ALSA.SequencerFFI as SndSeq +import qualified Sound.ALSA.Sequencer.FFI as SndSeq import qualified Sound.MIDI.File as MIDIFile import qualified Sound.MIDI.Event as MIDIEvent @@ -121,6 +121,10 @@ -- fail "SndSeq.event_input failed" else liftM eventToMIDIEvent (peek =<< peek eventPtrPtr) +{- | +NoteOn events with zero velocity are automatically converted to NoteOff events, +which is equivalent according to the MIDI standard. +-} eventToMIDIEvent :: SndSeq.Event -> Maybe MIDIFile.Event eventToMIDIEvent ev = case SndSeq.eventData ev of @@ -135,17 +139,31 @@ c = MIDIEvent.toChannel $ fromIntegral c0 in Just $ MIDIFile.MIDIEvent c $ case SndSeq.typ ev of - SndSeq.EventNoteOn -> MIDIEvent.NoteOn p v + SndSeq.EventNoteOn -> + if v0==0 + then MIDIEvent.NoteOff p (MIDIEvent.toVelocity 64) + else MIDIEvent.NoteOn p v SndSeq.EventNoteOff -> MIDIEvent.NoteOff p v + SndSeq.EventKeyPressure -> MIDIEvent.PolyAfter p $ fromIntegral v0 _ -> error ("eventToMIDIEvent: note typ " ++ show ev) SndSeq.Control {SndSeq.controlChannel = c, SndSeq.controlParameter = p, SndSeq.controlValue = x} -> Just $ MIDIFile.MIDIEvent (MIDIEvent.toChannel $ fromIntegral c) $ - MIDIEvent.Control - (toEnum $ fromIntegral p) - (fromIntegral x) + case SndSeq.typ ev of + SndSeq.EventController -> + MIDIEvent.Control + (toEnum $ fromIntegral p) + (fromIntegral x) + SndSeq.EventProgramChange -> + MIDIEvent.ProgramChange + (MIDIEvent.toProgram $ fromIntegral x) + SndSeq.EventChannelPressure -> + MIDIEvent.MonoAfter (fromIntegral x) + SndSeq.EventPitchBend -> + MIDIEvent.PitchBend (fromIntegral x) + _ -> error ("eventToMIDIEvent: cannot convert controller message " ++ show ev) _ -> error ("eventToMIDIEvent: " ++ show ev) ioToLazyList :: IO a -> IO [a] diff --git a/src/Sound/ALSA/Sequencer/FFI.hs b/src/Sound/ALSA/Sequencer/FFI.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/FFI.hs @@ -0,0 +1,1831 @@ +{-# 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 diff --git a/src/Sound/ALSA/Sequencer/Play.hs b/src/Sound/ALSA/Sequencer/Play.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer/Play.hs @@ -0,0 +1,72 @@ +{- | +If you have the Haskore package installed, +then you can use this module for playing Haskore songs in realtime via ALSA. +Example: + +> Prelude> Sound.ALSA.Sequencer.Play.run (Sound.ALSA.Sequencer.numAddress 128 0) (Haskore.Interface.MIDI.Render.generalMidi Haskore.Example.ChildSong6.song) +-} +module Sound.ALSA.Sequencer.Play (run) where + + +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.Sequencer.FFI as SndSeqFFI + +import qualified Sound.MIDI.File as MIDIFile + +import qualified Data.EventList.Relative.TimeBody as EventList +import qualified Numeric.NonNegative.Wrapper as NonNeg + +import Control.Concurrent (threadDelay) +import Control.Exception (bracket) +-- import Control.Monad.Error () -- Monad instance for Either + + +mkEvent :: + SndSeqFFI.Queue -> + SndSeqFFI.Address -> SndSeqFFI.Address -> + MIDIFile.Event -> SndSeqFFI.Event +mkEvent queue srcAddress dstAddress ev = + let (typ, dat) = SndSeq.eventFromMIDIEvent queue ev + in SndSeqFFI.Event { + SndSeqFFI.typ = typ, + SndSeqFFI.tag = 0, + SndSeqFFI.queue = SndSeqFFI.queueDirect, + SndSeqFFI.time = SndSeqFFI.TimeStampTick (SndSeqFFI.TickTime 0), + SndSeqFFI.timeMode = SndSeqFFI.TimeModeRelative, + SndSeqFFI.eventLength = SndSeqFFI.EventLengthFixed, + SndSeqFFI.priority = SndSeqFFI.PriorityNormal, + SndSeqFFI.source = srcAddress, + SndSeqFFI.dest = dstAddress, + SndSeqFFI.eventData = dat} + + +run :: SndSeqFFI.Address -> MIDIFile.T -> IO () +run dstAddress (MIDIFile.Cons typ _div tracks) = + do -- print midi + + let track = + case typ of + MIDIFile.Parallel -> foldl EventList.merge EventList.empty tracks + MIDIFile.Serial -> EventList.concat tracks + MIDIFile.Mixed -> EventList.concat tracks + + bracket + (SndSeq.createClient SndSeqFFI.openOutput "midi player") + SndSeq.deleteClient $ + \ client -> + SndSeq.withNamedQueue client "playmidi out queue" $ + \ queue -> + do -- putStrLn "playing" + port <- SndSeq.createOutputPort client "player output" + let srcAddress = SndSeq.portAddress client port + EventList.mapM_ + (threadDelay . (5000*) . fromInteger . NonNeg.toNumber) + (\ev -> + (SndSeq.sendPlainEvent client $ + let seqEv = mkEvent queue srcAddress dstAddress ev + in case ev of + MIDIFile.MetaEvent (MIDIFile.SetTempo _) -> + seqEv{SndSeqFFI.dest = SndSeqFFI.addressTimer} + _ -> seqEv) + >> SndSeq.drainOutput client) + track diff --git a/src/Sound/ALSA/SequencerFFI.hs b/src/Sound/ALSA/SequencerFFI.hs --- a/src/Sound/ALSA/SequencerFFI.hs +++ b/src/Sound/ALSA/SequencerFFI.hs @@ -1,1831 +1,5 @@ -{-# OPTIONS -fffi #-} - -module Sound.ALSA.SequencerFFI 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 +module Sound.ALSA.SequencerFFI + {-# DEPRECATED "import Sound.ALSA.Sequencer.FFI instead" #-} + (module Sound.ALSA.Sequencer.FFI) where + +import Sound.ALSA.Sequencer.FFI