summaryrefslogtreecommitdiff
path: root/src/midi.clj
diff options
context:
space:
mode:
Diffstat (limited to 'src/midi.clj')
-rw-r--r--src/midi.clj231
1 files changed, 59 insertions, 172 deletions
diff --git a/src/midi.clj b/src/midi.clj
index 57e7705..bb9ffbc 100644
--- a/src/midi.clj
+++ b/src/midi.clj
@@ -1,8 +1,7 @@
(ns midi
(:require [missionary.core :as m])
(:import [javax.sound.midi MidiSystem Receiver ShortMessage MidiDevice$Info MidiDevice Transmitter MidiMessage]
- [uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider]
- [missionary Cancelled]))
+ [uk.co.xfactorylibrarians.coremidi4j CoreMidiDeviceProvider]))
(defn get-all-midi-device-info []
(CoreMidiDeviceProvider/getMidiDeviceInfo))
@@ -26,20 +25,14 @@
[^MidiDevice device tfn]
(m/sp
(try
- (.open device)
- #_
(m/? (m/via m/blk (.open device)))
(println "Device opened" device)
(m/? (tfn device))
- (catch Cancelled e (println "with-device received cancellation signal") (throw e))
- (catch Exception e (println "with-device received exception") (throw e))
(finally
- ;; HERE:
- ;; For some reason, closing device is hanging.
(println "Closing device...")
- (.close ^MidiDevice device)
- (println "Device closed.")
- #_
+ ;; 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)))
(println "Device closed" device)))))
@@ -57,59 +50,38 @@
[^MidiDevice device t]
(m/sp
(let [^Transmitter transmitter
- (.getTransmitter device)
- #_
(m/? (m/via m/blk (.getTransmitter device)))
- _ (println "tx mounted")
rv (m/mbx)
receiver
(reify Receiver
(send [_this midi-message _timestamp]
(println "Sending message")
- ;; NOTE: RV CANNOT BLOCK!
- ;; If it does, you can end up with a deadlock during cancellation.
- (rv midi-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)
(println "Message sent"))
(close [_this]))]
(println "RX object defined:" receiver)
(try
(println "Setting receiver...")
- (.setReceiver transmitter receiver)
- #_
(m/? (m/via m/blk (.setReceiver transmitter receiver)))
(println "Receiver set")
- (try
- (m/?
- (t (m/ap
- (m/amb=
- ;; TODO This might not be necessary
- (m/? m/never)
- (loop []
- (m/amb
- (do
- (println "tx awaiting value from device...")
- (m/amb))
-
- ;; TODO:
- ;; As far as I can tell, rx is closing but tx is not.
- ;; I think we're hanging on the take here
- ;; Probably need to raise an exception somehow
-
- ;; Looks like my m/amb= calls are good?
- (let [v (m/? rv)]
- (println "tx received value" v)
- v)
- (recur)))))))
- (catch Cancelled e (println "cancellation signal receved prior to loop exit") (throw e))
- (catch Exception e (println "exception receved prior to loop exit") (throw e))
- (finally
- (println "Loop exited")))
- (catch Cancelled e (println "cancellation signal receved prior to closing tx") (throw e))
- (catch Exception e (println "exception receved prior to closing tx") (throw e))
+ (m/?
+ (t (m/ap
+ (loop []
+ (m/amb
+ (do
+ (println "tx awaiting value from device...")
+ (m/amb))
+ (let [v (m/? rv)]
+ (println "tx received value" v)
+ v)
+ (recur))))))
(finally
(println "Closing tx")
- (.close transmitter)
- #_
(m/? (m/via m/blk (.close transmitter)))
(println "Tx closed"))))))
@@ -128,39 +100,24 @@
"
[^MidiDevice device f]
(m/sp
- ;; TODO Try finally
- ;; TODO blocking APIs everywhere
- ;; TODO mailbox -> rdv
(let [^Receiver receiver
- (.getReceiver device)
- #_
(m/? (m/via m/blk (.getReceiver device)))]
(println "receiver mounted")
(try
(m/?
(m/reduce {} nil
(m/ap
- (try
- (let [^MidiMessage v (m/?< f)]
- (println "rx received value" v)
- (.send receiver v UNSCHEDULED-EVENT)
- #_
- (m/? (m/via m/blk (.send receiver v UNSCHEDULED-EVENT)))
- (println ".send returned"))
- (catch Cancelled e (println "cancellation signal receved prior to rx flow exit") (throw e))
- (catch Exception e (println "exception receved prior to rx flow exit") (throw e))
- (finally (println "RX flow exited"))))))
- (catch Cancelled e (println "cancellation signal receved prior to rx closure") (throw e))
- (catch Exception e (println "exception receved prior to rx closure") (throw e))
+ (let [^MidiMessage v (m/?< f)]
+ (println "rx received value" v)
+ (m/? (m/via m/blk (.send receiver v UNSCHEDULED-EVENT)))
+ (println ".send returned")))))
(finally
(println "Closing rx")
- (.close receiver)
- #_
(m/? (m/via m/blk (.close receiver)))
(println "rx closed"))))))
-
-(defn echo [tx-device rx-device]
+(defn echo
+ [tx-device rx-device from-ch to-ch]
(m/sp
(let [rv (m/rdv)]
(m/?
@@ -169,48 +126,41 @@
(fn [d]
(println "Have tx device")
(m/sp
- (try
- (m/?
- (with-tx d
- (fn [f]
- (m/sp
- (println "Have transmitter")
- (m/?
- (m/reduce prn nil
- (m/ap
- (let [^MidiMessage v (m/?< f)
- _ (println "Echo received value from flow:" v)
- new-msg (ShortMessage. ShortMessage/NOTE_ON 9 (.getData1 ^ShortMessage v) (.getData2 ^ShortMessage v))]
- (println "sending v to rdv.")
- (m/?
- (rv new-msg))
- (println "Value sent.")))))))))
- (catch Cancelled e (println "cancellation signal receved prior transmitter completion") (throw e))
- (catch Exception e (println "exception receved prior transmitter completion") (throw e))
- (finally
- (println "Done with transmitter"))))))
+ (m/?
+ (with-tx d
+ (fn [f]
+ (m/sp
+ (println "Have transmitter")
+ (m/?
+ (m/reduce prn nil
+ (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)))
+
+ (println "Value sent.")))))))))))
(with-device rx-device
(fn [d]
(println "Have rx device")
(m/sp
- (try
- (m/?
- (with-rx d
- (m/ap
- (m/amb=
- (m/? m/never)
- (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)))))))
- (catch Cancelled e (println "cancellation signal receved prior receiver completion") (throw e))
- (catch Exception e (println "exception receved prior receiver completion") (throw e))
- (finally
- (println "Done with receiver")))))))))))
+ (m/?
+ (with-rx d
+ (m/ap
+ (m/amb=
+ (m/? m/never)
+ (loop []
+ (println "Echo rx awaiting value...")
+ (m/amb
+ (m/? rv)
+ (recur)))))))))))))))
(def run
(m/sp
(let [txd
@@ -223,10 +173,7 @@
(select-devices (get-all-midi-device-info)
"CoreMIDI4J - IAC Bus" false true))]
- (def txd txd)
- (def rxd rxd)
-
- (m/? (echo txd rxd)))))
+ (m/? (echo txd rxd 0 0)))))
;; CoreMidiSource is TX Device
;; CoreMidiDestination is RX Device
@@ -271,63 +218,3 @@
;; `val` is a signal of sets representing active notes on that channel.
;;
-(let [_ (println "getting device")
- txd (first
- (select-devices (get-all-midi-device-info)
- "CoreMIDI4J - IAC Bus" true false))
- rxd (first
- (select-devices (get-all-midi-device-info)
- "CoreMIDI4J - IAC Bus" false true))
- _ (println "getting transmitter")
- transmitter (.getTransmitter txd)
- _ (.setReceiver transmitter
- (reify Receiver
- (send [_this midi-message _timestamp]
- (println "Message received:")
- (println midi-message))
- (close [_this] (println "Closing!"))))
- receiver (.getReceiver rxd)]
- (println "opening txd")
- (.open txd)
- (println "Opening rxd")
- (.open rxd)
- (println "setting receiver")
- (def txd txd)
- (def rxd rxd)
- (def t transmitter)
- (def r receiver))
-
-(.send r (ShortMessage. ShortMessage/NOTE_ON 0 0 0) -1)
-
-(.close txd)
-(.close rxd)
-(.close t)
-(.close r)
-
-(def t
- (m/sp
- (try
- (println "A")
- (m/? (m/sp
- (try
- (println "AA")
- (m/? (m/sleep 10000000))
- (println "BB")
- (catch missionary.Cancelled e
- (println "Catch Inner") (throw e))
- (catch Exception e
- (println "E" e)
- (println "Exception Inner") (throw e))
- (finally
- (println "Finally Inner")))))
- (catch missionary.Cancelled e
- (println "Catch Outer") (throw e))
- (catch Exception e
- (println "Exception Outer") (throw e))
- (finally
- (println "Finally Outer")))
- (println "B")))
-
-(def cancel (t {} {}))
-
-(cancel)
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-09 11:40:19 +0000