Organize namespaces

5 files changed, 498 insertions, 0 deletions

diff --git a/src/unheard/clock.clj b/src/unheard/clock.clj
new file mode 100644
index 0000000..4011919
--- /dev/null
+++ b/src/unheard/clock.clj
@@ -0,0 +1,11 @@
+(ns unheard.clock
+  (:require [missionary.core :as m]))
+
+(defn clock
+  "Returns a tuple of [`>clock` `clock`].
+  `clock` is an atom representing the current time.
+  `>clock` is a signal representing the current time."
+  []
+  (let [clock (atom 0)
+        >clock (m/signal (m/watch clock))]
+    [>clock clock]))
diff --git a/src/unheard/dsl.clj b/src/unheard/dsl.clj
new file mode 100644
index 0000000..e111725
--- /dev/null
+++ b/src/unheard/dsl.clj
@@ -0,0 +1,61 @@
+(ns unheard.dsl
+  (:require [missionary.core :as m]
+            [clojure.set :refer [union]]))
+
+(comment
+  ;; Parallel groups
+  ;; Notes 1, 2, and 3 simultaneously
+  ;; = should remind you of amb=
+  ;; implicit duration of 1
+  [= 1 2 3]
+  ;; Compiles to?
+
+  ;; Same as above, but with duration 3
+  ([= 1 2 3] 3)
+
+  ;; Notes 1, 2, and 3 all with different durations
+  [=
+   (1 2)
+   (2 3)
+   (3 4)]
+
+  ;; Inner values override outer values
+  ;; In this chord, 1 would have a duration of 3 while 2 and 3 would have a duration of 2
+  ([= (1 3) 2 3] 2)
+
+  ;; Notes 1, 2, and 3 all with different durations and velocities
+  [=
+   (1 2 100)
+   (2 3 110)
+   (3 4 123)]
+
+  ;; Sequential groups
+  ;; Note 1, then note 2, then note 3
+  [1 2 3]
+
+  ;; Note 1 duration 1, then note 2 duration 2, then note 3 duration 1
+  [(1 1)
+   (2 2)
+   (3 1)]
+
+  ;; Three chords played sequentially
+  [[= 1 2 3]
+   [= 1 2 3]
+   [= 1 2 3]]
+
+;; Note 1, followed by a rest, followed by note 3
+  [1 (r) 3]
+
+  ;; Unlike notes, rests are at most 2-tuples
+  ;; (Think about it: Rests never have a note value)
+
+  ;; Assign the note sequence 1 2 3 to the name loop1
+  ;; The first argument is always the name; the last argument is always either
+  ;; a sequential or parallel group
+  (=loop1 [1 2 3])
+
+  ;; Use loop1
+  [1 (loop1) 2 3]
+
+  ;; Middle arguments are variable names
+  (=loop2 dur ([1 2 3] dur)))
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.
+;;
+
diff --git a/src/unheard/midi/percussion.clj b/src/unheard/midi/percussion.clj
new file mode 100644
index 0000000..700b2e6
--- /dev/null
+++ b/src/unheard/midi/percussion.clj
@@ -0,0 +1,82 @@
+(ns unheard.midi.percussion
+  "General MIDI percussion instrument mappings (MIDI notes 35-81).
+
+  In General MIDI, channel 10 is reserved for percussion where each
+  note number represents a different percussion instrument rather than pitch.")
+
+;; Bass Drums
+(def acoustic-bass-drum 35)
+(def bass-drum-1 36)
+(def kick 36)  ; alias for bass-drum-1
+
+;; Snares
+(def side-stick 37)
+(def acoustic-snare 38)
+(def hand-clap 39)
+(def electric-snare 40)
+(def snare 38)  ; alias for acoustic-snare
+
+;; Toms
+(def low-floor-tom 41)
+(def high-floor-tom 43)
+(def low-tom 45)
+(def low-mid-tom 47)
+(def hi-mid-tom 48)
+(def high-tom 50)
+
+;; Hi-Hats
+(def closed-hi-hat 42)
+(def pedal-hi-hat 44)
+(def open-hi-hat 46)
+
+;; Cymbals
+(def crash-cymbal-1 49)
+(def ride-cymbal-1 51)
+(def chinese-cymbal 52)
+(def ride-bell 53)
+(def splash-cymbal 55)
+(def crash-cymbal-2 57)
+(def ride-cymbal-2 59)
+(def crash 49)  ; alias for crash-cymbal-1
+(def ride 51)   ; alias for ride-cymbal-1
+
+;; Percussion
+(def tambourine 54)
+(def cowbell 56)
+(def vibraslap 58)
+
+;; Latin Percussion - Bongos & Congas
+(def hi-bongo 60)
+(def low-bongo 61)
+(def mute-hi-conga 62)
+(def open-hi-conga 63)
+(def low-conga 64)
+
+;; Latin Percussion - Timbales
+(def high-timbale 65)
+(def low-timbale 66)
+
+;; Latin Percussion - Agogos
+(def high-agogo 67)
+(def low-agogo 68)
+
+;; Latin Percussion - Others
+(def cabasa 69)
+(def maracas 70)
+(def short-whistle 71)
+(def long-whistle 72)
+(def short-guiro 73)
+(def long-guiro 74)
+(def claves 75)
+
+;; Wood Blocks
+(def hi-wood-block 76)
+(def low-wood-block 77)
+
+;; Cuicas
+(def mute-cuica 78)
+(def open-cuica 79)
+
+;; Triangles
+(def mute-triangle 80)
+(def open-triangle 81)
diff --git a/src/unheard/theory.clj b/src/unheard/theory.clj
new file mode 100644
index 0000000..5d5805b
--- /dev/null
+++ b/src/unheard/theory.clj
@@ -0,0 +1,34 @@
+(ns unheard.theory
+  (:require [missionary.core :as m]
+            [clojure.set :refer [union]]))
+
+(defn note [clock start duration value]
+  (m/cp
+   (if (m/?< (m/latest #(<= start % (dec (+ start duration))) clock))
+     #{value}
+     #{})))
+
+(defn poly [& notes]
+  (m/ap
+    (apply union (m/?< (apply m/latest vector notes)))))
+
+;; TODO: Group could actually wrap note, rather than using explicitly
+;; WIll introduce a lot of GC churn, though
+(defn group
+  [clock start end content]
+  (m/cp
+   (let [content (m/signal content)]
+     (if (m/?< (m/latest #(<= start % end) clock))
+       (m/?< content)
+       (m/amb #{})))))
+
+;; TODO:
+;; - Note literals turn into numbers
+;; - Represent keyboard as byte array of shorts
+;; - play a note increments, stop a note decrements
+;; - Multiple instruments
+;; - Mapping inputs to vars
+;; - Inputs get declared at the top of a track
+;; - Devices get mapped to declared inputs
+;; - Notion of scenes that change mapping of inputs to vars
+;; - Loops