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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
|
(ns midi
(:require [missionary.core :as m])
(:import [javax.sound.midi MidiSystem Receiver ShortMessage MidiDevice$Info MidiDevice Transmitter MidiMessage]
[uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider]))
(defn get-all-midi-device-info []
(CoreMidiDeviceProvider/getMidiDeviceInfo))
(defn select-devices
"Given device info list `devices`, return seq where device name is `device-name`.
If tx? is true, returned devices will have unlimited transmitters.
If rx? is true, returned devices will have unlimited receivers."
[devices device-name tx? rx?]
(->> devices
(filter (fn [^MidiDevice$Info di]
(let [d (MidiSystem/getMidiDevice di)]
(and
(= device-name (.getName di))
(or (not tx?) (= -1 (.getMaxTransmitters d)))
(or (not rx?) (= -1 (.getMaxReceivers d)))))))
(map #(MidiSystem/getMidiDevice %))))
(defn with-device
"Open `device` and then run task returned by invoking `tfn` with `device` as its sole argument."
[^MidiDevice device tfn]
(m/sp
(try
(m/? (m/via m/blk (.open device)))
(println "Device opened")
(m/? (tfn device))
(catch Exception e (println "E" e) (throw e))
(finally
(m/? (m/via m/blk (.close device)))
(println "Device closed")))))
(defn with-tx
"Feed a transmitter device (e.g. a MIDI keyboard) into a consumer `t`.
`t` is a function taking a flow of MIDI ShortMessages as its sole argument
and returning a task completing with consumption of that flow.
When invoked, `with-tx` will open the transmitter.
Upon cancellation or flow termination, the transmitter will be closed.
Returns a task."
[^MidiDevice device t]
(m/sp
(let [^Transmitter transmitter (m/? (m/via m/blk (.getTransmitter device)))
_ (println "tx mounted")
rv (m/rdv)
receiver
(reify Receiver
(send [_this midi-message _timestamp]
(println "Sending message")
(m/? (rv midi-message))
(println "Message sent"))
(close [_this]))]
(println "RX object defined" receiver)
(try
(println "Setting receiver...")
(m/? (m/via m/blk (.setReceiver transmitter receiver)))
(println "Receiver set")
(m/?
(t (m/ap
(loop []
(m/amb (let [v (m/? rv)]
(println "tx received value" v)
v)
(recur))))))
(finally
(println "Closing tx")
(m/? (m/via m/blk (.close transmitter)))
(println "Tx closed"))))))
(def UNSCHEDULED-EVENT -1)
(defn with-rx
"Feed a flow of midi messages into a receiver device (e.g. a synthesizer).
`f` is a flow of midi ShortMessages.
When invoked, `with-rx` will open the receiver.
Upon cancellation or flow termination, the receiver will be closed.
Returns a task.
"
[^MidiDevice device f]
(m/sp
;; TODO Try finally
;; TODO blocking APIs everywhere
;; TODO mailbox -> rdv
(let [^Receiver receiver (m/? (m/via m/blk (.getReceiver device)))]
(println "receiver mounted")
(try
(m/?
(m/reduce {} nil
(m/ap
(let [v (m/?< f)]
(println "rx received value" v)
(.send receiver v UNSCHEDULED-EVENT)))))
(finally
(println "Closing rx")
(m/? (m/via m/blk (.close receiver)))
(println "rx closed"))))))
(defn echo [tx-device rx-device]
(m/sp
(let [rv (m/rdv)]
(m/?
(m/join vector
(with-device tx-device
(fn [d]
(println "Have tx device")
(with-tx d
(fn [f]
(m/sp
(println "Have transmitter")
(m/?
(m/reduce prn nil
(m/ap
(let [^ShortMessage v (m/?< f)
_ (println v)
new-msg (ShortMessage. ShortMessage/NOTE_ON 9 (.getData1 v) (.getData2 v))]
(println "Echo received value from flow:" v)
(println "Echo sending v to rdv.")
(m/?
(rv new-msg))
(println "Value sent."))))))))))
(with-device rx-device
(fn [d]
(println "Have rx device")
(with-rx d
(m/ap
(loop []
(println "Echo rx awaiting value...")
(m/amb
(let [v (m/? rv)]
(println "Echo received value:" v)
v)
;; I think that what is happening here is a deadlock on either give or take of the rdv
(recur))))))))))))
(def run
(m/sp
(let [tx
(first
(select-devices (get-all-midi-device-info)
"CoreMIDI4J - IAC Bus" true false))
rx
(first
(select-devices (get-all-midi-device-info)
"CoreMIDI4J - IAC Bus" false true))]
(def t tx)
(def r rx)
(m/? (echo tx rx)))))
(def close (run prn prn))
(close)
#_(defn >midi-messages->ch-stream
[>midi-messages]
(m/signal
(m/ap
(let [device (new-device)]
(m/amb= device
(do
(let [v (m/?< >midi-messages)]
(cond (instance? ShortMessage v)
(let [channel (.getChannel ^ShortMessage v)
command (.getCommand ^ShortMessage v)
data-1 (.getData1 ^ShortMessage v)]
(cond (= command ShortMessage/NOTE_ON)
(swap! (first (get device channel)) conj data-1)
(= command ShortMessage/NOTE_OFF)
(swap! (first (get device channel)) disj data-1)))
:else :other))
(m/amb)))))))
#_(defn >ch-stream [>device ch]
(m/cp (m/?< (second (get >device ch)))))
;; Goal:
;; Create function called `(receive-from-bus bus-name)`.
;; `bus-name` is the name of a midi bus on this machine. If a bus with that name
;; exists, the signal returned by `bus` will contain a map of {ch val}, where ch
;; is a midi channel number and val is a signal of sets representing active
;; notes on that channel.
;;
;; Create a nother function, `(send-to-bus bus-name sigs)`. `bus-name` is the
;; name of a midi bus on this machine. If a bus with that name exists, it will
;; start reading note values from `sigs`.
;;
;; Here, `sigs` is a map of {ch val}, where `ch` is a midi channel number and
;; `val` is a signal of sets representing active notes on that channel.
;;
|
