diff options
author | Andrew Cady <d@jerkface.net> | 2014-01-15 07:32:00 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2014-01-15 08:46:52 -0500 |
commit | e19c35c8a7125b53688d056bfd5cf8a276590228 (patch) | |
tree | fb6d01d7575e13ad432988483924899f78fa6c96 /midi-dump.hs | |
parent | 0df77d0edfd649902f69636e2851215795a29839 (diff) |
add list of alsa clients to usage error
TODO: make it default to AXiS -> FluidSynth, if available.
Diffstat (limited to 'midi-dump.hs')
-rw-r--r-- | midi-dump.hs | 55 |
1 files changed, 45 insertions, 10 deletions
diff --git a/midi-dump.hs b/midi-dump.hs index 436644c..2c8d430 100644 --- a/midi-dump.hs +++ b/midi-dump.hs | |||
@@ -2,11 +2,13 @@ import qualified Sound.ALSA.Exception as AlsaExc | |||
2 | import qualified Sound.ALSA.Sequencer.Address as Addr | 2 | import qualified Sound.ALSA.Sequencer.Address as Addr |
3 | import qualified Sound.ALSA.Sequencer as SndSeq | 3 | import qualified Sound.ALSA.Sequencer as SndSeq |
4 | import qualified Sound.ALSA.Sequencer.Client as Client | 4 | import qualified Sound.ALSA.Sequencer.Client as Client |
5 | import qualified Sound.ALSA.Sequencer.Client.Info as ClientInfo | ||
6 | import qualified Sound.ALSA.Sequencer.Port.Info as PortInfo | ||
5 | import qualified Sound.ALSA.Sequencer.Connect as Connect | 7 | import qualified Sound.ALSA.Sequencer.Connect as Connect |
6 | import qualified Sound.ALSA.Sequencer.Event as Event | 8 | import qualified Sound.ALSA.Sequencer.Event as Event |
7 | import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove | 9 | import qualified Sound.ALSA.Sequencer.Event.RemoveMonad as Remove |
8 | import qualified Sound.ALSA.Sequencer.Port as Port | 10 | import qualified Sound.ALSA.Sequencer.Port as Port |
9 | import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfo | 11 | import qualified Sound.ALSA.Sequencer.Port.InfoMonad as PortInfoM |
10 | import qualified Sound.ALSA.Sequencer.Queue as Queue | 12 | import qualified Sound.ALSA.Sequencer.Queue as Queue |
11 | import qualified Sound.ALSA.Sequencer.RealTime as RealTime | 13 | import qualified Sound.ALSA.Sequencer.RealTime as RealTime |
12 | import qualified Sound.ALSA.Sequencer.Time as Time | 14 | import qualified Sound.ALSA.Sequencer.Time as Time |
@@ -14,11 +16,16 @@ import qualified System.Exit as Exit | |||
14 | import qualified System.IO as IO | 16 | import qualified System.IO as IO |
15 | import System.Environment (getArgs, ) | 17 | import System.Environment (getArgs, ) |
16 | import Text.Printf | 18 | import Text.Printf |
19 | import Control.Monad (when, forM_, forM) | ||
17 | 20 | ||
18 | import qualified Data.Set as Set | 21 | import qualified Data.Set as Set |
22 | import Data.List (group, sort) | ||
19 | 23 | ||
20 | printWords [] = return () | 24 | joinWords [] = "" |
21 | printWords ls = putStrLn $ foldr1 (\a b -> a ++ " " ++ b) ls | 25 | joinWords ls = foldr1 (\a b -> a ++ " " ++ b) ls |
26 | |||
27 | printWords [] = return () -- print nothing if no words (not an empty line) | ||
28 | printWords ls = putStrLn $ joinWords ls | ||
22 | 29 | ||
23 | pitchWords set = map (show . Event.unPitch) $ Set.toList set | 30 | pitchWords set = map (show . Event.unPitch) $ Set.toList set |
24 | 31 | ||
@@ -29,9 +36,36 @@ prettyNote (Event.Note noteChannel noteNote noteVelocity noteOffVelocity noteDur | |||
29 | in | 36 | in |
30 | printf "%d(%d)" pitch vlcty | 37 | printf "%d(%d)" pitch vlcty |
31 | 38 | ||
39 | showPorts ls = joinWords $ map (show . head) $ group $ sort ls | ||
40 | |||
41 | showAlsaPorts h = do | ||
42 | c <- alsaClients h | ||
43 | putStrLn "" | ||
44 | printf "%15s %s\n" "Ports" "Names" | ||
45 | printf "%15s %s\n" "=====" "=====" | ||
46 | forM c (\(name, ports) -> printf "%15s %s\n" (showPorts ports) name) | ||
47 | putStrLn "" | ||
48 | |||
49 | alsaClients h = do | ||
50 | portsNames <- ClientInfo.queryLoop h $ \cinfo -> do | ||
51 | ports <- alsaClientPorts h cinfo | ||
52 | name <- ClientInfo.getName cinfo | ||
53 | return (name, ports) | ||
54 | return portsNames | ||
55 | |||
56 | alsaClientPorts h cinfo = do | ||
57 | client <- ClientInfo.getClient cinfo | ||
58 | ports <- PortInfo.queryLoop h client $ \pinfo -> do | ||
59 | c <- PortInfo.getClient pinfo | ||
60 | let (Client.Cons p) = c in | ||
61 | return p | ||
62 | return ports | ||
63 | |||
32 | alsaInit k = do | 64 | alsaInit k = do |
33 | SndSeq.withDefault SndSeq.Nonblock $ \h -> do | 65 | SndSeq.withDefault SndSeq.Nonblock $ \h -> do |
34 | Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell-Beat" | 66 | |
67 | Client.setName (h :: SndSeq.T SndSeq.DuplexMode) "Haskell Beats" -- In imperative language MIDI sequencer, you rock beat. In Haskell language MIDI sequencer, rock beat you! | ||
68 | |||
35 | Port.withSimple h "inout" | 69 | Port.withSimple h "inout" |
36 | (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite, Port.capSubsWrite]) | 70 | (Port.caps [Port.capRead, Port.capSubsRead, Port.capWrite, Port.capSubsWrite]) |
37 | (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \public -> do | 71 | (Port.types [Port.typeMidiGeneric, Port.typeApplication]) $ \public -> do |
@@ -40,10 +74,10 @@ alsaInit k = do | |||
40 | (Port.types [Port.typeMidiGeneric]) $ \private -> do | 74 | (Port.types [Port.typeMidiGeneric]) $ \private -> do |
41 | Queue.with h $ \q -> do | 75 | Queue.with h $ \q -> do |
42 | 76 | ||
43 | PortInfo.modify h public $ do | 77 | PortInfoM.modify h public $ do |
44 | PortInfo.setTimestamping True | 78 | PortInfoM.setTimestamping True |
45 | PortInfo.setTimestampReal True | 79 | PortInfoM.setTimestampReal True |
46 | PortInfo.setTimestampQueue q | 80 | PortInfoM.setTimestampQueue q |
47 | 81 | ||
48 | c <- Client.getId h | 82 | c <- Client.getId h |
49 | let publicAddr = Addr.Cons c public | 83 | let publicAddr = Addr.Cons c public |
@@ -67,8 +101,9 @@ main = (do | |||
67 | return () | 101 | return () |
68 | 102 | ||
69 | _ -> do | 103 | _ -> do |
70 | IO.hPutStrLn IO.stderr "need arguments: input-client output-client" | 104 | showAlsaPorts h |
71 | Exit.exitFailure | 105 | IO.hPutStrLn IO.stderr "need arguments: input-port output-port" |
106 | Exit.exitFailure | ||
72 | 107 | ||
73 | let wait keysDown = do | 108 | let wait keysDown = do |
74 | pending <- Event.inputPending h True | 109 | pending <- Event.inputPending h True |