diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,280 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,23 @@ +AlsaMidi - Bindings to the Alsa sequencer api + +http://open-projects.net/~shahn/index.php?seite=code + +It's far from being finished... (as usual) + + + +INSTALLATION: + + runhaskell Setup configure + runhaskell Setup build + runhaskell Setup haddock # if you want + sudo runhaskell Setup install + + +You need ALSA for this to work... +( http://www.alsa-project.org/ ) + +The software is licensed under GPL 2, see LICENSE. + +Any comments appreciated: shahn@cs.tu-berlin.de + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,27 @@ + +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/alsa-midi.cabal b/alsa-midi.cabal new file mode 100644 --- /dev/null +++ b/alsa-midi.cabal @@ -0,0 +1,62 @@ +Name: alsa-midi +Version: 0.3 +License: GPL +Author: Soenke Hahn +Maintainer: Henning Thielemann +Homepage: http://open-projects.net/~shahn/index.php?seite=code +Repository: http://darcs.haskell.org/alsa-midi/ +Category: Sound +Tested-With: GHC==6.4.1 +Build-Type: Simple +Build-Depends: base, midi==0.0.4, event-list==0.0.5, non-negative==0.0.1 +-- mtl==1.0 only needed in PlayMIDI for Monad instance of Either +-- jack for SimpleSynth example +Synopsis: Bindings for the ALSA sequencer API (MIDI stuff) +Description: + Bindings for the ALSA sequencer API (MIDI stuff) + Since there is also + + which aims at a more complete interface to ALSA + we will no longer maintain this one. +Hs-Source-Dirs: src +Exposed-Modules: + Sound.ALSA.Sequencer +-- Other-Modules: + Sound.ALSA.SequencerFFI +GHC-Options: -Wall -threaded +extensions: ForeignFunctionInterface +license-file: LICENSE +extra-libraries: asound +includes: alsa/asoundlib.h +include-dirs: /usr/local/include, /usr/include +extra-source-files: README + , examples/SimpleSynth.hs + +Executable: playnote +Hs-source-dirs: src, . +GHC-Options: -Wall -threaded +Extensions: ForeignFunctionInterface +Extra-Libraries: asound +Main-Is: examples/PlayNote.hs + +Executable: playmidi +Hs-source-dirs: src, . +GHC-Options: -Wall -threaded +Extensions: ForeignFunctionInterface +Extra-Libraries: asound +Main-Is: examples/PlayMIDI.hs + +Executable: mididump +Hs-source-dirs: src, . +GHC-Options: -Wall -threaded +Extensions: ForeignFunctionInterface +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 diff --git a/examples/MidiDump.hs b/examples/MidiDump.hs new file mode 100644 --- /dev/null +++ b/examples/MidiDump.hs @@ -0,0 +1,10 @@ +module Main where + +import qualified Sound.ALSA.Sequencer as Alsa + +main :: IO () +main = + putStrLn "started..." >> + Alsa.withMIDIEvents + "mididump" "mididump-listen" + (putStr . unlines . map show) diff --git a/examples/PlayMIDI.hs b/examples/PlayMIDI.hs new file mode 100644 --- /dev/null +++ b/examples/PlayMIDI.hs @@ -0,0 +1,120 @@ +module Main where + +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.SequencerFFI as SndSeqFFI + +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.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} + + +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 + + + +parseAddress :: String -> Either String SndSeqFFI.Address +parseAddress str0 = + let addrs = + do (client, ':':str1) <- reads str0 + (port, []) <- reads str1 + return $ SndSeq.numAddressEither client port + in case addrs of + [addr] -> addr + _ -> Left "address must be a string like '128:0'" + +{- +parseAddressNaive :: String -> SndSeqFFI.Address +parseAddressNaive str = + let (client, ':':port) = break (':'==) str + in SndSeqFFI.Address (read client) (read port) +-} + + +data Flags = + Flags { + optHelp :: Bool, + optPort :: Either String SndSeqFFI.Address + } + +options :: [OptDescr (Flags -> Flags)] +options = + Option ['h'] ["help"] (NoArg (\ flags -> flags{optHelp = True})) "show options" : + Option ['p'] ["port"] (ReqArg (\str flags -> flags{optPort = parseAddress str}) "PORT") "destination PORT" : + [] + +main :: IO () +main = + do argv <- getArgs + let (opts, files, errors) = getOpt RequireOrder options argv + when (not (null errors)) + (ioError . userError . concat $ errors) + let flags = foldr ($) + (Flags {optHelp = False, + optPort = Left "no port specified"}) opts + when (optHelp flags) + (putStrLn (usageInfo "Usage: playmidi [OPTIONS] FILES ..." options)) + port <- + either + (ioError . userError) + return + (optPort flags) + mapM_ (play port) files diff --git a/examples/PlayNote.hs b/examples/PlayNote.hs new file mode 100644 --- /dev/null +++ b/examples/PlayNote.hs @@ -0,0 +1,35 @@ +module Main where + +import qualified Sound.ALSA.Sequencer as SndSeq +import qualified Sound.ALSA.SequencerFFI as SndSeqFFI +import Control.Exception (bracket) + + +main :: IO () +main = + bracket + (SndSeq.createClient SndSeqFFI.openOutput "note player") + SndSeq.deleteClient $ + \ client -> + do port <- SndSeq.createOutputPort client "play note" + + let ev = + SndSeqFFI.Event { + SndSeqFFI.typ = SndSeqFFI.EventNoteOn, + 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 = SndSeq.portAddress client port, + SndSeqFFI.dest = SndSeq.numAddress 128 0, + SndSeqFFI.eventData = SndSeqFFI.Note { + SndSeqFFI.noteChannel = 0, + SndSeqFFI.notePitch = 49, + SndSeqFFI.noteVelocity = 64, + SndSeqFFI.noteOffVelocity = 64, + SndSeqFFI.noteDuration = 0} + } + SndSeq.sendPlainEvent client ev + SndSeq.drainOutput client diff --git a/examples/SimpleSynth.hs b/examples/SimpleSynth.hs new file mode 100644 --- /dev/null +++ b/examples/SimpleSynth.hs @@ -0,0 +1,66 @@ +module Main where + +import qualified Sound.JACK as Jack +import qualified Sound.ALSA.Sequencer as Alsa +import Sound.ALSA.Sequencer (MIDIEvent) + +import Foreign.C.Types (CFloat) + +import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef) +import Control.Concurrent + + +main :: IO () +main = do + n <- newIORef Nothing + (_client, incoming) <- Alsa.receiveMIDIEvents "SimpleSynth" "inport" + forkIO $ writeNotes n incoming + performNotes n + +writeNotes :: + IORef (Maybe MIDIEvent) + -> [MIDIEvent] + -> IO () +writeNotes ref = + mapM_ (\ a -> writeIORef ref $ toMaybe (Alsa.isNoteOn a) a) + +toMaybe :: Bool -> a -> Maybe a +toMaybe c x = if c then Just x else Nothing + +performNotes :: + IORef (Maybe MIDIEvent) -> IO () +performNotes ref = do + putStrLn "performNotes..." + phase <- newIORef 0 + Jack.mainStereo (const (synth ref phase)) + +synth :: + IORef (Maybe MIDIEvent) + -> IORef CFloat + -> IO (CFloat, CFloat) +synth ref phase = + readIORef ref >>= + liftM split + (maybe + (return 0) + (\n -> do + p <- readIORef phase + modifyIORef phase (incPhase (midi2Hz (Alsa.note n)) 44100) + return $ sin (p * 2 * pi))) + +split :: t -> (t, t) +split a = (a, a) + +incPhase :: (RealFrac a) => a -> a -> a -> a +incPhase frq samplerate phase = + snd (properFraction (phase + frq / samplerate) `asTypeOf` + (undefined::Int,phase)) + +midi2Hz :: Int -> CFloat +midi2Hz mn = midiBaseFrq * semitoneFactor ^ mn + +semitoneFactor :: CFloat +semitoneFactor = 2 ** (1 / 12) + +midiBaseFrq :: CFloat +midiBaseFrq = 440 / semitoneFactor ^ (69::Int) diff --git a/src/Sound/ALSA/Sequencer.hs b/src/Sound/ALSA/Sequencer.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/Sequencer.hs @@ -0,0 +1,280 @@ +module Sound.ALSA.Sequencer ( + MIDIFile.Event(..), + isNoteOn, isNoteOff, + createClient, + deleteClient, + createInputPort, + createOutputPort, + withMIDIEvents, + receiveMIDIEvent, + + sendPlainEvent, + drainOutput, + + initQueueTempo, + withNamedQueue, + + portAddress, + numAddress, + numAddressEither, + -- constructors only for internal use + Client(sequencerHandle), + SndSeq.Port(..), + + eventFromMIDIEvent, + ) where + +import qualified Sound.ALSA.SequencerFFI as SndSeq + +import qualified Sound.MIDI.File as MIDIFile +import qualified Sound.MIDI.Event as MIDIEvent + +import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Utils (with) +import Foreign.Storable (peek) +-- import Foreign.Ptr (Ptr) +import Foreign.C.String (withCString) +-- import Foreign.C.Types (CInt) +import Data.IORef (IORef, newIORef, readIORef, modifyIORef) + +import Control.Exception (bracket) + +import System.IO.Unsafe (unsafeInterleaveIO) +import Control.Monad (liftM, liftM2) +import Data.Maybe (catMaybes) +import Data.Ix (inRange) + + +isNoteOn :: MIDIFile.Event -> Bool +isNoteOn = maybe False (MIDIEvent.isNoteOn . snd) . MIDIFile.maybeMIDIEvent + +isNoteOff :: MIDIFile.Event -> Bool +isNoteOff = maybe False (MIDIEvent.isNoteOff . snd) . MIDIFile.maybeMIDIEvent + + +clientId :: Client -> SndSeq.ClientId +clientId = SndSeq.client_id . sequencerHandle + +data Client = Client { + sequencerHandle :: SndSeq.T, + ports :: IORef [SndSeq.Port] + } + +portAddress :: Client -> SndSeq.Port -> SndSeq.Address +portAddress = SndSeq.Address . clientId + +numAddress :: Integer -> Integer -> SndSeq.Address +numAddress client port = + either error id $ numAddressEither client port + +numAddressEither :: Integer -> Integer -> Either String SndSeq.Address +numAddressEither client port = + if inRange (128,191) client + then + if inRange (0,255) port + then Right + (SndSeq.Address + (SndSeq.ClientId $ fromInteger client) + (SndSeq.Port $ fromInteger port)) + else Left "port must be in range [0,255]" + else Left "client must be in range [128,191]" + + +-- * Useful things + +{- | +Process MIDI events from ALSA in a lazy manner. +The processing function must be strict, +in order to let the cleanup take place after abandoning the process. +-} +withMIDIEvents :: String -> String -> ([MIDIFile.Event] -> IO a) -> IO a +withMIDIEvents clientName portName act = do + bracket + (createClient SndSeq.openInput clientName) + deleteClient $ + \ client -> do + -- Why is it necessary to use a writable port for reading events? + createOutputPort client portName + (act . catMaybes) =<< ioToLazyList (receiveMIDIEvent client) + +deleteClient :: Client -> IO () +deleteClient ac = do + mapM_ (deletePort ac) =<< readIORef (ports ac) + SndSeq.close (sequencerHandle ac) + return () + +{- +event_input tells whether more events are waiting. +Maybe we should return a list of all events rather than a Maybe. +-} +receiveMIDIEvent :: Client -> IO (Maybe MIDIFile.Event) +receiveMIDIEvent ac = + alloca $ \eventPtrPtr -> +{- sometimes returns code -4 (Interrupted system call) + SndSeq.check "receiveMIDIEvent" (SndSeq.event_input (sequencerHandle ac) eventPtrPtr) + >> liftM eventToMIDIEvent (peek =<< peek eventPtrPtr) +-} + SndSeq.event_input (sequencerHandle ac) eventPtrPtr + >>= \(SndSeq.ReturnCode err) -> + if err < 0 + then return Nothing + -- fail "SndSeq.event_input failed" + else liftM eventToMIDIEvent (peek =<< peek eventPtrPtr) + +eventToMIDIEvent :: SndSeq.Event -> Maybe MIDIFile.Event +eventToMIDIEvent ev = + case SndSeq.eventData ev of + SndSeq.Connect _ _ -> Nothing + SndSeq.Fixed -> Nothing + SndSeq.Note + {SndSeq.noteVelocity = v0, + SndSeq.notePitch = p0, + SndSeq.noteChannel = c0} -> + let p = MIDIEvent.toPitch $ fromIntegral p0 + v = MIDIEvent.toVelocity $ fromIntegral v0 + c = MIDIEvent.toChannel $ fromIntegral c0 + in Just $ MIDIFile.MIDIEvent c $ + case SndSeq.typ ev of + SndSeq.EventNoteOn -> MIDIEvent.NoteOn p v + SndSeq.EventNoteOff -> MIDIEvent.NoteOff p v + _ -> 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) + _ -> error ("eventToMIDIEvent: " ++ show ev) + +ioToLazyList :: IO a -> IO [a] +ioToLazyList m = + unsafeInterleaveIO $ + liftM2 (:) m (ioToLazyList m) + + +mkNote :: + MIDIEvent.Channel -> + MIDIEvent.Pitch -> + MIDIEvent.Velocity -> + SndSeq.EventDataUnion +mkNote c p v = + let v1 = fromIntegral $ MIDIEvent.fromVelocity v + in SndSeq.Note { + SndSeq.noteChannel = fromIntegral $ MIDIEvent.fromChannel c, + SndSeq.notePitch = fromIntegral $ MIDIEvent.fromPitch p, + SndSeq.noteVelocity = v1, + SndSeq.noteOffVelocity = v1, + SndSeq.noteDuration = 0} + +eventFromMIDIEvent :: + SndSeq.Queue -> MIDIFile.Event -> (SndSeq.EventType, SndSeq.EventDataUnion) +eventFromMIDIEvent _ (MIDIFile.MIDIEvent c ev) = + case ev of + MIDIEvent.NoteOn p v -> (SndSeq.EventNoteOn, mkNote c p v) + MIDIEvent.NoteOff p v -> (SndSeq.EventNoteOff, mkNote c p v) + MIDIEvent.ProgramChange p -> (SndSeq.EventProgramChange, + SndSeq.Control { + SndSeq.controlChannel = fromIntegral $ MIDIEvent.fromChannel c, + SndSeq.controlValue = fromIntegral $ MIDIEvent.fromProgram p, + SndSeq.controlParameter = 0 + }) + _ -> error ("eventFromMIDIEvent: event type not supported, " ++ show ev) +eventFromMIDIEvent q (MIDIFile.MetaEvent ev) = + case ev of + MIDIFile.SetTempo t -> (SndSeq.EventTempo, SndSeq.QueueEv { + SndSeq.queueId = q, + SndSeq.queueControl = SndSeq.QueueControlValue $ fromIntegral t}) + _ -> error ("eventFromMIDIEvent: event type not supported, " ++ show ev) +eventFromMIDIEvent _ ev = + error ("eventFromMIDIEvent: event type not supported, " ++ show ev) + + +sendPlainEvent :: Client -> SndSeq.Event -> IO () +sendPlainEvent client ev = + with ev $ \evPtr -> + liftM (const ()) $ + SndSeq.check "sendPlainEvent" $ + SndSeq.event_output (sequencerHandle client) evPtr + + +{- | +Strangly ALSA returns error code 2 (No such file or directory) +if the destination port does not exist. +-} +drainOutput :: Client -> IO () +drainOutput = + liftM (const ()) . + SndSeq.check "drainOutput" . + SndSeq.drain_output . sequencerHandle + + +withNamedQueue :: Client -> String -> (SndSeq.Queue -> IO a) -> IO a +withNamedQueue client name = + bracket + (liftM + (SndSeq.Queue . fromIntegral) + (SndSeq.check "withNamedQueue" (withCString name + (SndSeq.alloc_named_queue (sequencerHandle client))))) + (SndSeq.free_queue (sequencerHandle client)) + + +initQueueTempo :: Client -> SndSeq.Queue -> Int -> Int -> IO () +initQueueTempo client q ppq tempo = + bracket + (alloca $ \t -> + SndSeq.check "initQueueTempo.malloc" (SndSeq.queue_tempo_malloc t) >> + peek t) + SndSeq.queue_tempo_free + (\t -> + do SndSeq.queue_tempo_set_tempo t (fromIntegral tempo) + SndSeq.queue_tempo_set_ppq t (fromIntegral ppq) + + SndSeq.check "initQueueTempo.set_tempo" + (SndSeq.set_queue_tempo (sequencerHandle client) q t) + return ()) + + +-- create a new client +createClient :: SndSeq.OpenMode -> String -> IO Client +createClient mode name = alloca $ \handlePtr -> do + SndSeq.check "createClient" $ + withCString "default" $ \defaultS -> + SndSeq.open handlePtr defaultS mode 0 + + hdl <- peek handlePtr + withCString name (SndSeq.set_client_name hdl) + liftM (Client hdl) (newIORef []) + + + +createPort :: SndSeq.PortCapabilitySet -> Client -> String -> IO SndSeq.Port +createPort cap client name = do + port <- + SndSeq.check "createPort" $ + withCString name $ \cname -> + SndSeq.create_simple_port + (sequencerHandle client) + cname + cap + SndSeq.portTypeMIDIGeneric -- TODO + + let p = SndSeq.Port $ fromIntegral port + modifyIORef (ports client) (p :) + return p + + +createInputPort :: Client -> String -> IO SndSeq.Port +createInputPort = + createPort (SndSeq.flagsToWord [SndSeq.PortCapRead, SndSeq.PortCapSubsRead]) + +createOutputPort :: Client -> String -> IO SndSeq.Port +createOutputPort = + createPort (SndSeq.flagsToWord [SndSeq.PortCapWrite, SndSeq.PortCapSubsWrite]) + +deletePort :: Client -> SndSeq.Port -> IO () +deletePort client = + liftM (const ()) . + SndSeq.check "deletePort" . + SndSeq.delete_simple_port (sequencerHandle client) diff --git a/src/Sound/ALSA/SequencerFFI.hs b/src/Sound/ALSA/SequencerFFI.hs new file mode 100644 --- /dev/null +++ b/src/Sound/ALSA/SequencerFFI.hs @@ -0,0 +1,1831 @@ +{-# 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