add midi-dump experimental code

1 files changed, 80 insertions, 0 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
new file mode 100644
index 0000000..3652162
--- /dev/null
+++ b/midi-dump.hs
@@ -0,0 +1,80 @@
+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, )
+
+
+import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo
+import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo
+import qualified Sound.ALSA.Sequencer.Port as Port
+import qualified Data.EnumSet as EnumSet
+import Text.Printf (printf, )
+import Control.Monad (liftM5, liftM2, join, when, filterM, forM_)
+
+import Sound.ALSA.Sequencer.Connect as AlsaConn
+
+
+listPorts :: IO ()
+listPorts = do
+  putStrLn " Port    Client name                      Port name                Caps"
+  SndSeq.withDefault SndSeq.Block $ \h ->
+    ClientInfo.queryLoop_ (h :: SndSeq.T SndSeq.OutputMode) $ \cinfo -> do
+      client <- ClientInfo.getClient cinfo
+      PortInfo.queryLoop_ h client $ \pinfo -> do
+        join $ liftM5 (\a b c d e -> when (c == "AXIS-49 2A") $ printf "%3d:%-3d  %-32.32s %-24.24s %s\n" a b c d e)
+          (fmap (\(Client.Cons p) -> p) $ PortInfo.getClient pinfo)
+          (fmap (\(Port.Cons p) -> p) $ PortInfo.getPort pinfo)
+          (ClientInfo.getName cinfo)
+          (PortInfo.getName pinfo)
+          (do
+             caps <- PortInfo.getCapability pinfo
+             let disp (cap, char) =
+                    if EnumSet.disjoint caps cap then ' ' else char
+             return $ map disp $
+               (Port.capRead, 'r') :
+               (Port.capSubsRead, 'R') :
+               (Port.capWrite, 'w') :
+               (Port.capSubsWrite, 'W') :
+               [])
+
+findPort wantName f = do
+  SndSeq.withDefault SndSeq.Block $ \h ->
+    ClientInfo.queryLoop_ (h :: SndSeq.T SndSeq.OutputMode) $ \cinfo -> do
+      name <- (ClientInfo.getName cinfo)
+      when (name == wantName) $ do
+        client <- ClientInfo.getClient cinfo
+        PortInfo.queryLoop_ h client $ \pinfo -> do
+          port <- (fmap (\(Client.Cons p) -> p) $ PortInfo.getClient pinfo)
+          f port
+
+main :: IO ()
+main = (do
+--outport <- findPort "AXIS-49 2A" return           -- nope
+--outport <- findPort "AXIS-49 2A" (\p -> return p) -- nope
+  putStrLn "Starting."
+  SndSeq.withDefault SndSeq.Nonblock $ \h -> do
+  Client.setName (h :: SndSeq.T SndSeq.InputMode) "Axis-of-Eval"
+  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."
+
+  clientPointer <- ClientInfo.get h
+  clientID_Cons <- ClientInfo.getClient clientPointer
+  clientID <- (\(Client.Cons p) -> return p) clientID_Cons
+
+  findPort "AXIS-49 2A" (connectAxis clientID)
+
+  when False $ do
+  forever $ do
+     putStrLn "waiting for an event:"
+     print =<< Event.input h)
+  `AlsaExc.catch` \e ->
+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e
+
+connectAxis myID axisID = do
+  printf "Found my ID: %d.\nFound Axis ID: %d.\n" myID axisID