diff options
| -rw-r--r-- | .nrepl-port | 2 | ||||
| -rw-r--r-- | deps.edn | 3 | ||||
| -rw-r--r-- | src/.midi.clj.swp | bin | 12288 -> 0 bytes | |||
| -rw-r--r-- | src/midi.clj | 316 |
4 files changed, 192 insertions, 129 deletions
diff --git a/.nrepl-port b/.nrepl-port index be0f9d1..1dda083 100644 --- a/.nrepl-port +++ b/.nrepl-port @@ -1 +1 @@ -56380
\ No newline at end of file +54154
\ No newline at end of file @@ -1,5 +1,6 @@ {:paths ["" "src" "resources"] :deps {org.clojure/clojure {:mvn/version "1.12.0"} missionary/missionary {:mvn/version "b.46"} - djblue/portal {:mvn/version "0.61.0"}} + djblue/portal {:mvn/version "0.61.0"} + uk.co.xfactory-librarians/coremidi4j {:mvn/version "1.6"}} :aliases {:dev {:extra-paths ["dev"]}}} diff --git a/src/.midi.clj.swp b/src/.midi.clj.swp Binary files differdeleted file mode 100644 index 2080894..0000000 --- a/src/.midi.clj.swp +++ /dev/null diff --git a/src/midi.clj b/src/midi.clj index 41a8740..bf7d03d 100644 --- a/src/midi.clj +++ b/src/midi.clj @@ -1,135 +1,197 @@ (ns midi (:require [missionary.core :as m]) - (:import [javax.sound.midi MidiSystem Receiver ShortMessage MidiDevice$Info MidiDevice Transmitter])) - -(def >midi-devices - (m/stream - (m/ap - (loop [] - (m/amb= (MidiSystem/getMidiDeviceInfo) - (do - (m/? (m/sleep 5000)) - (recur))))))) - -;; NOTE: Seems that there is a JVM bug that prevents device rescanning -;; -(def >midi-device-info - "A flow of maps of device name -> device properties" - (m/signal - (m/eduction (dedupe) - (m/ap (let [devices (m/?< >midi-devices)] - (into {} (map (fn [^MidiDevice$Info d] - [(.getName d) - {:description (.getDescription d) - :vendor (.getVendor d) - :version (.getVersion d) - :device-info d}]) devices))))))) - -(defn >device-info - [device-name] - (m/ap (let [device-info (m/?< >midi-device-info)] - (get-in device-info [device-name :device-info])))) - -(defn >device - "Returns a device for given device name. Returns nil if device not found." - [device-name] - (m/stream - (m/ap - (let [device-info - (m/?< (>device-info device-name)) - ^MidiDevice device (MidiSystem/getMidiDevice ^MidiDevice$Info device-info)] - ;; Essential problem: Combining taking element from flow to put in - ;; conditional, and cleaning up in catch. - ;; NOTE: You need the MidiDevice type hint when you call open and close! - - (m/amb= (do - (println "opening device") - (m/? (m/via m/blk (.open device))) - (println "device opened") - (m/amb - device)) - (try - (m/? m/never) - (finally - (println "closing device") - (m/compel (m/? (m/via m/blk (.close device)))) - (println "device closed")))))))) - -;; Key insight: Cancelation shouldn't actually start with the device - -(defn >midi-messages - "A flow of java midi messages" - [device-name] - (m/stream - (m/ap - (let [^MidiDevice device (m/?< (>device device-name)) - ^Transmitter transmitter (m/? (m/via m/blk (.getTransmitter device))) - transmit (atom nil) - >transmit (m/eduction (filter some?) (m/ap (try (m/?< (m/watch transmit)) (catch missionary.Cancelled _ (m/amb))))) - receiver (reify Receiver - (send [_this midi-message _timestamp] - (println "HI") - (reset! transmit midi-message)) - ;; TODO: Close - (close [this]))] - (m/amb= - (do - (println "Connecting to transmitter") - (m/? (m/via m/blk (.setReceiver transmitter receiver))) - (println "Connected to transmitter") - (m/?< >transmit)) - (try (m/? m/never) - (finally - (println "Disconnecting from transmitter") - (m/? (m/compel (m/via m/blk (.close receiver)))) - (println "Disconnected from transmitter") - (throw (missionary.Cancelled. "Transmitter cancelled."))))))))) - -(defn new-device - "Generate a new midi device. - Currently, this is a map of channel-num to [atom signal]." - [] - (into {} (map (fn [i] [i (let [v (atom #{})] [v (m/signal (m/watch v))])]) (range 0 127)))) - -(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))))) - -(def bus-sel (atom nil)) -(def >bus-sel (m/eduction (dedupe) (m/watch bus-sel))) -(reset! bus-sel "Bus 1") -#_(reset! bus-sel "Bus 2") -#_(reset! bus-sel nil) + (: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/ap - (prn (m/?< (>device (m/?< >bus-sel)))) - )) + (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 ((m/reduce prn {} run) {} {})) -#_ +(def close (run prn prn)) (close) -;; OH! You hreally have to think about the supervision tree at all times -;; It informs your function composition +#_(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. ;; -;;It helps to write in a continuation style - see `with-messages` -;;>device is my most mature fn |