alsa-seq 0.5 → 0.5.1

raw patch · 32 files changed

+1319/−360 lines, 32 filesdep +data-accessordep +enumsetdep +utility-htnew-component:exe:alsa-seq-broadcastnew-component:exe:alsa-seq-dumpnew-component:exe:alsa-seq-list-clientsnew-component:exe:alsa-seq-list-subscribersnew-component:exe:alsa-seq-melodynew-component:exe:alsa-seq-send-notePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-accessor, enumset, utility-ht

API changes (from Hackage documentation)

Files

• alsa-seq.cabal +119/−26
• examples/broadcast.hs +28/−0
• examples/dump.hs +23/−0
• examples/list-clients.hs +13/−0
• examples/list-subscribers.hs +28/−0
• examples/melody.hs +103/−0
• examples/send-note.hs +56/−0
• examples/test1.hs +0/−24
• examples/test2.hs +0/−38
• examples/test3.hs +0/−38
• examples/test4.hs +0/−13
• examples/test5.hs +0/−69
• filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs +42/−0
• filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs +80/−0
• src/Sound/ALSA/Sequencer/Area.hsc +64/−13
• src/Sound/ALSA/Sequencer/Client/Info.hs +29/−6
• src/Sound/ALSA/Sequencer/Event.hs +36/−19
• src/Sound/ALSA/Sequencer/Event/Accessor.hs +47/−0
• src/Sound/ALSA/Sequencer/Marshal/Event.hsc +122/−49
• src/Sound/ALSA/Sequencer/Marshal/Port.hsc +156/−9
• src/Sound/ALSA/Sequencer/Marshal/QuerySubscribe.hsc +21/−0
• src/Sound/ALSA/Sequencer/Port.hs +7/−7
• src/Sound/ALSA/Sequencer/Port/Info.hs +8/−8
• src/Sound/ALSA/Sequencer/Queue.hs +5/−5
• src/Sound/ALSA/Sequencer/Queue/Info.hs +3/−3
• src/Sound/ALSA/Sequencer/Queue/Status.hs +7/−7
• src/Sound/ALSA/Sequencer/Queue/Tempo.hs +3/−3
• src/Sound/ALSA/Sequencer/Queue/Timer.hs +3/−3
• src/Sound/ALSA/Sequencer/RealTime.hs +0/−1
• src/Sound/ALSA/Sequencer/Sequencer.hs +19/−19
• src/Sound/ALSA/Sequencer/Subscribe.hs +147/−0
• src/Sound/ALSA/Sequencer/Subscribe/Query.hs +150/−0

@@ -1,20 +1,28 @@-Name: alsa-seq-Version: 0.5-Copyright: Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann-Maintainer: Henning Thielemann <alsa@henning-thielemann.de>-Author: Bjorn Bringert <bjorn@bringert.net>, Iavor S. Diatchki <iavor.diatchki@gmail.com>-Category: Sound, Music-License: BSD3-License-file: LICENSE-Homepage: http://www.haskell.org/haskellwiki/ALSA-Stability: Experimental-Build-Type: Simple-Cabal-Version: >= 1.8--Synopsis: Binding to the ALSA Library API (MIDI sequencer).+Name:           alsa-seq+Version:        0.5.1+Copyright:      Bjorn Bringert, Iavor S. Diatchki, Henning Thielemann+Maintainer:     Henning Thielemann <alsa@henning-thielemann.de>+Author:+  Henning Thielemann <alsa@henning-thielemann.de>,+  Dylan Simon <dylan@dylex.net>,+  Bjorn Bringert <bjorn@bringert.net>,+  Iavor S. Diatchki <iavor.diatchki@gmail.com>+Category:       Sound, Music+License:        BSD3+License-file:   LICENSE+Homepage:       http://www.haskell.org/haskellwiki/ALSA+Stability:      Experimental+Build-Type:     Simple+Cabal-Version:  >= 1.8+Synopsis:       Binding to the ALSA Library API (MIDI sequencer). Description:   This package provides access to ALSA sequencer (MIDI support).   For audio support see alsa-pcm.+  Included are some simple example programs.+  For more example programs including a GUI, see the alsa-gui programs.+Extra-Source-Files:+  filter/modify/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs+  filter/setget/Sound/ALSA/Sequencer/Client/Info/EventFilter.hs  Source-Repository head   type:     darcs@@ -23,16 +31,23 @@ Source-Repository this   type:     darcs   location: http://code.haskell.org/~thielema/alsa-seq/-  tag:      0.5+  tag:      0.5.1  Flag buildExamples   description: Build example executables   default:     False +Flag modifyFilter+  description: Use native event filter functions that are provided by newer ALSA versions+  default:     True+ Library   Build-depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    data-accessor >=0.2.1 && <0.3,+    utility-ht >= 0.0.7 && <0.1,     extensible-exceptions >=0.1.1 && <0.2,     base >= 3 && <5 @@ -43,6 +58,12 @@     EmptyDataDecls    Hs-Source-Dirs: src+  If flag(modifyFilter)+    PkgConfig-Depends: alsa >= 1.0.17+    Hs-Source-Dirs: filter/modify+  Else+    PkgConfig-Depends: alsa >= 1.0.14+    Hs-Source-Dirs: filter/setget    Exposed-Modules:     Sound.ALSA.Sequencer@@ -52,12 +73,15 @@     Sound.ALSA.Sequencer.Port     Sound.ALSA.Sequencer.Port.Info     Sound.ALSA.Sequencer.Event+    Sound.ALSA.Sequencer.Event.Accessor     Sound.ALSA.Sequencer.RealTime     Sound.ALSA.Sequencer.Queue     Sound.ALSA.Sequencer.Queue.Info     Sound.ALSA.Sequencer.Queue.Status     Sound.ALSA.Sequencer.Queue.Tempo     Sound.ALSA.Sequencer.Queue.Timer+    Sound.ALSA.Sequencer.Subscribe+    Sound.ALSA.Sequencer.Subscribe.Query    Other-modules:     Sound.ALSA.Sequencer.Marshal.Sequencer@@ -68,18 +92,23 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Client.Info.EventFilter     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer     Sound.ALSA.Sequencer.Utility    Includes: alsa/asoundlib.h-  Extra-libraries: asound -Executable test1-  Main-Is: test1.hs+Executable alsa-seq-dump+  Main-Is: dump.hs   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget   GHC-Options: -Wall -threaded   Extensions:     ForeignFunctionInterface@@ -94,18 +123,25 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,     base >=3 && <5 -Executable test2-  Main-Is: test2.hs+Executable alsa-seq-send-note+  Main-Is: send-note.hs   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget   GHC-Options: -Wall -threaded   Extensions:     ForeignFunctionInterface@@ -120,18 +156,25 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,     base >=3 && <5 -Executable test3-  Main-Is: test3.hs+Executable alsa-seq-broadcast+  Main-Is: broadcast.hs   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget   GHC-Options: -Wall -threaded   Extensions:     ForeignFunctionInterface@@ -146,18 +189,25 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,     base >=3 && <5 -Executable test4-  Main-Is: test4.hs+Executable alsa-seq-list-clients+  Main-Is: list-clients.hs   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget   GHC-Options: -Wall -threaded   Extensions:     ForeignFunctionInterface@@ -172,18 +222,25 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,     base >=3 && <5 -Executable test5-  Main-Is: test5.hs+Executable alsa-seq-melody+  Main-Is: melody.hs   If !flag(buildExamples)     Buildable: False   Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget   GHC-Options: -Wall -threaded   Extensions:     ForeignFunctionInterface@@ -198,9 +255,45 @@     Sound.ALSA.Sequencer.Marshal.QueueTimer     Sound.ALSA.Sequencer.Marshal.Event     Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe     Sound.ALSA.Sequencer.Area     Sound.ALSA.Sequencer.Sequencer   Build-Depends:     alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,     array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,+    base >=3 && <5++Executable alsa-seq-list-subscribers+  Main-Is: list-subscribers.hs+  If !flag(buildExamples)+    Buildable: False+  Hs-Source-Dirs: src, examples+  If flag(modifyFilter)+    Hs-Source-Dirs: filter/modify+  Else+    Hs-Source-Dirs: filter/setget+  GHC-Options: -Wall -threaded+  Extensions:+    ForeignFunctionInterface+    GeneralizedNewtypeDeriving+    EmptyDataDecls+  Other-modules:+    Sound.ALSA.Sequencer.Marshal.Sequencer+    Sound.ALSA.Sequencer.Marshal.Address+    Sound.ALSA.Sequencer.Marshal.Client+    Sound.ALSA.Sequencer.Marshal.Port+    Sound.ALSA.Sequencer.Marshal.Queue+    Sound.ALSA.Sequencer.Marshal.QueueTimer+    Sound.ALSA.Sequencer.Marshal.Event+    Sound.ALSA.Sequencer.Marshal.RealTime+    Sound.ALSA.Sequencer.Marshal.QuerySubscribe+    Sound.ALSA.Sequencer.Area+    Sound.ALSA.Sequencer.Sequencer+  Build-Depends:+    alsa-core >=0.5 && <0.6,+    enumset >= 0.0.2 && <0.1,+    array >= 0.1 && <0.4,+    utility-ht >= 0.0.7 && <0.1,     base >=3 && <5

