diff options
Diffstat (limited to 'src/midi.clj')
| -rw-r--r-- | src/midi.clj | 310 |
1 files changed, 0 insertions, 310 deletions
diff --git a/src/midi.clj b/src/midi.clj deleted file mode 100644 index 8e56b08..0000000 --- a/src/midi.clj +++ /dev/null @@ -1,310 +0,0 @@ -(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 |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 (midi/|group-by-channel (midi/|short-messages (m/stream f)))) - ch-messages (m/stream ch-messages)] - (m/amb= - (let [[note note-messages] - (m/?> 128 (-> ch-messages - (midi/|matching-commands note-commands) - (midi/|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 - (midi/|matching-commands control-commands) - (midi/|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. -;; - |