From d95475d8c16d1baf066492e36ed6ebe8866bba31 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 14 Jan 2014 04:43:07 -0500
Subject: add midi-dump experimental code

---
 midi-dump.hs | 80 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 80 insertions(+)
 create mode 100644 midi-dump.hs

(limited to 'midi-dump.hs')

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
-- 
cgit v1.2.3