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
|
(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))
(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)))
(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 {} 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)))))))))))
(def run
(echo "CoreMIDI4J - IAC Bus" 0 0))
;; CoreMidiSource is TX Device
;; CoreMidiDestination is RX Device
(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.
;;
|
