From 2d956a3a779672ab3acfc1bc542ebba855522d06 Mon Sep 17 00:00:00 2001 From: Jake Zerrer Date: Wed, 5 Nov 2025 16:45:22 -0500 Subject: Organize namespaces --- .nrepl-port | 1 - src/midi.clj | 310 ---------------------------------------- src/midi/percussion.clj | 82 ----------- src/notation.clj | 104 -------------- src/scratch.clj | 3 +- src/unheard/clock.clj | 11 ++ src/unheard/dsl.clj | 61 ++++++++ src/unheard/midi.clj | 310 ++++++++++++++++++++++++++++++++++++++++ src/unheard/midi/percussion.clj | 82 +++++++++++ src/unheard/theory.clj | 34 +++++ 10 files changed, 500 insertions(+), 498 deletions(-) delete mode 100644 .nrepl-port delete mode 100644 src/midi.clj delete mode 100644 src/midi/percussion.clj delete mode 100644 src/notation.clj create mode 100644 src/unheard/clock.clj create mode 100644 src/unheard/dsl.clj create mode 100644 src/unheard/midi.clj create mode 100644 src/unheard/midi/percussion.clj create mode 100644 src/unheard/theory.clj diff --git a/.nrepl-port b/.nrepl-port deleted file mode 100644 index 9a32db3..0000000 --- a/.nrepl-port +++ /dev/null @@ -1 +0,0 @@ -52896 \ No newline at end of file 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 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. -;; - diff --git a/src/midi/percussion.clj b/src/midi/percussion.clj deleted file mode 100644 index 21fcee9..0000000 --- a/src/midi/percussion.clj +++ /dev/null @@ -1,82 +0,0 @@ -(ns 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/notation.clj b/src/notation.clj deleted file mode 100644 index 6e266ce..0000000 --- a/src/notation.clj +++ /dev/null @@ -1,104 +0,0 @@ -(ns notation - (: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)) - -;; 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 - ) - -;; TODO: Move elsewhere -(defn clock [] - (let [clock (atom 0) - >clock (m/signal (m/watch clock))] - [>clock (fn [v] (reset! clock v))] - )) - -(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 #{}))))) - -#_(reset! clock 0) -#_(swap! clock inc) -#_(swap! clock dec) diff --git a/src/scratch.clj b/src/scratch.clj index ed2d464..7c305aa 100644 --- a/src/scratch.clj +++ b/src/scratch.clj @@ -1,5 +1,6 @@ (ns scratch - (:require [midi :as midi] + (:require [unheard.midi :as midi] + [unheard.midi.percussion :refer [kick snare]] [missionary.core :as m])) #_(print-all-midi-devices) 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 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 -- cgit v1.2.3