summaryrefslogtreecommitdiff
path: root/midi-dump.hs
blob: 4d1946cb7cd895e093b73cff04d157dcc267fdd8 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
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
import qualified Sound.ALSA.Sequencer.Address as Addr


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 $ show 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."

  clientID <- Client.getId h

  findPort "AXIS-49 2A" (connectAxis h clientID _p1)

  forever $ do
     putStrLn "waiting for an event:"
     print =<< Event.input h)
  `AlsaExc.catch` \e ->
     putStrLn $ "alsa_exception: " ++ AlsaExc.show e

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 ()