alsa-midi (empty) → 0.3
raw patch · 10 files changed
+2734/−0 lines, 10 filesdep +basedep +event-listdep +midisetup-changed
Dependencies added: base, event-list, midi, non-negative
Files
- LICENSE +280/−0
- README +23/−0
- Setup.hs +27/−0
- alsa-midi.cabal +62/−0
- examples/MidiDump.hs +10/−0
- examples/PlayMIDI.hs +120/−0
- examples/PlayNote.hs +35/−0
- examples/SimpleSynth.hs +66/−0
- src/Sound/ALSA/Sequencer.hs +280/−0
- src/Sound/ALSA/SequencerFFI.hs +1831/−0
+ LICENSE view
@@ -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
+ README view
@@ -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+
+ Setup.hs view
@@ -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"+
+ alsa-midi.cabal view
@@ -0,0 +1,62 @@+Name: alsa-midi+Version: 0.3+License: GPL+Author: Soenke Hahn+Maintainer: Henning Thielemann <haskell@henning-thielemann.de>+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+ <http://code.haskell.org/alsa/>+ 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
+ examples/MidiDump.hs view
@@ -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)
+ examples/PlayMIDI.hs view
@@ -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
+ examples/PlayNote.hs view
@@ -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
+ examples/SimpleSynth.hs view
@@ -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)
+ src/Sound/ALSA/Sequencer.hs view
@@ -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)
+ src/Sound/ALSA/SequencerFFI.hs view
@@ -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