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
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
|
(ns midi
(:require [missionary.core :as m]
[taoensso.trove :as log])
(: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))
;; Move to tools.repl
(defn print-all-midi-devices
"Prints the names of all MIDI devices attached to the computer."
[]
(doseq [^MidiDevice$Info device-info (get-all-midi-device-info)]
(println (.getName device-info))))
(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 %))))
;; TODO: git-bug d317eca
(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)))
(log/log! {:level :info, :id :midi/device-opened, :data {:device (str device)}})
(m/? (tfn device))
(finally
(log/log! {:level :info, :id :midi/closing-device})
;; NOTE:
;; Be careful, (.close device) will wait for (.send receiver ...) to return.
;; This can lead to deadlocks during cancellation.
(m/? (m/via m/blk (.close device)))
(log/log! {:level :info, :id :midi/device-closed, :data {:device (str device)}})))))
(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)))
rv (m/mbx)
receiver
(reify Receiver
(send [_this midi-message _timestamp]
(log/log! {:level :debug, :id :midi/sending-message})
;; NOTE:
;; Be careful, (.close device) will wait for (.send receiver ...) to return.
;; This can lead to deadlocks during cancellation.
;;
;; TODO: git-bug a1652f9
(rv midi-message)
(log/log! {:level :debug, :id :midi/message-sent}))
(close [_this]))]
(log/log! {:level :debug, :id :midi/rx-object-defined, :data {:receiver (str receiver)}})
(try
(log/log! {:level :debug, :id :midi/setting-receiver})
(m/? (m/via m/blk (.setReceiver transmitter receiver)))
(log/log! {:level :debug, :id :midi/receiver-set})
(m/?
(t (m/ap
(loop []
(m/amb
(do
(log/log! {:level :debug, :id :midi/tx-awaiting-value})
(m/amb))
(let [v (m/? rv)]
(log/log! {:level :debug, :id :midi/tx-received-value, :data {:value (str v)}})
v)
(recur))))))
(finally
(log/log! {:level :info, :id :midi/closing-tx})
(m/? (m/via m/blk (.close transmitter)))
(log/log! {:level :info, :id :midi/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
(let [^Receiver receiver
(m/? (m/via m/blk (.getReceiver device)))]
(log/log! {:level :info, :id :midi/receiver-mounted})
(try
(m/?
(m/reduce {} nil
(m/ap
(let [^MidiMessage v (m/?< f)]
(log/log! {:level :debug, :id :midi/rx-received-value, :data {:value (str v)}})
(m/? (m/via m/blk (.send receiver v UNSCHEDULED-EVENT)))
(log/log! {:level :debug, :id :midi/send-returned})))))
(finally
(log/log! {:level :info, :id :midi/closing-rx})
(m/? (m/via m/blk (.close receiver)))
(log/log! {:level :info, :id :midi/rx-closed}))))))
(defn >bus
"Opens device named `name`.
Device will consume `flow`, a flow of Message objects."
[name flow]
(let [device
(first
(select-devices (get-all-midi-device-info)
name false true))]
(with-device device
(fn [d]
(with-rx d flow)))))
(defn <bus
"Opens device named `name`.
Calls `flow-handler` with a flow of midi messages.
`flow-handler` should return a flow."
[name flow-handler]
(let [device
(first
(select-devices (get-all-midi-device-info)
name true false))]
(with-device device
(fn [d]
(with-tx d
(fn [f]
(m/reduce prn nil (flow-handler f))))))))
(defn echo
"Echo test."
[name from-ch to-ch]
(m/sp
(let [rv (m/rdv)]
(m/?
(m/join vector
(<bus name
(fn [f]
(m/ap
(let [v (m/?< f)]
(if (= (class v) ShortMessage)
(let [v ^ShortMessage v]
(if (and (= from-ch (.getChannel v))
(#{ShortMessage/NOTE_ON ShortMessage/NOTE_OFF} (.getCommand v)))
(let [new-msg (ShortMessage. (.getCommand v) to-ch
(.getData1 v)
(.getData2 v))]
(m/? (rv new-msg)))
(m/amb)))
(m/amb)))
(log/log! {:level :debug, :id :midi/value-sent}))))
(>bus name
(m/ap
(m/amb=
(m/? m/never)
(loop []
(log/log! {:level :debug, :id :midi/echo-rx-awaiting-value})
(m/amb
(m/? rv)
(recur)))))))))))
;; CoreMidiSource is TX Device
;; CoreMidiDestination is RX Device
#_(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 >midi-messages->ch-stream
[>midi-messages]
(m/ap
(let [device (atom #{})
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! device conj data-1)
(= command ShortMessage/NOTE_OFF)
(swap! device disj data-1)))
:else (m/amb)))))
(defn |short-messages
"Filter down to midi short messages"
[>messages]
(m/eduction (filter #(instance? ShortMessage %)) >messages))
(defn |channels
[>messages]
(m/group-by #(.getChannel ^ShortMessage %) >messages))
(def note-commands
#{ShortMessage/NOTE_OFF
ShortMessage/NOTE_ON
ShortMessage/POLY_PRESSURE})
(defn |notes
[>messages]
(m/group-by #(.getData1 ^ShortMessage %)
(m/ap
(let [^ShortMessage v (m/?> >messages)]
(if (contains? note-commands (.getCommand v))
v
(m/amb))))))
(def control-commands
#{ShortMessage/CONTROL_CHANGE})
;; TODO: |control-changes and |notes combine grouping and filtering, which isn't great
(defn |control-changes
[>messages]
(m/group-by #(.getData1 ^ShortMessage %)
(m/ap
(let [^ShortMessage v (m/?> >messages)]
(if (contains? control-commands (.getCommand v))
v
(m/amb))))))
#_(defn >ch-stream [>device ch]
(m/cp (m/?< (second (get >device ch)))))
#_{ch {:notes {note aftertouch}
:pitch v
:control {controller value}
:program program}}
;; 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.
;;
|
