summaryrefslogtreecommitdiff
path: root/src/unheard/midi.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/unheard/midi.clj')
-rw-r--r--src/unheard/midi.clj310
1 files changed, 310 insertions, 0 deletions
diff --git a/src/unheard/midi.clj b/src/unheard/midi.clj
new file mode 100644
index 0000000..1e135a2
--- /dev/null
+++ b/src/unheard/midi.clj
@@ -0,0 +1,310 @@
+(ns unheard.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 |group-by-channel
+ [>messages]
+ (m/group-by #(.getChannel ^ShortMessage %) >messages))
+
+(defn |group-by-data-1
+ [>messages]
+ (m/group-by #(.getData1 ^ShortMessage %) >messages))
+
+(defn |matching-commands
+ [>messages commands]
+ (m/eduction (filter (fn [^ShortMessage v]
+ (contains? commands (.getCommand v)))) >messages))
+
+(def note-commands
+ #{ShortMessage/NOTE_OFF
+ ShortMessage/NOTE_ON
+ ShortMessage/POLY_PRESSURE})
+
+(def control-commands
+ #{ShortMessage/CONTROL_CHANGE})
+
+(defn keyboard
+ [f]
+ (m/relieve
+ (m/group-by
+ first
+ (m/ap
+ (let [[ch ch-messages]
+ (m/?> 128 (|group-by-channel (|short-messages (m/stream f))))
+ ch-messages (m/stream ch-messages)]
+ (m/amb=
+ (let [[note note-messages]
+ (m/?> 128 (-> ch-messages
+ (|matching-commands note-commands)
+ (|group-by-data-1)))]
+ ;; TODO: Where to relieve in here?
+ [:key ch note
+ (m/?<
+ (m/reductions
+ (fn [_prev curr]
+ (when (some? curr)
+ (let [cmd (.getCommand ^ShortMessage curr)]
+ (cond
+ (= cmd ShortMessage/NOTE_ON)
+ (.getData2 ^ShortMessage curr)
+ (= cmd ShortMessage/POLY_PRESSURE)
+ (.getData2 ^ShortMessage curr)
+ (= cmd ShortMessage/NOTE_OFF)
+ nil)))) nil note-messages))])
+
+ (let [[control-number control-messages]
+ (m/?> 128 (-> ch-messages
+ (|matching-commands control-commands)
+ (|group-by-data-1)))]
+ [:control ch control-number (.getData2 ^ShortMessage (m/?< control-messages))])))))))
+
+#_(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 another 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.
+;;
+
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-08 05:32:07 +0000