axis --> fluidsynth alsa proxy works!

1 files changed, 68 insertions, 68 deletions

diff --git a/midi-dump.hs b/midi-dump.hs
index 4d1946c..74b9596 100644
--- a/midi-dump.hs
+++ b/midi-dump.hs
@@ -1,82 +1,82 @@
+import Control.Monad (forever, )
+import Control.Monad (mplus, )
+import Data.Maybe.HT (toMaybe, )
+import qualified Sound.ALSA.Exception as AlsaExc
+import qualified Sound.ALSA.Sequencer.Address as Addr
+import qualified Sound.ALSA.Sequencer as SndSeq
 import qualified Sound.ALSA.Sequencer.Client as Client
-import qualified Sound.ALSA.Sequencer.Port as Port
+import qualified Sound.ALSA.Sequencer.Connect as Connect
 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.Event.RemoveMonad as Remove
 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 qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfo
+import qualified Sound.ALSA.Sequencer.Queue as Queue
+import qualified Sound.ALSA.Sequencer.RealTime as RealTime
+import qualified Sound.ALSA.Sequencer.Time as Time
+import qualified System.Exit as Exit
+import qualified System.IO as IO
+import System.Environment (getArgs, )
 
-import Sound.ALSA.Sequencer.Connect as AlsaConn
-import qualified Sound.ALSA.Sequencer.Address as Addr
+main :: IO ()
+main = (do
+  SndSeq.withDefault SndSeq.Block $ \h -> do
+  Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Beat"
+  Port.withSimple h "inout"
+     (Port.caps [Port.capRead, Port.capSubsRead,
+                 Port.capWrite, Port.capSubsWrite])
+     (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \public -> do
+  Port.withSimple h "private"
+     (Port.caps [Port.capRead, Port.capWrite])
+     (Port.types [Port.typeMidiGeneric]) $ \private -> do
+  Queue.with h $ \q -> do
 
+  PortInfo.modify h public $ do
+     PortInfo.setTimestamping True
+     PortInfo.setTimestampReal True
+     PortInfo.setTimestampQueue q
 
-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') :
-               [])
+  c <- Client.getId h
+  let publicAddr  = Addr.Cons c public
+      privateAddr = Addr.Cons c private
 
-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 $ show port
+--args <- getArgs
+  let args = ["20", "128"]
+  case args of
+     [input, output] ->
+        (Connect.createFrom h public =<< Addr.parse h input)
+        >>
+        (Connect.createTo   h public =<< Addr.parse h output)
+        >>
+        return ()
+     _ ->
+       IO.hPutStrLn IO.stderr "need arguments: input-client output-client"
+       >>
+       Exit.exitFailure
 
-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."
 
-  clientID <- Client.getId h
+  let wait = do
+      ev <- Event.input h
+      case Event.body ev of
+         Event.NoteEv Event.NoteOn n  -> return (Event.NoteOn, n)
+         Event.NoteEv Event.NoteOff n -> return (Event.NoteOff, n)
+         _ -> wait
 
-  findPort "AXIS-49 2A" (connectAxis h clientID _p1)
+  Queue.control h q Event.QueueStart Nothing
 
-  forever $ do
-     putStrLn "waiting for an event:"
-     print =<< Event.input h)
-  `AlsaExc.catch` \e ->
-     putStrLn $ "alsa_exception: " ++ AlsaExc.show e
+  let mkEv e =
+         (Event.simple publicAddr e) {
+             Event.queue = q,
+             Event.time = Time.consAbs $ Time.Real $ RealTime.fromDouble 0
+         }
 
-connectAxis h myID myPort axisID = do
-  myID_int <- (\(Client.Cons p) -> return p) myID
-  printf "Found my ID: %d.\nFound Axis ID: %s.\n" myID_int axisID
-  AlsaConn.createFrom h myPort =<< Addr.parse h (axisID ++ ":0")
-  return ()
+  let go = do
+      (onoff, note) <- wait
+      print note
+      Event.output h $ mkEv $ Event.NoteEv onoff note
+      _ <- Event.drainOutput h
+      go
 
+  go)
+   `AlsaExc.catch` \e ->
+     putStrLn $ "alsa_exception: " ++ AlsaExc.show e