@@ -0,0 +1,28 @@+import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc++main :: IO ()+main = (do+  putStrLn "Starting."+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Broadcast"+  c <- Client.getId h+  putStrLn ("Created sequencer with id: " ++ show c)+  -- tgt_addr <- Addr.parse h "HS1:255"+  let tgt_addr = Addr.Cons Client.broadcast Port.unknown+  print tgt_addr+  let ev n =+         (Event.simple+            (Addr.Cons c Port.unknown)+            (Event.NoteEv n $ Event.simpleNote 0 60 64))+         {Event.dest = tgt_addr}+  _ <- Event.outputDirect h $ ev Event.NoteOn+  _ <- getChar+  _ <- Event.outputDirect h $ ev Event.NoteOff+  return ())+  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -0,0 +1,23 @@+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc+import Control.Monad (forever, )++main :: IO ()+main = (do+  putStrLn "Starting."+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  Client.setName (h :: SndSeq.T SndSeq.InputMode) "Haskell-Dump"+  putStrLn "Created sequencer."+  Port.withSimple h "primary"+     (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do+  Port.withSimple h "secondary"+     (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p2 -> do+  putStrLn "Created ports."+  forever $ do+     putStrLn "waiting for an event:"+     print =<< Event.input h)+  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -0,0 +1,13 @@+import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo+import qualified Sound.ALSA.Sequencer as SndSeq++import Control.Monad (when, )++main :: IO ()+main =+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  i <- ClientInfo.queryFirst (h :: SndSeq.T SndSeq.OutputMode)+  let loop = do putStrLn =<< ClientInfo.getName i+                more <- ClientInfo.queryNext h i+                when more loop+  loop

@@ -0,0 +1,28 @@+import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Subscribe.Query as Query+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc+import System.Environment (getArgs, )+import Control.Monad ((<=<), forM_, )++main :: IO ()+main = (do+  args <- getArgs+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> forM_ args $ \arg -> do+  a <- Addr.parse (h :: SndSeq.T SndSeq.InputMode) arg+  let showQ q = do+	ad <- Query.getAddr q+	qq <- Query.getQueue q+	ex <- Query.getExclusive q+	tu <- Query.getTimeUpdate q+	tr <- Query.getTimeReal q+	return (show ad ++ ":" ++ show qq +	  ++ (if tu then " update" else "")+	  ++ (if tr then " realtime" else "")+	  ++ (if ex then " exclusive" else ""))+      list t = do+	putStrLn ("subscribers of " ++ show a ++ " for " ++ show t ++ ":")+	mapM_ (putStrLn . (' ':) <=< showQ) =<< Query.queryAll h a t+  mapM_ list [Query.Read, Query.Write])+  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -0,0 +1,103 @@+{- |+Play a melody.+Demonstrate how to wait on the end of a performance of events,+by sending an Echo message to ourselves.+-}+import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer.Queue as Queue+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc++import qualified System.Exit as Exit+import qualified System.IO as IO+import System.Environment (getArgs, )++import Control.Monad (zipWithM_, )+++parseAndConnect ::+   (SndSeq.AllowOutput mode) =>+   SndSeq.T mode -> Port.T -> String -> IO Addr.T+parseAndConnect h p destStr = do+  dest <- Addr.parse h destStr+  SndSeq.connectTo h p dest+  return dest++main :: IO ()+main = (do+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Melody"+  Port.withSimple h "out"+     (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite])+     (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \p -> do+  Queue.with h $ \q -> do+  args <- getArgs+  dest <-+     case args of+        [] -> do+           putStrLn "Enter destination or connect to a synthesizer and hit ENTER"+           destStr <- getLine+           if null destStr+             then return Addr.subscribers+             else parseAndConnect h p destStr+        [destStr] ->+           parseAndConnect h p destStr+        _ ->+           IO.hPutStrLn IO.stderr "too many arguments"+           >>+           Exit.exitFailure++  c <- Client.getId h+  let me = Addr.Cons c p+      ev t e =+         (Event.simple me e) {+             Event.queue = q,+             Event.dest = dest,+             Event.timestamp = Event.TickTime t+          }+      play t chan pitch vel =+         Event.output h (ev t $+            Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch vel)+         >>+         Event.output h (ev (t+1) $+            Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch 0)+         >>+         return ()++      echo t =+         fmap (const ()) $ Event.output h+            ((ev t $ Event.CustomEv Event.Echo $ Event.Custom 0 0 0){+               Event.dest = me+            })++  Queue.control h q Event.QueueStart 0 Nothing+  Queue.control h q Event.QueueTempo 10000000 Nothing+  zipWithM_ (\t ->+        maybe (echo t) (\n -> play t 0 n 64)) [0..] $+     (++[Nothing]) $+     concat $ concatMap (replicate 4 . map Just) $+        [57, 59, 60, 64] :+        [57, 59, 60, 65] :+        [57, 62, 64, 65] :+        [57, 59, 60, 64] :+        []+  _ <- Event.drainOutput h+  _ <- Event.outputPending h++--          threadDelay 10000000+  let waitForEcho = do+         event <- Event.input h+         print event+         case Event.body event of+            Event.CustomEv Event.Echo _d ->+               if Event.source event == me+                 then return ()+                 else waitForEcho+            _ -> waitForEcho+  waitForEcho)++  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -0,0 +1,56 @@+import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Client as Client+import qualified Sound.ALSA.Sequencer.Port as Port+import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq+import qualified Sound.ALSA.Exception as AlsaExc++import qualified System.Exit as Exit+import qualified System.IO as IO+import System.Environment (getArgs, )++parseAndConnect ::+   (SndSeq.AllowOutput mode) =>+   SndSeq.T mode -> Port.T -> String -> IO Addr.T+parseAndConnect h p destStr = do+  dest <- Addr.parse h destStr+  SndSeq.connectTo h p dest+  return dest++main :: IO ()+main = (do+  putStrLn "Starting."+  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do+  Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Send-Note"+  c <- Client.getId h+  putStrLn ("Created sequencer with id: " ++ show c)+  Port.withSimple h "out"+     (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do+  putStrLn "Created port."+  args <- getArgs+  dest <-+     case args of+        [] -> do+           putStrLn "Enter destination or connect to a synthesizer and hit ENTER"+           destStr <- getLine+           if null destStr+             then return Addr.subscribers+             else parseAndConnect h p destStr+        [destStr] ->+           parseAndConnect h p destStr+        _ ->+           IO.hPutStrLn IO.stderr "too many arguments"+           >>+           Exit.exitFailure++  let ev n =+         (Event.simple (Addr.Cons c p) $+            Event.NoteEv n $ Event.simpleNote 0 60 64)+         {Event.dest = dest}+  _ <- Event.outputDirect h $ ev Event.NoteOn+  putStrLn "press Enter for stopping the note"+  _ <- getChar+  _ <- Event.outputDirect h $ ev Event.NoteOff+  return ())+  `AlsaExc.catch` \e ->+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -1,24 +0,0 @@-import qualified Sound.ALSA.Sequencer.Client as Client-import qualified Sound.ALSA.Sequencer.Port as Port-import qualified Sound.ALSA.Sequencer.Event as Event-import qualified Sound.ALSA.Sequencer as SndSeq-import qualified Sound.ALSA.Exception as AlsaExc--main :: IO ()-main = (do-  putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  Client.setName (h :: SndSeq.T SndSeq.InputMode) "HS1"-  putStrLn "Created sequencer."-  Port.withSimple h "one"-     (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p1 -> do-  Port.withSimple h "two"-     (Port.caps [Port.capWrite, Port.capSubsWrite]) Port.typeMidiGeneric $ \ _p2 -> do-  putStrLn "Created ports."-  let loop = do putStrLn "waiting for an event:"-                e <- Event.input h-                print e-                loop-  loop)-  `AlsaExc.catch` \e ->-     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -1,38 +0,0 @@-import qualified Sound.ALSA.Sequencer.Address as Addr-import qualified Sound.ALSA.Sequencer.Client as Client-import qualified Sound.ALSA.Sequencer.Port as Port-import qualified Sound.ALSA.Sequencer.Event as Event-import qualified Sound.ALSA.Sequencer.Queue as Queue-import qualified Sound.ALSA.Sequencer as SndSeq-import qualified Sound.ALSA.Exception as AlsaExc--main :: IO ()-main = (do-  putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  Client.setName (h :: SndSeq.T SndSeq.OutputMode) "HS test client"-  putStrLn "Created sequencer."-  Port.withSimple h "one"-     (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do-  putStrLn "Created port."-  x <- Client.getId h-  putStrLn ("My id is: " ++ show x)-  let me = Addr.Cons { Addr.client = x, Addr.port = p }-  getChar-  Event.outputDirect h (e1 me)-  getChar-  return ())-  `AlsaExc.catch` \e ->-     putStrLn $ "alsa_exception: " ++ AlsaExc.show e---e1 :: Addr.T -> Event.T-e1 me = Event.Cons-  { Event.highPriority = False-  , Event.tag = 0-  , Event.queue = Queue.direct-  , Event.timestamp = Event.TickTime 0-  , Event.source = me-  , Event.dest = Addr.subscribers-  , Event.body = Event.NoteEv Event.NoteOn (Event.simpleNote 0 60 100)-  }

@@ -1,38 +0,0 @@-import qualified Sound.ALSA.Sequencer.Address as Addr-import qualified Sound.ALSA.Sequencer.Client as Client-import qualified Sound.ALSA.Sequencer.Port as Port-import qualified Sound.ALSA.Sequencer.Event as Event-import qualified Sound.ALSA.Sequencer.Queue as Queue-import qualified Sound.ALSA.Sequencer as SndSeq-import qualified Sound.ALSA.Exception as AlsaExc--main :: IO ()-main = (do-  putStrLn "Starting."-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  Client.setName (h :: SndSeq.T SndSeq.OutputMode) "HS3"-  putStrLn "Created sequencer."-  x <- Client.getId h-  putStrLn ("My id is: " ++ show x)-  let me = Addr.Cons { Addr.client = x, Addr.port = Port.unknown }-  -- tgt_addr <- parse_address h "HS1:255"-  let tgt_addr = Addr.Cons Client.broadcast Port.unknown-  print tgt_addr-  getChar-  Event.outputDirect h (e1 me tgt_addr)-  getChar-  return ())-  `AlsaExc.catch` \e ->-     putStrLn $ "alsa_exception: " ++ AlsaExc.show e---e1 :: Addr.T -> Addr.T -> Event.T-e1 from to = Event.Cons-  { Event.highPriority = False-  , Event.tag = 0-  , Event.queue = Queue.direct-  , Event.timestamp = Event.TickTime 0-  , Event.source = from-  , Event.dest = to-  , Event.body = Event.NoteEv Event.NoteOn (Event.simpleNote 0 60 100)-  }

@@ -1,13 +0,0 @@-import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo-import qualified Sound.ALSA.Sequencer as SndSeq--import Control.Monad (when, )--main :: IO ()-main =-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  i <- ClientInfo.queryFirst (h :: SndSeq.T SndSeq.OutputMode)-  let loop = do putStrLn =<< ClientInfo.getName i-                more <- ClientInfo.queryNext h i-                when more loop-  loop

@@ -1,69 +0,0 @@-import qualified Sound.ALSA.Sequencer.Address as Addr-import qualified Sound.ALSA.Sequencer.Client as Client-import qualified Sound.ALSA.Sequencer.Port as Port-import qualified Sound.ALSA.Sequencer.Event as Event-import qualified Sound.ALSA.Sequencer.Queue as Queue-import qualified Sound.ALSA.Sequencer as SndSeq-import qualified Sound.ALSA.Exception as AlsaExc--import Control.Monad (zipWithM_, )---main :: IO ()-main = (do-  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do-  Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "HS5"-  Port.withSimple h "1"-     (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite])-     (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \p -> do-  c <- Client.getId h-  Queue.with h $ \q -> do-  let ev t e = Event.Cons-                 { Event.highPriority = False-                 , Event.tag = 0-                 , Event.queue = q-                 , Event.timestamp = Event.TickTime t-                 , Event.source = Addr.Cons { Addr.client = c, Addr.port = p }-                 , Event.dest = Addr.subscribers-                 , Event.body = e-                 }-      play t chan pitch vel =-           do print =<< Event.output h (ev t $-                 Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch vel)--              print =<< Event.output h (ev (t+1) $-                 Event.NoteEv Event.NoteOn $ Event.simpleNote chan pitch 0)--      echo t =-         print =<< Event.output h-            ((ev t $ Event.CustomEv Event.Echo $ Event.Custom 0 0 0){-               Event.dest = Addr.Cons { Addr.client = c, Addr.port = p }-            })--  putStrLn "Please connect me to a synth"-  getChar-  Queue.control h q Event.QueueStart 0 Nothing-  Queue.control h q Event.QueueTempo 10000000 Nothing-  zipWithM_ (\t ->-        maybe (echo t) (\n -> play t 0 n 127)) [0..] $-     (++[Nothing]) $-     concat $ concatMap (replicate 4 . map Just) $-        [57, 59, 60, 64] :-        [57, 59, 60, 65] :-        [57, 62, 64, 65] :-        [57, 59, 60, 64] :-        []-  Event.drainOutput h-  print =<< Event.outputPending h----          threadDelay 10000000-  let waitForEcho = do-         event <- Event.input h-         print event-         case Event.body event of-            Event.CustomEv Event.Echo _d -> return ()-            _ -> waitForEcho-  waitForEcho)--  `AlsaExc.catch` \e ->-     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

@@ -0,0 +1,42 @@+module Sound.ALSA.Sequencer.Client.Info.EventFilter where++import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event++import Foreign.C.Types(CInt, )+import Foreign.Ptr(Ptr, )+++type T  = Area.ClientInfo+type T_ = Area.ClientInfo_+++clear :: T -> IO ()+add :: Event.Type e => T -> e -> IO ()+delete :: Event.Type e => T -> e -> IO ()+check :: Event.Type e => T -> e -> IO Bool+++clear i =+  Area.with_client_info i snd_seq_client_info_event_filter_clear++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_clear"+  snd_seq_client_info_event_filter_clear :: Ptr T_ -> IO ()++add i e =+  Area.with_client_info i (`snd_seq_client_info_event_filter_add` fromIntegral (Event.expEv e))++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_add"+  snd_seq_client_info_event_filter_add :: Ptr T_ -> CInt -> IO ()++delete i e =+  Area.with_client_info i (`snd_seq_client_info_event_filter_del` fromIntegral (Event.expEv e))++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_del"+  snd_seq_client_info_event_filter_del :: Ptr T_ -> CInt -> IO ()++check i e =+  fmap (/= 0) $ Area.with_client_info i (`snd_seq_client_info_event_filter_check` fromIntegral (Event.expEv e))++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_event_filter_check"+  snd_seq_client_info_event_filter_check :: Ptr T_ -> CInt -> IO CInt

@@ -0,0 +1,80 @@+-- | Emulate new api using the old functions+module Sound.ALSA.Sequencer.Client.Info.EventFilter where++import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event++import Foreign.C.Types (CUInt, )+import Foreign.Ptr (Ptr, nullPtr, )+import Foreign.Marshal.Array (allocaArray, copyArray, )+import Foreign.Storable (sizeOf, peekElemOff, pokeElemOff, )+import Data.Bits (testBit, setBit, clearBit, )+++type T  = Area.ClientInfo+type T_ = Area.ClientInfo_++{- |+Although alsa/seq.h says CUChar, that's not true,+because internally it uses CUInt and+that makes a difference between little and big endian memory access.+-}+type EventTypeSubset = CUInt+type EventTypeSet = Ptr EventTypeSubset+++clear :: T -> IO ()+add :: Event.Type e => T -> e -> IO ()+delete :: Event.Type e => T -> e -> IO ()+check :: Event.Type e => T -> e -> IO Bool++clear i =+  Area.with_client_info i (`snd_seq_client_info_set_event_filter` nullPtr)++bit :: Event.Type e => e -> (Int, Int)+bit e =+  divMod+    (fromIntegral $ Event.expEv e)+    (8 * sizeOf (undefined :: EventTypeSubset))++size :: Int+size = div 32 (sizeOf (undefined :: EventTypeSubset))+  -- succ $ fst $ bit Event.maxEventType++get :: T -> IO EventTypeSet+get i = Area.with_client_info i snd_seq_client_info_get_event_filter++check i e = do+  ef <- get i+  let (o,b) = bit e+  w <- peekElemOff ef o+  return $ testBit w b++set :: T -> EventTypeSet -> IO ()+set i ef =+  Area.with_client_info i (`snd_seq_client_info_set_event_filter` ef)++modify :: T -> (EventTypeSet -> IO ()) -> IO ()+modify i f =+  allocaArray size $ \ef' -> do+    ef <- get i+    copyArray ef' ef size+    f ef'+    set i ef'++modifyByte ::+  (Event.Type e) =>+  (EventTypeSubset -> Int -> EventTypeSubset) -> T -> e -> IO ()+modifyByte f i e =+  modify i $ \ef ->+  let (o,b) = bit e+  in  pokeElemOff ef o . flip f b =<< peekElemOff ef o++add    = modifyByte setBit+delete = modifyByte clearBit++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_get_event_filter"+  snd_seq_client_info_get_event_filter :: Ptr T_ -> IO EventTypeSet++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_client_info_set_event_filter"+  snd_seq_client_info_set_event_filter :: Ptr T_ -> EventTypeSet -> IO ()

@@ -20,8 +20,10 @@ import qualified Sound.ALSA.Sequencer.Marshal.Port as Port import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.QueueTimer as QueueTimer+import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as QuerySubscribe import qualified Sound.ALSA.Exception as Exc +import qualified Data.EnumSet as EnumSet import Foreign.C.Types (CInt, ) import Foreign.C.String (CString, peekCString, withCAString, ) import Foreign.Storable (Storable, peek, )@@ -46,13 +48,13 @@ "-- | Allocate an uninitialized object. (Not exported)\n" y"_malloc :: IO "x"\n" y"_malloc = alloca $ \\p ->\n"-"  do Exc.checkResult \"Sequencer."y"\" =<< snd_seq_"y"_malloc p\n"+"  do Exc.checkResult_ \"Sequencer."y"\" =<< snd_seq_"y"_malloc p\n" "     "x" `fmap` (newForeignPtr snd_seq_"y"_free =<< peek p)\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_malloc\"\n" "  snd_seq_"y"_malloc :: Ptr (Ptr "x"_) -> IO CInt\n" "\n"-"foreign import ccall \"alsa/asoundlib.h &snd_seq_"y"_free\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h &snd_seq_"y"_free\"\n" "   snd_seq_"y"_free :: FunPtr (Ptr "x"_ -> IO ())\n" "\n" "-- | Copy the content of one object into another.\n"@@ -66,7 +68,7 @@ "  with_"y" from $ \\p2 ->\n" "    snd_seq_"y"_copy p1 p2\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_copy\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_copy\"\n" "  snd_seq_"y"_copy :: Ptr "x"_ -> Ptr "x"_ -> IO ()\n" "\n" "-- | Copy the content of an object to a newly created object.\n"@@ -86,23 +88,32 @@ y"_get_name :: "x" -> IO String\n" y"_get_name i = peekCString =<< with_"y" i snd_seq_"y"_get_name\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_name\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_name\"\n" "  snd_seq_"y"_get_name :: Ptr "x"_ -> IO CString\n" "\n" y"_set_name :: "x" -> String -> IO ()\n" y"_set_name i c =\n" "  withCAString c $ \\p -> with_"y" i (`snd_seq_"y"_set_name` p)\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_name\"\n" "  snd_seq_"y"_set_name :: Ptr "x"_ -> CString -> IO ()\n" } +#{let get_bool x,y,z =+y"_get_"z" :: "x" -> IO Bool\n"+y"_get_"z" i =\n"+"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"+"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"+"  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n"+}+ #{let get_set_bool x,y,z = y"_get_"z" :: "x" -> IO Bool\n" y"_get_"z" i =\n"-"  (1 ==) `fmap` with_"y" i snd_seq_"y"_get_"z"\n"+"  (0 /=) `fmap` with_"y" i snd_seq_"y"_get_"z"\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" "  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n" "\n" y"_set_"z" :: "x" -> Bool -> IO ()\n"@@ -110,7 +121,7 @@ "  let x = if c then 1 else 0\n" "  in with_"y" i (`snd_seq_"y"_set_"z"` x)\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" "  snd_seq_"y"_set_"z" :: Ptr "x"_ -> CInt -> IO ()\n" } @@ -120,7 +131,7 @@ "  "mk"\n" "      `fmap` with_"y" i snd_seq_"y"_get_"z"\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_get_"z"\"\n" "  snd_seq_"y"_get_"z" :: Ptr "x"_ -> IO CInt\n" } @@ -129,7 +140,7 @@ y"_set_"z" i c =\n" "  with_"y" i (`snd_seq_"y"_set_"z"` "brk" c)\n" "\n"-"foreign import ccall \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n"+"foreign import ccall unsafe \"alsa/asoundlib.h snd_seq_"y"_set_"z"\"\n" "  snd_seq_"y"_set_"z"  :: Ptr "x"_ -> CInt -> IO ()\n" } @@ -175,9 +186,9 @@ #{set_int "PortInfo", "port_info", "client",           "Client.T","Client.exp"} #{get_int "PortInfo", "port_info", "capability",-          "Port.Cap","(Port.Cap . fromIntegral)"}+          "Port.Cap","(EnumSet.Cons . fromIntegral)"} #{set_int "PortInfo", "port_info", "capability",-          "Port.Cap","(fromIntegral . Port.unCap)"}+          "Port.Cap","(fromIntegral . EnumSet.decons)"}  #{get_int "PortInfo", "port_info", "midi_channels",           "Word","fromIntegral"}@@ -202,6 +213,46 @@           "Word","fromIntegral"} #{get_int "PortInfo", "port_info", "write_use",           "Word","fromIntegral"}++-- Subscribe Port ----------------------------------------------------------------+#area "PortSubscribe",	"port_subscribe"++#{get_int "PortSubscribe", "port_subscribe", "queue",+           "Queue.T","Queue.imp"}+#{set_int "PortSubscribe", "port_subscribe", "queue",+           "Queue.T","Queue.exp"}+#get_set_bool "PortSubscribe", "port_subscribe", "exclusive"+#get_set_bool "PortSubscribe", "port_subscribe", "time_update"+#get_set_bool "PortSubscribe", "port_subscribe", "time_real"++-- Subscribe Query ---------------------------------------------------------------+#area "QuerySubscribe", "query_subscribe"++#{get_int "QuerySubscribe", "query_subscribe", "client",+          "Client.T", "Client.imp"}+#{set_int "QuerySubscribe", "query_subscribe", "client",+          "Client.T", "Client.exp"}+#{get_int "QuerySubscribe", "query_subscribe", "port",+          "Port.T", "Port.imp"}+#{set_int "QuerySubscribe", "query_subscribe", "port",+          "Port.T", "Port.exp"}+#{get_int "QuerySubscribe", "query_subscribe", "type",+          "QuerySubscribe.Type", "QuerySubscribe.impType"}+#{set_int "QuerySubscribe", "query_subscribe", "type",+          "QuerySubscribe.Type", "QuerySubscribe.expType"}+#{get_int "QuerySubscribe", "query_subscribe", "index",+          "Word", "fromIntegral"}+#{set_int "QuerySubscribe", "query_subscribe", "index",+          "Word", "fromIntegral"}++-- RO+#{get_int "QuerySubscribe", "query_subscribe", "num_subs",+          "Word", "fromIntegral"}+#{get_int "QuerySubscribe", "query_subscribe", "queue",+          "Queue.T", "Queue.imp"}+#get_bool "QuerySubscribe", "query_subscribe", "exclusive"+#get_bool "QuerySubscribe", "query_subscribe", "time_update"+#get_bool "QuerySubscribe", "query_subscribe", "time_real"  -- Queue.T Info ------------------------------------------------------------------ #area "QueueInfo",   "queue_info"

@@ -21,6 +21,7 @@   , queryFirst   , queryNext   , set+  , modify    , copy   , clone@@ -37,12 +38,19 @@   , setName   , setBroadcastFilter   , setErrorBounce++  , filterClear+  , filterAdd+  , filterDel+  , filterCheck   ) where +import qualified Sound.ALSA.Sequencer.Client.Info.EventFilter as Filter  import qualified Sound.ALSA.Sequencer.Marshal.Client as Client import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event import qualified Sound.ALSA.Exception as Exc  import Foreign.C.Types(CInt, )@@ -61,10 +69,10 @@ get :: Seq.T mode -> IO T get (Seq.Cons h) =   do info <- Area.client_info_malloc-     Exc.checkResult "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h)+     Exc.checkResult_ "get_client_info" =<< Area.with_client_info info (snd_seq_get_client_info h)      return info -foreign import ccall "alsa/asoundlib.h snd_seq_get_client_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_client_info"   snd_seq_get_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt  @@ -72,11 +80,11 @@ getAny :: Seq.T mode -> Client.T -> IO T getAny (Seq.Cons h) c =   do info <- Area.client_info_malloc-     Exc.checkResult "get_any_client_info" =<< Area.with_client_info info+     Exc.checkResult_ "get_any_client_info" =<< Area.with_client_info info                         (snd_seq_get_any_client_info h (Client.exp c))      return info -foreign import ccall "alsa/asoundlib.h snd_seq_get_any_client_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_client_info"   snd_seq_get_any_client_info     :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt @@ -99,7 +107,7 @@          (const True) (\x -> guard (x == -2) >> return False)       =<< Area.with_client_info info (snd_seq_query_next_client h) -foreign import ccall "alsa/asoundlib.h snd_seq_query_next_client"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_client"   snd_seq_query_next_client :: Ptr Seq.Core -> Ptr T_ -> IO CInt  @@ -109,8 +117,23 @@ set (Seq.Cons h) info =   Exc.checkResult_ "set_client_info" =<< Area.with_client_info info (snd_seq_set_client_info h) -foreign import ccall "alsa/asoundlib.h snd_seq_set_client_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_info"   snd_seq_set_client_info :: Ptr Seq.Core -> Ptr T_ -> IO CInt+++modify :: Seq.T mode -> (T -> IO T) -> IO ()+modify ss f = set ss =<< f =<< get ss+++filterClear :: T -> IO ()+filterAdd :: Event.Type e => T -> e -> IO ()+filterDel :: Event.Type e => T -> e -> IO ()+filterCheck :: Event.Type e => T -> e -> IO Bool++filterClear = Filter.clear+filterAdd   = Filter.add+filterDel   = Filter.delete+filterCheck = Filter.check   copy :: T -> T -> IO ()

@@ -29,16 +29,14 @@   , dropInput   , dropInputBuffer -  , volumeSame-   , TimeStamp(..)   , InstrCluster   , Instr(..)   , Sample(..)   , Cluster(..)-  , Volume(..)+  , Volume(..), volumeSame -  , Event.T(..)+  , Event.T(..), simple   , Event.Data(..)   , NoteEv(..), Note(..), simpleNote   , CtrlEv(..), Ctrl(..)@@ -50,6 +48,8 @@   ) where  +import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Queue as Queue import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq import Sound.ALSA.Sequencer.Marshal.Event as Event import qualified Sound.ALSA.Exception as Exc@@ -68,7 +68,7 @@ syncOutputQueue (Seq.Cons h) =   Exc.checkResult_ "syncOutputQueue" =<< snd_seq_sync_output_queue h -foreign import ccall "alsa/asoundlib.h snd_seq_sync_output_queue"+foreign import ccall safe "alsa/asoundlib.h snd_seq_sync_output_queue"   snd_seq_sync_output_queue :: Ptr Seq.Core -> IO CInt  @@ -84,10 +84,10 @@ -- input :: Seq.AllowInput mode => Seq.T mode -> IO Event.T input (Seq.Cons h) = alloca $ \p ->-  do Exc.checkResult "input" =<< snd_seq_event_input h p+  do Exc.checkResult_ "input" =<< snd_seq_event_input h p      peek =<< peek p -foreign import ccall "alsa/asoundlib.h snd_seq_event_input"+foreign import ccall safe "alsa/asoundlib.h snd_seq_event_input"   snd_seq_event_input :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt  @@ -109,7 +109,7 @@ inputPending (Seq.Cons h) fill =   checkResult "inputPending" =<< snd_seq_event_input_pending h (if fill then 1 else 0) -foreign import ccall "alsa/asoundlib.h snd_seq_event_input_pending"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_input_pending"   snd_seq_event_input_pending :: Ptr Seq.Core -> Int -> IO CInt  @@ -127,7 +127,7 @@ output (Seq.Cons h) e =   Event.allocaEv e $ \p -> checkResult "output" =<< snd_seq_event_output h p -foreign import ccall "alsa/asoundlib.h snd_seq_event_output"+foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output"   snd_seq_event_output :: Ptr Seq.Core -> Ptr Event.T -> IO CInt  @@ -144,7 +144,7 @@ outputBuffer (Seq.Cons h) e =   Event.allocaEv e $ \p -> checkResult "outputBuffer" =<< snd_seq_event_output_buffer h p -foreign import ccall "alsa/asoundlib.h snd_seq_event_output_buffer"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_buffer"   snd_seq_event_output_buffer :: Ptr Seq.Core -> Ptr Event.T -> IO CInt  @@ -161,7 +161,7 @@ outputDirect (Seq.Cons h) e =   Event.allocaEv e $ \p -> checkResult "outputDirect" =<< snd_seq_event_output_direct h p -foreign import ccall "alsa/asoundlib.h snd_seq_event_output_direct"+foreign import ccall safe "alsa/asoundlib.h snd_seq_event_output_direct"   snd_seq_event_output_direct :: Ptr Seq.Core -> Ptr Event.T -> IO CInt  @@ -174,7 +174,7 @@ outputPending (Seq.Cons h) =   fromIntegral `fmap` snd_seq_event_output_pending h -foreign import ccall "alsa/asoundlib.h snd_seq_event_output_pending"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_event_output_pending"   snd_seq_event_output_pending :: Ptr Seq.Core -> IO CInt  @@ -186,7 +186,7 @@   => Seq.T mode   -> IO Event.T   -- ^ the first event in the buffer (if one was present) extractOutput (Seq.Cons h) =-  alloca $ \p -> do Exc.checkResult "extractOutput" =<< snd_seq_extract_output h p+  alloca $ \p -> do Exc.checkResult_ "extractOutput" =<< snd_seq_extract_output h p                     peek =<< peek p  -- | Remove the first event in output buffer.@@ -196,7 +196,7 @@   => Seq.T mode -> IO () removeOutput (Seq.Cons h) = Exc.checkResult_ "removeOutput" =<< snd_seq_extract_output h nullPtr -foreign import ccall "alsa/asoundlib.h snd_seq_extract_output"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_extract_output"   snd_seq_extract_output :: Ptr Seq.Core -> Ptr (Ptr Event.T) -> IO CInt  @@ -216,7 +216,7 @@  drainOutput (Seq.Cons h) = checkResult "drainOutput" =<< snd_seq_drain_output h -foreign import ccall "alsa/asoundlib.h snd_seq_drain_output"+foreign import ccall safe "alsa/asoundlib.h snd_seq_drain_output"   snd_seq_drain_output :: Ptr Seq.Core -> IO CInt  @@ -228,7 +228,7 @@   => Seq.T mode -> IO () dropOutput (Seq.Cons h) = Exc.checkResult_ "dropOutput" =<< snd_seq_drop_output h -foreign import ccall "alsa/asoundlib.h snd_seq_drop_output"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output"   snd_seq_drop_output :: Ptr Seq.Core -> IO CInt  @@ -239,7 +239,7 @@   => Seq.T mode -> IO () dropOutputBuffer (Seq.Cons h) = Exc.checkResult_ "dropOutputBuffer" =<< snd_seq_drop_output_buffer h -foreign import ccall "alsa/asoundlib.h snd_seq_drop_output_buffer"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_output_buffer"   snd_seq_drop_output_buffer :: Ptr Seq.Core -> IO CInt  @@ -251,7 +251,7 @@   => Seq.T mode -> IO () dropInput (Seq.Cons h) = Exc.checkResult_ "dropInput" =<< snd_seq_drop_input h -foreign import ccall "alsa/asoundlib.h snd_seq_drop_input"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input"   snd_seq_drop_input :: Ptr Seq.Core -> IO CInt  @@ -262,7 +262,7 @@   => Seq.T mode -> IO () dropInputBuffer (Seq.Cons h) = Exc.checkResult_ "dropInputBuffer" =<< snd_seq_drop_input_buffer h -foreign import ccall "alsa/asoundlib.h snd_seq_drop_input_buffer"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_drop_input_buffer"   snd_seq_drop_input_buffer :: Ptr Seq.Core -> IO CInt  @@ -282,6 +282,23 @@       Event.noteDuration = 0    } +{- |+Construct an ALSA sequencer event from very few information.+Most fields are initialized with sensible defaults.+You may use this as a start and alter its fields for your special needs.++> (Event.simple myAddr (Event.simpleNote 0 60 64)) {Event.dest = destAddr}+-}+simple :: Addr.T -> Event.Data -> Event.T+simple src bdy = Cons+  { Event.highPriority = False+  , Event.tag = 0+  , Event.queue = Queue.direct+  , Event.timestamp = Event.TickTime 0+  , Event.source = src+  , Event.dest = Addr.subscribers+  , Event.body = bdy+  }  -- | Used for volume control: means do not change the volume. volumeSame :: Int16

@@ -0,0 +1,47 @@+module Sound.ALSA.Sequencer.Event.Accessor (+   highPriority,+   tag,+   queue,+   timestamp,+   source,+   dest,+   connect,+   body,+   ) where++import qualified Sound.ALSA.Sequencer.Address as Addr+import qualified Sound.ALSA.Sequencer.Queue as Queue+import qualified Sound.ALSA.Sequencer.Marshal.Event as Event++import qualified Data.Accessor.Basic as Acc++import Data.Word (Word8, )+++highPriority :: Acc.T Event.T Bool+tag :: Acc.T Event.T Word8+queue :: Acc.T Event.T Queue.T+timestamp :: Acc.T Event.T Event.TimeStamp+source :: Acc.T Event.T Addr.T+dest :: Acc.T Event.T Addr.T+connect :: Acc.T Event.T Event.Connect+body :: Acc.T Event.T Event.Data++highPriority =+   Acc.fromSetGet (\x ev -> ev{Event.highPriority = x}) Event.highPriority+tag =+   Acc.fromSetGet (\x ev -> ev{Event.tag = x}) Event.tag+queue =+   Acc.fromSetGet (\x ev -> ev{Event.queue = x}) Event.queue+timestamp =+   Acc.fromSetGet (\x ev -> ev{Event.timestamp = x}) Event.timestamp+source =+   Acc.fromSetGet (\x ev -> ev{Event.source = x}) Event.source+dest =+   Acc.fromSetGet (\x ev -> ev{Event.dest = x}) Event.dest+connect =+   Acc.fromSetGet+      (\(Event.Connect src dst) ev -> ev{Event.source = src, Event.dest = dst})+      (\ev -> Event.Connect (Event.source ev) (Event.dest ev))+body =+   Acc.fromSetGet (\x ev -> ev{Event.body = x}) Event.body

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Marshal.Event--- Copyright : (c) Henning Thielemann, 2010+-- Copyright : (c) Henning Thielemann, 2011 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -33,12 +33,66 @@           (Storable, sizeOf, alignment, peek, poke, pokeByteOff, peekByteOff, ) import Foreign.Ptr (Ptr, castPtr, nullPtr, plusPtr, ) import Foreign.Marshal.Alloc (alloca, )-import Data.Bits ((.|.), (.&.), )+import Data.Monoid (mappend, )+import qualified Data.FlagSet as FlagSet import Data.Int (Int16, Int32, ) import Data.Word (Word8, Word16, Word32, ) import Data.Array (Array, (!), accumArray, )  +data Flag+type Flags     = FlagSet.T Word8 Flag+type FlagValue = FlagSet.MaskedValue Word8 Flag+++timeStampTick, timeStampReal :: FlagValue+timeStampTick =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_STAMP_MASK}+      #{const SND_SEQ_TIME_STAMP_TICK}+timeStampReal =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_STAMP_MASK}+      #{const SND_SEQ_TIME_STAMP_REAL}+++timeModeAbs, timeModeRel :: FlagValue+timeModeAbs =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_MODE_MASK}+      #{const SND_SEQ_TIME_MODE_ABS}+timeModeRel =+   FlagSet.MaskedValue+      #{const SND_SEQ_TIME_MODE_MASK}+      #{const SND_SEQ_TIME_MODE_REL}+++eventLengthFixed, eventLengthVariable, eventLengthVarUser :: FlagValue+eventLengthFixed =+   FlagSet.MaskedValue+      #{const SND_SEQ_EVENT_LENGTH_MASK}+      #{const SND_SEQ_EVENT_LENGTH_FIXED}+eventLengthVariable =+   FlagSet.MaskedValue+      #{const SND_SEQ_EVENT_LENGTH_MASK}+      #{const SND_SEQ_EVENT_LENGTH_VARIABLE}+eventLengthVarUser =+   FlagSet.MaskedValue+      #{const SND_SEQ_EVENT_LENGTH_MASK}+      #{const SND_SEQ_EVENT_LENGTH_VARUSR}+++priorityHigh, priorityNormal :: FlagValue+priorityHigh =+   FlagSet.MaskedValue+      #{const SND_SEQ_PRIORITY_MASK}+      #{const SND_SEQ_PRIORITY_HIGH}+priorityNormal =+   FlagSet.MaskedValue+      #{const SND_SEQ_PRIORITY_MASK}+      #{const SND_SEQ_PRIORITY_NORMAL}++ data Connect = Connect    { connSource :: !Addr.T    , connDest   :: !Addr.T@@ -58,17 +112,16 @@                     | RealTime !RealTime.T                       deriving Show -peekTimestamp :: Word8 -> Ptr TimeStamp -> IO TimeStamp+peekTimestamp :: Flags -> Ptr TimeStamp -> IO TimeStamp peekTimestamp flags p =-  case flags .&. #{const SND_SEQ_TIME_STAMP_MASK} of-    { #{const SND_SEQ_TIME_STAMP_TICK} -> TickTime `fmap` peek (castPtr p)-    ; _                                -> RealTime `fmap` peek (castPtr p)-    }+  if FlagSet.match flags timeStampTick+    then fmap TickTime $ peek $ castPtr p+    else fmap RealTime $ peek $ castPtr p -pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO Word8+pokeTimestamp :: Ptr TimeStamp -> TimeStamp -> IO FlagValue pokeTimestamp p ts = case ts of-  TickTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_TICK}-  RealTime t -> poke (castPtr p) t >> return #{const SND_SEQ_TIME_STAMP_REAL}+  TickTime t -> poke (castPtr p) t >> return timeStampTick+  RealTime t -> poke (castPtr p) t >> return timeStampReal   @@ -253,7 +306,7 @@        dst   <- #{peek snd_seq_event_t, dest} p        d     <- (peekData ! ty) (#{ptr snd_seq_event_t, data} p)        return Cons-         { highPriority = (flags .&. #{const SND_SEQ_PRIORITY_MASK}) /= 0+         { highPriority = not $ FlagSet.match flags priorityNormal          , tag = tg          , queue = q          , timestamp = time@@ -269,12 +322,13 @@     ; real <- pokeTimestamp (#{ptr snd_seq_event_t, time} p) (timestamp e)     ; #{poke snd_seq_event_t, source} p (source e)     ; #{poke snd_seq_event_t, dest} p (dest e)-    ; let flags = (if highPriority e-                     then #{const SND_SEQ_PRIORITY_HIGH}-                     else #{const SND_SEQ_PRIORITY_NORMAL})-               .|. real-               .|. #{const SND_SEQ_EVENT_LENGTH_FIXED}  -- XXX-    ; #{poke snd_seq_event_t, flags} p flags+    ; let flags =+             (if highPriority e+                then priorityHigh+                else priorityNormal)+             `mappend` real+             `mappend` eventLengthFixed+    ; #{poke snd_seq_event_t, flags} p (FlagSet.fromMaskedValue flags)     }  allocaEv :: T -> (Ptr T -> IO a) -> IO a@@ -284,14 +338,20 @@ allocaMaybeEv me h =   maybe (h nullPtr) (\e -> allocaEv e h) me +pokeBody ::+  (Storable d, Type e) =>+  Ptr Data -> e -> d -> IO Word8+pokeBody p e d =+  poke (castPtr p) d >> return (expEv e)+ pokeData :: Ptr Data -> Data -> IO Word8 pokeData p dt = case dt of-  NoteEv e d  -> poke (castPtr p) d >> return (expNoteEv e)-  CtrlEv e d  -> poke (castPtr p) d >> return (expCtrlEv e)-  AddrEv e d  -> poke (castPtr p) d >> return (expAddrEv e)-  ConnEv e d  -> poke (castPtr p) d >> return (expConnEv e)-  CustomEv e d -> poke (castPtr p) d >> return (expCustomEv e)-  EmptyEv e   -> return (expEmptyEv e)+  NoteEv   e d -> pokeBody p e d+  CtrlEv   e d -> pokeBody p e d+  AddrEv   e d -> pokeBody p e d+  ConnEv   e d -> pokeBody p e d+  CustomEv e d -> pokeBody p e d+  EmptyEv  e   -> return (expEv e)   peekData :: Array Word8 (Ptr Data -> IO Data)@@ -410,7 +470,7 @@   data NoteEv   = ANote | NoteOn | NoteOff | KeyPress-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data CtrlEv   = Controller | PgmChange | ChanPress               | PitchBend | Control14@@ -418,7 +478,7 @@               | SongPos | SongSel               | QFrame               | TimeSign | KeySign-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data QueueEv  = QueueStart               | QueueContinue@@ -430,33 +490,36 @@               | QueueTick               | QueueSkew               | QueueSyncPos-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data EmptyEv  = TuneRequest | Reset | Sensing | None | Unknown-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data CustomEv = Echo | OSS               | User0 | User1 | User2 | User3 | User4               | User5 | User6 | User7 | User8 | User9-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data AddrEv   = ClientStart | ClientExit | ClientChange               | PortStart | PortExit | PortChange-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  data ConnEv   = PortSubscribed | PortUnsubscribed-                deriving Show+                deriving (Show, Eq, Ord, Enum, Bounded)  -expNoteEv :: NoteEv -> Word8-expNoteEv e = case e of+class Type e where+  expEv :: e -> Word8++instance Type NoteEv where + expEv e = case e of   ANote    -> #{const SND_SEQ_EVENT_NOTE}   NoteOn   -> #{const SND_SEQ_EVENT_NOTEON}   NoteOff  -> #{const SND_SEQ_EVENT_NOTEOFF}   KeyPress -> #{const SND_SEQ_EVENT_KEYPRESS} -expCtrlEv :: CtrlEv -> Word8-expCtrlEv e = case e of+instance Type CtrlEv where + expEv e = case e of   Controller  -> #{const SND_SEQ_EVENT_CONTROLLER}   PgmChange   -> #{const SND_SEQ_EVENT_PGMCHANGE}   ChanPress   -> #{const SND_SEQ_EVENT_CHANPRESS}@@ -470,8 +533,8 @@   TimeSign    -> #{const SND_SEQ_EVENT_TIMESIGN}   KeySign     -> #{const SND_SEQ_EVENT_KEYSIGN} -expQueueEv :: QueueEv -> Word8-expQueueEv e = case e of+instance Type QueueEv where + expEv e = case e of   QueueStart      -> #{const SND_SEQ_EVENT_START}   QueueContinue   -> #{const SND_SEQ_EVENT_CONTINUE}   QueueStop       -> #{const SND_SEQ_EVENT_STOP}@@ -483,16 +546,16 @@   QueueSkew       -> #{const SND_SEQ_EVENT_QUEUE_SKEW}   QueueSyncPos    -> #{const SND_SEQ_EVENT_SYNC_POS} -expEmptyEv :: EmptyEv -> Word8-expEmptyEv e = case e of+instance Type EmptyEv where + expEv e = case e of   TuneRequest -> #{const SND_SEQ_EVENT_TUNE_REQUEST}   Reset       -> #{const SND_SEQ_EVENT_RESET}   Sensing     -> #{const SND_SEQ_EVENT_SENSING}   None        -> #{const SND_SEQ_EVENT_NONE}   Unknown     -> #{const SND_SEQ_EVENT_NONE} -expCustomEv :: CustomEv -> Word8-expCustomEv e = case e of+instance Type CustomEv where + expEv e = case e of   Echo  -> #{const SND_SEQ_EVENT_ECHO}   OSS   -> #{const SND_SEQ_EVENT_OSS}   User0 -> #{const SND_SEQ_EVENT_USR0}@@ -506,8 +569,8 @@   User8 -> #{const SND_SEQ_EVENT_USR8}   User9 -> #{const SND_SEQ_EVENT_USR9} -expAddrEv :: AddrEv -> Word8-expAddrEv e = case e of+instance Type AddrEv where +  expEv e = case e of     ClientStart -> #{const SND_SEQ_EVENT_CLIENT_START}     ClientExit -> #{const SND_SEQ_EVENT_CLIENT_EXIT}     ClientChange -> #{const SND_SEQ_EVENT_CLIENT_CHANGE}@@ -515,29 +578,39 @@     PortExit -> #{const SND_SEQ_EVENT_PORT_EXIT}     PortChange -> #{const SND_SEQ_EVENT_PORT_CHANGE} -expConnEv :: ConnEv -> Word8-expConnEv e = case e of+instance Type ConnEv where + expEv e = case e of   PortSubscribed   -> #{const SND_SEQ_EVENT_PORT_SUBSCRIBED}   PortUnsubscribed -> #{const SND_SEQ_EVENT_PORT_UNSUBSCRIBED}  +maxEventType :: EmptyEv+maxEventType = maxBound+++peekBody ::+  (Storable d) =>+  (d -> Data) -> Ptr Data -> IO Data+peekBody makeBody p =+  fmap makeBody (peek (castPtr p))+ peekNoteEv :: NoteEv -> Ptr Data -> IO Data-peekNoteEv e p = NoteEv e `fmap` peek (castPtr p)+peekNoteEv e = peekBody (NoteEv e)  peekCtrlEv :: CtrlEv -> Ptr Data -> IO Data-peekCtrlEv e p = CtrlEv e `fmap` peek (castPtr p)+peekCtrlEv e = peekBody (CtrlEv e)  peekAddrEv :: AddrEv -> Ptr Data -> IO Data-peekAddrEv e p = AddrEv e `fmap` peek (castPtr p)+peekAddrEv e = peekBody (AddrEv e)  peekConnEv :: ConnEv -> Ptr Data -> IO Data-peekConnEv e p = ConnEv e `fmap` peek (castPtr p)+peekConnEv e = peekBody (ConnEv e)  peekEmptyEv :: EmptyEv -> Ptr Data -> IO Data peekEmptyEv e _ = return (EmptyEv e)  peekCustomEv :: CustomEv -> Ptr Data -> IO Data-peekCustomEv e p = CustomEv e `fmap` peek (castPtr p)+peekCustomEv e = peekBody (CustomEv e)   data Data

@@ -1,7 +1,7 @@ -------------------------------------------------------------------------------- -- | -- Module    : Sound.ALSA.Sequencer.Marshal--- Copyright : (c) Henning Thielemann, 2010+-- Copyright : (c) Henning Thielemann, 2011 --             (c) Iavor S. Diatchki, 2007 -- License   : BSD3 --@@ -26,9 +26,11 @@ import qualified Sound.ALSA.Sequencer.Utility as U import Foreign.C.Types (CInt, CUInt, ) import Foreign.Storable (Storable, )-import Data.Bits ((.|.), )+import Data.Ix (Ix, range, index, inRange, rangeSize, ) import Data.Word (Word8, )-+import Data.Maybe (fromMaybe, )+import qualified Data.Ix.Enum as IxEnum+import qualified Data.EnumSet as EnumSet   -- The type of client ports.@@ -46,11 +48,156 @@ imp p = Cons (fromIntegral p)  +{-+We could also define++> newtype CapabilityFlag = CapabilityFlag Int++but the enumeration definition gives nicer Show instance.+-}+data CapabilityFlag =+     CapOther Int   {- ^ a capability that cannot be represented by the other constructors -}+   | CapRead        {- ^ readable from this port -}+   | CapWrite       {- ^ writable to this port -}+   | CapSyncRead    {- ^ allow read subscriptions -}+   | CapSyncWrite   {- ^ allow write subscriptions -}+   | CapDuplex      {- ^ allow read/write duplex -}+   | CapSubsRead    {- ^ allow read subscription -}+   | CapSubsWrite   {- ^ allow write subscription -}+   | CapNoExport    {- ^ routing not allowed -}+     deriving (Eq, Ord, Show)++data TypeFlag =+     TypeOther Int      {- ^ a type that cannot be represented by the other constructors -}+   | TypeSpecific       {- ^ hardware specific -}+   | TypeMIDIGeneric    {- ^ generic MIDI device -}+   | TypeMIDIGM         {- ^ General MIDI compatible device -}+   | TypeMIDIGS         {- ^ GS compatible device -}+   | TypeMIDIXG         {- ^ XG compatible device -}+   | TypeMIDIMT32       {- ^ MT-32 compatible device -}+   | TypeMIDIGM2        {- ^ General MIDI 2 compatible device -}++   | TypeSynth          {- ^ Synth device -}+   | TypeDirectSample   {- ^ Sampling device (support sample download) -}+   | TypeSample         {- ^ Sampling device (sample can be downloaded at any time) -}++   | TypeHardware       {- ^ This port is implemented in hardware. -}+   | TypeSoftware       {- ^ This port is implemented in software. -}+   | TypeSynthesizer    {- ^ Messages sent to this port will generate sounds. -}+   | TypePort           {- ^ This port may connect to other devices+                             (whose characteristics are not known). -}+   | TypeApplication    {- ^ application (sequencer/editor) -}+     deriving (Eq, Ord, Show)+++capFlagSet :: CapabilityFlag -> Cap+capFlagSet cap =+   case cap of+      CapOther n   -> EnumSet.singletonByPosition n+      CapRead      -> capRead+      CapWrite     -> capWrite+      CapSyncRead  -> capSyncRead+      CapSyncWrite -> capSyncWrite+      CapDuplex    -> capDuplex+      CapSubsRead  -> capSubsRead+      CapSubsWrite -> capSubsWrite+      CapNoExport  -> capNoExport++{- |+The Enum instance may not be very efficient,+but it should hardly be used, at all.+Better use constants such as 'capRead' and set manipulation.+If the binary logarithm is computed by constant unfolding,+performance would be better, but direct set manipulation is still faster.+We implement the 'Enum' instance in this way,+in order to stay independent from the particular ALSA definitions,+that may differ between platforms.+-}+instance Enum CapabilityFlag where+   fromEnum cap =+      case cap of+         CapOther n -> n+         _ -> EnumSet.mostSignificantPosition (capFlagSet cap)+   toEnum n =+      fromMaybe (CapOther n) $+      lookup (EnumSet.singletonByPosition n) $+      map (\cap -> (capFlagSet cap, cap)) $+         CapRead :+         CapWrite :+         CapSyncRead :+         CapSyncWrite :+         CapDuplex :+         CapSubsRead :+         CapSubsWrite :+         CapNoExport :+         []++instance Ix CapabilityFlag where+   range     = IxEnum.range+   index     = IxEnum.index+   inRange   = IxEnum.inRange+   rangeSize = IxEnum.rangeSize+++typeFlagSet :: TypeFlag -> Type+typeFlagSet typ =+   case typ of+      TypeOther n      -> EnumSet.singletonByPosition n+      TypeSpecific     -> typeSpecific+      TypeMIDIGeneric  -> typeMidiGeneric+      TypeMIDIGM       -> typeMidiGM+      TypeMIDIGS       -> typeMidiGS+      TypeMIDIXG       -> typeMidiXG+      TypeMIDIMT32     -> typeMidiMT32+      TypeMIDIGM2      -> typeMidiGM2+      TypeSynth        -> typeSynth+      TypeDirectSample -> typeDirectSample+      TypeSample       -> typeSample+      TypeHardware     -> typeHardware+      TypeSoftware     -> typeSoftware+      TypeSynthesizer  -> typeSynthesizer+      TypePort         -> typePort+      TypeApplication  -> typeApplication++instance Enum TypeFlag where+   fromEnum typ =+      case typ of+         TypeOther n -> n+         _ -> EnumSet.mostSignificantPosition (typeFlagSet typ)+   toEnum n =+      fromMaybe (TypeOther n) $+      lookup (EnumSet.singletonByPosition n) $+      map (\typ -> (typeFlagSet typ, typ)) $+         TypeSpecific :+         TypeMIDIGeneric :+         TypeMIDIGM :+         TypeMIDIGS :+         TypeMIDIXG :+         TypeMIDIMT32 :+         TypeMIDIGM2 :+         TypeSynth :+         TypeDirectSample :+         TypeSample :+         TypeHardware :+         TypeSoftware :+         TypeSynthesizer :+         TypePort :+         TypeApplication :+         []+++instance Ix TypeFlag where+   range     = IxEnum.range+   index     = IxEnum.index+   inRange   = IxEnum.inRange+   rangeSize = IxEnum.rangeSize++ -- | Port capabilities.-newtype Cap = Cap { unCap :: CUInt } deriving (Eq,Ord)+type Cap = EnumSet.T CUInt CapabilityFlag  -- | Port types.-newtype Type = Type { unType :: CUInt } deriving (Eq,Ord)+type Type = EnumSet.T CUInt TypeFlag  #{enum T, Cons  , systemTimer    = SND_SEQ_PORT_SYSTEM_TIMER@@ -58,7 +205,7 @@  , unknown        = SND_SEQ_ADDRESS_UNKNOWN  } -#{enum Cap, Cap+#{enum Cap, EnumSet.Cons  , capRead      = SND_SEQ_PORT_CAP_READ  , capWrite     = SND_SEQ_PORT_CAP_WRITE  , capSyncRead  = SND_SEQ_PORT_CAP_SYNC_READ@@ -70,9 +217,9 @@  }  caps :: [Cap] -> Cap-caps cs = Cap (foldl (.|.) 0 (map unCap cs))+caps = EnumSet.unions -#{enum Type, Type+#{enum Type, EnumSet.Cons  , typeSpecific     = SND_SEQ_PORT_TYPE_SPECIFIC  , typeMidiGeneric  = SND_SEQ_PORT_TYPE_MIDI_GENERIC  , typeMidiGM       = SND_SEQ_PORT_TYPE_MIDI_GM@@ -93,4 +240,4 @@  }  types :: [Type] -> Type-types cs = Type (foldl (.|.) 0 (map unType cs))+types = EnumSet.unions

@@ -0,0 +1,21 @@+module Sound.ALSA.Sequencer.Marshal.QuerySubscribe where++#include <alsa/asoundlib.h>+import Foreign.C.Types (CInt, )+++data Type =+     Read+   | Write+   deriving (Show, Eq, Ord, Enum)++expType :: Type -> CInt+expType t  = case t of+  Read  -> #{const SND_SEQ_QUERY_SUBS_READ}+  Write	-> #{const SND_SEQ_QUERY_SUBS_WRITE}++impType :: CInt -> Type+impType t  = case t of+  #{const SND_SEQ_QUERY_SUBS_READ}  -> Read+  #{const SND_SEQ_QUERY_SUBS_WRITE} -> Write+  _ -> error ("QuerySubscribe.impType: unknown subscription type (" ++ show t ++ ")")

@@ -64,7 +64,7 @@ import qualified Sound.ALSA.Exception as Exc import Sound.ALSA.Sequencer.Area -import Foreign.C.Types (CInt, CUInt, )+import Foreign.C.Types (CInt, ) import Foreign.C.String (CString, withCAString, ) import Foreign.Ptr (Ptr, ) @@ -76,12 +76,12 @@  -- | Create a port - simple version. createSimple :: Seq.T mode -> String -> Port.Cap -> Port.Type -> IO Port.T-createSimple (Seq.Cons h) s (Port.Cap c) (Port.Type t) =+createSimple (Seq.Cons h) s c t =   withCAString s $ \a ->     Port.imp `fmap` (Exc.checkResult "create_simple_port" =<< snd_seq_create_simple_port h a c t) -foreign import ccall "alsa/asoundlib.h snd_seq_create_simple_port"-  snd_seq_create_simple_port :: Ptr Seq.Core -> CString -> CUInt -> CUInt+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_simple_port"+  snd_seq_create_simple_port :: Ptr Seq.Core -> CString -> Port.Cap -> Port.Type                                 -> IO CInt  @@ -90,7 +90,7 @@ deleteSimple (Seq.Cons h) (Port.Cons p) =   Exc.checkResult_ "delete_simple_port" =<< snd_seq_delete_simple_port h (fromIntegral p) -foreign import ccall "alsa/asoundlib.h snd_seq_delete_simple_port"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_delete_simple_port"   snd_seq_delete_simple_port :: Ptr Seq.Core -> CInt -> IO CInt  @@ -110,7 +110,7 @@ create (Seq.Cons h) p =   Exc.checkResult_ "create_port" =<< with_port_info p (snd_seq_create_port h) -foreign import ccall "alsa/asoundlib.h snd_seq_create_port"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_create_port"   snd_seq_create_port :: Ptr Seq.Core -> Ptr PortInfo_ -> IO CInt  -- | Delete the port.@@ -118,5 +118,5 @@ delete (Seq.Cons h) (Port.Cons p) =   Exc.checkResult_ "delete_port" =<< snd_seq_delete_port h (fromIntegral p) -foreign import ccall "alsa/asoundlib.h snd_seq_delete_port"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_delete_port"   snd_seq_delete_port :: Ptr Seq.Core -> CInt -> IO CInt

@@ -79,10 +79,10 @@ get :: Seq.T mode -> Port.T -> IO T get (Seq.Cons h) p =   do info <- Area.port_info_malloc-     Exc.checkResult "get_port_info" =<< Area.with_port_info info (snd_seq_get_port_info h (Port.exp p))+     Exc.checkResult_ "get_port_info" =<< Area.with_port_info info (snd_seq_get_port_info h (Port.exp p))      return info -foreign import ccall "alsa/asoundlib.h snd_seq_get_port_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_port_info"   snd_seq_get_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -91,11 +91,11 @@ getAny :: Seq.T mode -> Client.T -> Port.T -> IO T getAny (Seq.Cons h) c p =   do info <- Area.port_info_malloc-     Exc.checkResult "get_any_port_info" =<< Area.with_port_info info+     Exc.checkResult_ "get_any_port_info" =<< Area.with_port_info info                        (snd_seq_get_any_port_info h (Client.exp c) (Port.exp p))      return info -foreign import ccall "alsa/asoundlib.h snd_seq_get_any_port_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_any_port_info"   snd_seq_get_any_port_info     :: Ptr Seq.Core -> CInt -> CInt -> Ptr T_ -> IO CInt @@ -115,7 +115,7 @@ queryNext (Seq.Cons h) info =    Exc.checkResult_ "query_next_port" =<< Area.with_port_info info (snd_seq_query_next_port h) -foreign import ccall "alsa/asoundlib.h snd_seq_query_next_port"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_next_port"   snd_seq_query_next_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt  -- | Set the information for the sequencer port based on the data@@ -124,7 +124,7 @@ set (Seq.Cons h) p info =   Exc.checkResult_ "set_port_info" =<< Area.with_port_info info (snd_seq_set_port_info h (Port.exp p)) -foreign import ccall "alsa/asoundlib.h snd_seq_set_port_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_port_info"   snd_seq_set_port_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -134,7 +134,7 @@ getAddr i =   peek =<< Area.with_port_info i snd_seq_port_info_get_addr -foreign import ccall "alsa/asoundlib.h snd_seq_port_info_get_addr"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_get_addr"   snd_seq_port_info_get_addr :: Ptr T_ -> IO (Ptr Addr.T)  @@ -143,7 +143,7 @@ setAddr i c =   alloca $ \p -> poke p c >> Area.with_port_info i (`snd_seq_port_info_set_addr` p) -foreign import ccall "alsa/asoundlib.h snd_seq_port_info_set_addr"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_info_set_addr"   snd_seq_port_info_set_addr :: Ptr T_ -> Ptr Addr.T -> IO ()  

@@ -42,7 +42,7 @@ alloc (Seq.Cons h) =   Queue.imp `fmap` (Exc.checkResult "alloc_queue" =<< snd_seq_alloc_queue h) -foreign import ccall "alsa/asoundlib.h snd_seq_alloc_queue"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_queue"   snd_seq_alloc_queue :: Ptr Seq.Core -> IO CInt  with :: Seq.T mode -> (Queue.T -> IO a) -> IO a@@ -53,7 +53,7 @@ allocNamed (Seq.Cons h) x = withCAString x $ \s ->   Queue.imp `fmap` (Exc.checkResult "alloc_named_queue" =<< snd_seq_alloc_named_queue h s) -foreign import ccall "alsa/asoundlib.h snd_seq_alloc_named_queue"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_alloc_named_queue"   snd_seq_alloc_named_queue :: Ptr Seq.Core -> CString -> IO CInt  withNamed :: Seq.T mode -> String -> (Queue.T -> IO a) -> IO a@@ -68,7 +68,7 @@ free (Seq.Cons h) q =   Exc.checkResult_ "free_queue" =<< snd_seq_free_queue h (Queue.exp q) -foreign import ccall "alsa/asoundlib.h snd_seq_free_queue"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_free_queue"   snd_seq_free_queue :: Ptr Seq.Core -> CInt -> IO CInt  @@ -81,7 +81,7 @@   -> Maybe Event.T   -> IO () control (Seq.Cons h) q a b me =-  Event.allocaMaybeEv me $ \p -> Exc.checkResult_ "control_queue" =<< snd_seq_control_queue h (Queue.exp q) (fromIntegral $ Event.expQueueEv a) (fromIntegral b) p+  Event.allocaMaybeEv me $ \p -> Exc.checkResult_ "control_queue" =<< snd_seq_control_queue h (Queue.exp q) (fromIntegral $ Event.expEv a) (fromIntegral b) p -foreign import ccall "alsa/asoundlib.h snd_seq_control_queue"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_control_queue"   snd_seq_control_queue :: Ptr Seq.Core -> CInt -> CInt -> CInt -> Ptr Event.T -> IO CInt

@@ -52,11 +52,11 @@ get :: Seq.T mode -> Queue.T -> IO T get (Seq.Cons h) q =   do info <- Area.queue_info_malloc-     Exc.checkResult "get_queue_info" =<< Area.with_queue_info info+     Exc.checkResult_ "get_queue_info" =<< Area.with_queue_info info                                      (snd_seq_get_queue_info h (Queue.exp q))      return info -foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_info"   snd_seq_get_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -64,7 +64,7 @@ set (Seq.Cons h) p info =   Exc.checkResult_ "set_queue_info" =<< Area.with_queue_info info (snd_seq_set_queue_info h (Queue.exp p)) -foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_info"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_info"   snd_seq_set_queue_info :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  

@@ -44,11 +44,11 @@ get :: Seq.T mode -> Queue.T -> IO T get (Seq.Cons h) q =   do status <- Area.queue_status_malloc-     Exc.checkResult "get_queue_status" =<< Area.with_queue_status status+     Exc.checkResult_ "get_queue_status" =<< Area.with_queue_status status                                      (snd_seq_get_queue_status h (Queue.exp q))      return status -foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_status"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_status"   snd_seq_get_queue_status :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -60,19 +60,19 @@ clone = Area.queue_status_clone  -foreign import ccall "alsa/asoundlib.h"+foreign import ccall unsafe "alsa/asoundlib.h"    snd_seq_queue_status_get_queue       :: Ptr T_ -> IO CInt-foreign import ccall "alsa/asoundlib.h"+foreign import ccall unsafe "alsa/asoundlib.h"    snd_seq_queue_status_get_events       :: Ptr T_ -> IO CInt-foreign import ccall "alsa/asoundlib.h"+foreign import ccall unsafe "alsa/asoundlib.h"    snd_seq_queue_status_get_tick_time       :: Ptr T_ -> IO Word32-foreign import ccall "alsa/asoundlib.h"+foreign import ccall unsafe "alsa/asoundlib.h"    snd_seq_queue_status_get_real_time       :: Ptr T_ -> IO (Ptr RealTime.T)-foreign import ccall "alsa/asoundlib.h"+foreign import ccall unsafe "alsa/asoundlib.h"    snd_seq_queue_status_get_status       :: Ptr T_ -> IO CUInt 

@@ -48,11 +48,11 @@ get :: Seq.T mode -> Queue.T -> IO T get (Seq.Cons h) q =   do tempo <- Area.queue_tempo_malloc-     Exc.checkResult "get_queue_tempo" =<< Area.with_queue_tempo tempo+     Exc.checkResult_ "get_queue_tempo" =<< Area.with_queue_tempo tempo                                      (snd_seq_get_queue_tempo h (Queue.exp q))      return tempo -foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_tempo"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_tempo"   snd_seq_get_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -60,7 +60,7 @@ set (Seq.Cons h) p tempo =   Exc.checkResult_ "set_queue_tempo" =<< Area.with_queue_tempo tempo (snd_seq_set_queue_tempo h (Queue.exp p)) -foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_tempo"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_tempo"   snd_seq_set_queue_tempo :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  

@@ -47,11 +47,11 @@ get :: Seq.T mode -> Queue.T -> IO T get (Seq.Cons h) q =   do timer <- Area.queue_timer_malloc-     Exc.checkResult "get_queue_timer" =<< Area.with_queue_timer timer+     Exc.checkResult_ "get_queue_timer" =<< Area.with_queue_timer timer                                      (snd_seq_get_queue_timer h (Queue.exp q))      return timer -foreign import ccall "alsa/asoundlib.h snd_seq_get_queue_timer"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_queue_timer"   snd_seq_get_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  @@ -59,7 +59,7 @@ set (Seq.Cons h) p timer =   Exc.checkResult_ "set_queue_timer" =<< Area.with_queue_timer timer (snd_seq_set_queue_timer h (Queue.exp p)) -foreign import ccall "alsa/asoundlib.h snd_seq_set_queue_timer"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_queue_timer"   snd_seq_set_queue_timer :: Ptr Seq.Core -> CInt -> Ptr T_ -> IO CInt  

@@ -7,7 +7,6 @@ import qualified Sound.ALSA.Sequencer.Marshal.RealTime as RealTime  import Prelude hiding (fromInteger, toInteger, )-import qualified Prelude as P   nanoPerSecond :: Num a => a

@@ -42,7 +42,7 @@   do Exc.checkResult_ "open" =<< snd_seq_open p s (Seq.expOpenMode om) (Seq.expBlockMode bm)      fmap Seq.Cons $ peek p -foreign import ccall "alsa/asoundlib.h snd_seq_open"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_open"   snd_seq_open :: Ptr (Ptr Seq.Core) -> CString -> CInt -> CInt -> IO CInt  withOpenMode :: (mode -> IO (Seq.T mode)) -> IO (Seq.T mode)@@ -60,7 +60,7 @@   -> IO () close (Seq.Cons h) = Exc.checkResult_ "close" =<< snd_seq_close h -foreign import ccall "alsa/asoundlib.h snd_seq_close"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_close"   snd_seq_close :: Ptr Seq.Core -> IO CInt  @@ -87,7 +87,7 @@   -> IO String  -- ^ ALSA identifier for the handel getName (Seq.Cons h) = peekCString =<< snd_seq_name h -foreign import ccall "alsa/asoundlib.h snd_seq_name"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_name"   snd_seq_name :: Ptr Seq.Core -> IO CString  @@ -103,7 +103,7 @@   -> IO () setBlocking (Seq.Cons h) m = Exc.checkResult_ "set_blocking" =<< snd_seq_nonblock h(Seq.expBlockMode m) -foreign import ccall "alsa/asoundlib.h snd_seq_nonblock"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_nonblock"   snd_seq_nonblock :: Ptr Seq.Core -> CInt -> IO CInt  @@ -118,7 +118,7 @@ getOutputBufferSize (Seq.Cons h) =   fromIntegral `fmap` snd_seq_get_output_buffer_size h -foreign import ccall "alsa/asoundlib.h snd_seq_get_output_buffer_size"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_output_buffer_size"   snd_seq_get_output_buffer_size :: Ptr Seq.Core -> IO CSize  @@ -132,7 +132,7 @@ setOutputBufferSize (Seq.Cons h) x =   Exc.checkResult_ "set_output_buffer_size" =<< snd_seq_set_output_buffer_size h (fromIntegral x) -foreign import ccall "alsa/asoundlib.h snd_seq_set_output_buffer_size"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_output_buffer_size"   snd_seq_set_output_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt  @@ -144,7 +144,7 @@ getInputBufferSize (Seq.Cons h) =   fromIntegral `fmap` snd_seq_get_input_buffer_size h -foreign import ccall "alsa/asoundlib.h snd_seq_get_input_buffer_size"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_get_input_buffer_size"    snd_seq_get_input_buffer_size :: Ptr Seq.Core -> IO CSize  @@ -158,7 +158,7 @@ setInputBufferSize (Seq.Cons h) x =   Exc.checkResult_ "set_input_buffer_size" =<< snd_seq_set_input_buffer_size h (fromIntegral x) -foreign import ccall "alsa/asoundlib.h snd_seq_set_input_buffer_size"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_input_buffer_size"   snd_seq_set_input_buffer_size :: Ptr Seq.Core -> CSize -> IO CInt  @@ -174,7 +174,7 @@ setPoolOutput (Seq.Cons h) x =   Exc.checkResult_ "set_pool_output" =<< snd_seq_set_client_pool_output h (fromIntegral x) -foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_output"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output"   snd_seq_set_client_pool_output :: Ptr Seq.Core -> CSize -> IO CInt  @@ -188,7 +188,7 @@ setPoolOutputRoom (Seq.Cons h) x =   Exc.checkResult_ "set_pool_output_room" =<< snd_seq_set_client_pool_output_room h (fromIntegral x) -foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_output_room"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_output_room"   snd_seq_set_client_pool_output_room :: Ptr Seq.Core -> CSize -> IO CInt  @@ -200,7 +200,7 @@ resetPoolOutput (Seq.Cons h) =   Exc.checkResult_ "reset_pool_output" =<< snd_seq_reset_pool_output h -foreign import ccall "alsa/asoundlib.h snd_seq_reset_pool_output"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_output"   snd_seq_reset_pool_output :: Ptr Seq.Core -> IO CInt  @@ -214,7 +214,7 @@ setPoolInput (Seq.Cons h) x =   Exc.checkResult_ "set_pool_input" =<< snd_seq_set_client_pool_input h (fromIntegral x) -foreign import ccall "alsa/asoundlib.h snd_seq_set_client_pool_input"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_set_client_pool_input"   snd_seq_set_client_pool_input :: Ptr Seq.Core -> CSize -> IO CInt  @@ -226,7 +226,7 @@ resetPoolInput (Seq.Cons h) =   Exc.checkResult_ "reset_pool_input" =<< snd_seq_reset_pool_input h -foreign import ccall "alsa/asoundlib.h snd_seq_reset_pool_input"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_reset_pool_input"   snd_seq_reset_pool_input :: Ptr Seq.Core -> IO CInt  @@ -246,7 +246,7 @@   Exc.checkResult_ "connect_from" =<< snd_seq_connect_from h (Port.exp me) c p   where (c,p) = Addr.exp a -foreign import ccall "alsa/asoundlib.h snd_seq_connect_from"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_from"   snd_seq_connect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt  @@ -256,7 +256,7 @@   Exc.checkResult_ "connect_to" =<< snd_seq_connect_to h (Port.exp me) c p   where (c,p) = Addr.exp a -foreign import ccall "alsa/asoundlib.h snd_seq_connect_to"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_connect_to"   snd_seq_connect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt  @@ -266,7 +266,7 @@   Exc.checkResult_ "disconnect_from" =<< snd_seq_disconnect_from h (Port.exp me) c p   where (c,p) = Addr.exp a -foreign import ccall "alsa/asoundlib.h snd_seq_disconnect_from"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_from"   snd_seq_disconnect_from :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt  -- | Simple disconnection.@@ -275,7 +275,7 @@   Exc.checkResult_ "disconnect_to" =<< snd_seq_disconnect_to h (Port.exp me) c p   where (c,p) = Addr.exp a -foreign import ccall "alsa/asoundlib.h snd_seq_disconnect_to"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_disconnect_to"   snd_seq_disconnect_to :: Ptr Seq.Core -> CInt -> CInt -> CInt -> IO CInt  @@ -290,8 +290,8 @@ parseAddress (Seq.Cons h) s =   alloca $ \pa ->   withCAString s $ \ps ->-    do Exc.checkResult "parse_address" =<< snd_seq_parse_address h pa ps+    do Exc.checkResult_ "parse_address" =<< snd_seq_parse_address h pa ps        peek pa -foreign import ccall "alsa/asoundlib.h snd_seq_parse_address"+foreign import ccall unsafe "alsa/asoundlib.h snd_seq_parse_address"   snd_seq_parse_address :: Ptr Seq.Core -> Ptr Addr.T -> CString -> IO CInt

@@ -0,0 +1,147 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Subscribe+-- Copyright : (c) Dylan Simon, 2011+-- License   : BSD3+--+-- Stability : provisional+--+-- This module contains functions for working with subscriptions.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Subscribe+  ( {- T++  , alloc+  , copy+  , clone++  , getSender+  , getDest+  , getQueue+  , getExclusive+  , getTimeUpdate+  , getTimeReal+  +  , setSender+  , setDest+  , setQueue+  , setExclusive+  , setTimeUpdate+  , setTimeReal++  , subscribePort+  , unsubscribePort++  , create+  , -} subscribe+  , unsubscribe+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Exception as Exc++import Foreign.C.Types (CInt, )+import Foreign.Ptr (Ptr, )+import Foreign.Marshal.Alloc (alloca, )+import Foreign.Storable (peek, poke, )++type T = Area.PortSubscribe+type T_ = Area.PortSubscribe_++alloc	      :: IO T+_copy	      :: T -> T -> IO ()+_clone	      :: T -> IO T+_getQueue     :: T -> IO Queue.T+_getExclusive :: T -> IO Bool+_getTimeUpdate:: T -> IO Bool+_getTimeReal  :: T -> IO Bool+setQueue     :: T -> Queue.T -> IO ()+setExclusive  :: T -> Bool -> IO ()+setTimeUpdate :: T -> Bool -> IO ()+setTimeReal   :: T -> Bool -> IO ()++alloc	      = Area.port_subscribe_malloc+_copy	      = Area.port_subscribe_copy+_clone	      = Area.port_subscribe_clone+_getQueue     = Area.port_subscribe_get_queue+_getExclusive = Area.port_subscribe_get_exclusive+_getTimeUpdate= Area.port_subscribe_get_time_update+_getTimeReal  = Area.port_subscribe_get_time_real+setQueue      = Area.port_subscribe_set_queue+setExclusive  = Area.port_subscribe_set_exclusive+setTimeUpdate = Area.port_subscribe_set_time_update+setTimeReal   = Area.port_subscribe_set_time_real++-- | Get sender address of a port subscription+_getSender :: T -> IO Addr.T+_getSender s = +  peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_sender++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_sender"+  snd_seq_port_subscribe_get_sender :: Ptr T_ -> IO (Ptr Addr.T)++-- | Get destination address of a port subscription+_getDest :: T -> IO Addr.T+_getDest s = +  peek =<< Area.with_port_subscribe s snd_seq_port_subscribe_get_dest++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_get_dest"+  snd_seq_port_subscribe_get_dest :: Ptr T_ -> IO (Ptr Addr.T)++-- | Set sender address of a port subscription+setSender :: T -> Addr.T -> IO ()+setSender s c =+  alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_sender` p)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_sender"+  snd_seq_port_subscribe_set_sender :: Ptr T_ -> Ptr Addr.T -> IO ()++-- | Set destination address of a port subscription+setDest :: T -> Addr.T -> IO ()+setDest s c =+  alloca $ \p -> poke p c >> Area.with_port_subscribe s (`snd_seq_port_subscribe_set_dest` p)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_port_subscribe_set_dest"+  snd_seq_port_subscribe_set_dest :: Ptr T_ -> Ptr Addr.T -> IO ()++-- | Subscribe a port connection+subscribePort :: Seq.T mode -> T -> IO ()+subscribePort (Seq.Cons h) s =+  Exc.checkResult_ "subscribe_port" =<< Area.with_port_subscribe s (snd_seq_subscribe_port h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_subscribe_port"+  snd_seq_subscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt++-- | Unsubscribe a connection between ports+unsubscribePort :: Seq.T mode -> T -> IO ()+unsubscribePort (Seq.Cons h) s =+  Exc.checkResult_ "unsubscribe_port" =<< Area.with_port_subscribe s (snd_seq_unsubscribe_port h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_unsubscribe_port"+  snd_seq_unsubscribe_port :: Ptr Seq.Core -> Ptr T_ -> IO CInt++create :: Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO T+create sender dest excl time = do+  s <- alloc+  setSender s sender+  setDest s dest+  setExclusive s excl+  maybe (return ()) (\(queue, realtime) -> do+    setTimeUpdate s True+    setQueue s queue+    setTimeReal s realtime) time+  return s++-- | Subscribe a port connection: @'subscribeSimple' sender dest exclusive (Just (updatequeue, realtime))@+subscribe :: Seq.T mode -> Addr.T -> Addr.T -> Bool -> Maybe (Queue.T, Bool) -> IO ()+subscribe ss sender dest excl time = subscribePort ss =<< create sender dest excl time++-- | Unsubscribe a port connection: @'unsubscribeSimple' sender dest@+unsubscribe :: Seq.T mode -> Addr.T -> Addr.T -> IO ()+unsubscribe ss sender dest = unsubscribePort ss =<< create sender dest False Nothing

@@ -0,0 +1,150 @@+--------------------------------------------------------------------------------+-- |+-- Module    : Sound.ALSA.Sequencer.Subscribe.Query+-- Copyright : (c) Dylan Simon, 2011+-- License   : BSD3+--+-- Stability : provisional+--+-- This module contains functions for working with subscriptions.+-- Reference:+-- <http://www.alsa-project.org/alsa-doc/alsa-lib/group___seq_subscribe.html>+--------------------------------------------------------------------------------++module Sound.ALSA.Sequencer.Subscribe.Query+  ( T+  , Query.Type(..)++  {-+  , alloc+  , copy+  , clone+  -}++  , getClient+  , getPort+  , getRoot+  , getType+  , getIndex+  , getNumSubs+  , getAddr+  , getQueue+  , getExclusive+  , getTimeUpdate+  , getTimeReal++  {-+  , setClient+  , setPort+  , setType+  , setIndex+  -}++  , query+  , queryAll+  ) where++import qualified Sound.ALSA.Sequencer.Marshal.QuerySubscribe as Query+import qualified Sound.ALSA.Sequencer.Marshal.Sequencer as Seq+import qualified Sound.ALSA.Sequencer.Area as Area+import qualified Sound.ALSA.Sequencer.Marshal.Address as Addr+import qualified Sound.ALSA.Sequencer.Marshal.Client as Client+import qualified Sound.ALSA.Sequencer.Marshal.Port as Port+import qualified Sound.ALSA.Sequencer.Marshal.Queue as Queue+import qualified Sound.ALSA.Exception as Exc++import Foreign.C.Error (Errno(Errno), eNOENT, )+import Foreign.C.Types (CInt, )+import Foreign.Ptr (Ptr, )+import Foreign.Marshal.Alloc (alloca, )+import Foreign.Storable (peek, poke, )+import Data.Word (Word, )++type T = Area.QuerySubscribe+type T_ = Area.QuerySubscribe_++alloc	      :: IO T+_copy	      :: T -> T -> IO ()+_clone	      :: T -> IO T+getClient     :: T -> IO Client.T+getPort	      :: T -> IO Port.T+getType	      :: T -> IO Query.Type+getIndex      :: T -> IO Word+getNumSubs    :: T -> IO Word+getQueue      :: T -> IO Queue.T+getExclusive  :: T -> IO Bool+getTimeUpdate :: T -> IO Bool+getTimeReal   :: T -> IO Bool+_setClient    :: T -> Client.T -> IO ()+_setPort      :: T -> Port.T -> IO ()+setType	      :: T -> Query.Type -> IO ()+setIndex      :: T -> Word -> IO ()++alloc	      = Area.query_subscribe_malloc+_copy	      = Area.query_subscribe_copy+_clone	      = Area.query_subscribe_clone+getClient     = Area.query_subscribe_get_client+getPort	      = Area.query_subscribe_get_port+getType	      = Area.query_subscribe_get_type+getIndex      = Area.query_subscribe_get_index+getNumSubs    = Area.query_subscribe_get_num_subs+getQueue      = Area.query_subscribe_get_queue+getExclusive  = Area.query_subscribe_get_exclusive+getTimeUpdate = Area.query_subscribe_get_time_update+getTimeReal   = Area.query_subscribe_get_time_real+_setClient    = Area.query_subscribe_set_client+_setPort      = Area.query_subscribe_set_port+setType       = Area.query_subscribe_set_type+setIndex      = Area.query_subscribe_set_index++-- | Get the client/port address of a query+getRoot :: T -> IO Addr.T+getRoot q = +  peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_root++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_root"+  snd_seq_query_subscribe_get_root :: Ptr T_ -> IO (Ptr Addr.T)++-- | Get the address of subscriber of query+getAddr :: T -> IO Addr.T+getAddr q = +  peek =<< Area.with_query_subscribe q snd_seq_query_subscribe_get_addr++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_get_addr"+  snd_seq_query_subscribe_get_addr :: Ptr T_ -> IO (Ptr Addr.T)+++-- | Set the client/port address of a query+setRoot :: T -> Addr.T -> IO ()+setRoot q c = +  alloca $ \p -> poke p c >> Area.with_query_subscribe q (`snd_seq_query_subscribe_set_root` p)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_subscribe_set_root"+  snd_seq_query_subscribe_set_root :: Ptr T_ -> Ptr Addr.T -> IO ()+++-- | Query port subscriber list+queryPort :: Seq.T mode -> T -> IO Bool+queryPort (Seq.Cons h) q =+  Exc.checkResultMaybe "query_port_subscribers" (const True) (\e -> if Errno (negate e) == eNOENT then Just False else Nothing) =<<+    Area.with_query_subscribe q (snd_seq_query_port_subscribers h)++foreign import ccall unsafe "alsa/asoundlib.h snd_seq_query_port_subscribers"+  snd_seq_query_port_subscribers :: Ptr Seq.Core -> Ptr T_ -> IO CInt++-- | Queries a subscriber connected to (Write) or from (Read) a given address: @'query' seq addr typ index@+query :: Seq.T mode -> Addr.T -> Query.Type -> Word -> IO (Maybe T)+query ss root t i = do+  q <- alloc+  setRoot q root+  setType q t+  setIndex q i+  r <- queryPort ss q+  return $ if r then Just q else Nothing++-- | Queries the list of subscribers accessing a port+queryAll :: Seq.T mode -> Addr.T -> Query.Type -> IO [T]+queryAll ss root t = queryRest 0 where+  queryRest i = query ss root t i >>=+    maybe (return []) (\q -> (q:) `fmap` queryRest (succ i))+