Improve poly; pass clock as argument

5 files changed, 169 insertions, 40 deletions

diff --git a/src/.notation.clj.swp b/src/.midi.clj.swp
index 6bfd6d0..2080894 100644
--- a/src/.notation.clj.swp
+++ b/src/.midi.clj.swp
diff --git a/src/example_song.clj b/src/example_song.clj
new file mode 100644
index 0000000..096c686
--- /dev/null
+++ b/src/example_song.clj
@@ -0,0 +1,11 @@
+(ns example-song
+  (:require [missionary.core :as m]
+            [notation :refer [note poly group]]))
+
+(defn melody [clock]
+  (m/signal
+   (group clock 0 2
+          (poly (note clock 0 4 1)
+                (note clock 0 5 3)
+                (note clock 0 3 5)
+                (note clock 2 1 7)))))
diff --git a/src/main.clj b/src/main.clj
index 74982ed..57eedad 100644
--- a/src/main.clj
+++ b/src/main.clj
@@ -2,7 +2,8 @@
   (:require [missionary.core :as m]
             [clojure.set :refer [difference union]]
             [portal :refer [>portal-main rec show-portal hide-portal +cap -cap cap]]
-            [notation :refer [melody]]))
+            [notation :as notation]
+            [example-song :refer [melody]]))
 
 ;; How many times per second are output continuous values sampled and turned
 ;; into events?
@@ -56,9 +57,10 @@
       :tick
       (recur)))))
 
-(def output
+(defn output
   "Convert the continuous time >notes-on flow to a series of discrete midi note
   on and off events."
+  [composition]
   (m/eduction
    (comp (remove #(= (select-keys % [:note-on :note-off]) {:note-on #{} :note-off #{}}))
          (dedupe))
@@ -74,19 +76,20 @@
                  ;; but not at all if nothing has changed
                  (m/sample
                   vector
-                  melody
+                  composition
                   clock))))
 
-(def process-midi-toggle-events
+(defn process-midi-toggle-events
   "Listen for changes on midi-enabled?
   When playback is disabled, send a note-off event for each active note
   and then zero out notes-on."
+  [composition]
   (m/ap
    (let [local-midi-enabled? (atom nil)
          local-active (atom #{})
          [tag value] (m/amb=
                       [:midi-enabled? (m/?< >midi-enabled?)]
-                      [:note-event (m/?< output)])]
+                      [:note-event (m/?< (output composition))])]
      (case tag
        :midi-enabled?
        (let [midi-enabled? value
@@ -110,10 +113,11 @@
 
 (defonce engine (atom nil))
 
-(def set->midi-events
+(defn set->midi-events
   "Convert set representation of notes to midi events"
+  [composition]
   (m/ap
-   (let [{:keys [note-on note-off]} (m/?< process-midi-toggle-events)]
+   (let [{:keys [note-on note-off]} (m/?< (process-midi-toggle-events composition))]
      (m/amb=
       (loop [notes note-on]
         (if (first notes)
@@ -126,17 +130,18 @@
                  (recur (rest notes)))
           (m/amb)))))))
 
-(def main
-  (m/ap (m/amb= (m/?< (rec :root set->midi-events))
+(defn main
+  [composition]
+  (m/ap (m/amb= (m/?< (rec :root (set->midi-events composition)))
                 (m/?< >portal-main))))
 
 (defn start-engine
   "Start playback engine."
-  []
+  [composition]
   (when (not @engine)
     (reset! engine
             (do (enable-midi)
-                ((m/reduce {} {} main) {} {})))))
+                ((m/reduce {} {} (main composition)) {} {})))))
 
 (defn stop-engine
   "Stop playback engine."
@@ -147,14 +152,17 @@
     (reset! engine nil)))
 
 (comment
-  (start-engine)
-
-  (cap)
-
+  (let [[>clock set-clock] (notation/clock)]
+       (def >clock >clock)
+       (def set-clock set-clock))
   (+cap :root :notes-set)
+  (start-engine (melody >clock))
 
+  (set-clock 0)
   (show-portal)
 
+  (cap)
+
   (play-notes 1 2 3 4 5)
   (stop-notes 4 5)
 
diff --git a/src/midi.clj b/src/midi.clj
new file mode 100644
index 0000000..ca70273
--- /dev/null
+++ b/src/midi.clj
@@ -0,0 +1,125 @@
+(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 >midi-messages
+  "A flow of java midi messages"
+  [^MidiDevice device]
+  (m/stream
+   (m/ap
+    (let [^Transmitter transmitter (m/? (m/via m/blk (.getTransmitter device)))
+          transmit (atom nil)
+          >transmit (m/eduction (filter some?) (m/watch transmit))
+          receiver (reify Receiver
+                     (send [_this midi-message _timestamp]
+                       (println "HI")
+                       (reset! transmit midi-message))
+                      ;; TODO: Close
+                     (close [this]))]
+      (try
+        (println "Connecting to transmitter")
+        (m/? (m/via m/blk (.setReceiver transmitter receiver)))
+        (println "Connected to transmitter")
+        (m/?< >transmit)
+        (finally
+          (println "Disconnecting from transmitter")
+          (m/? (m/compel (m/via m/blk (.close receiver))))
+          (println "Disconnected from transmitter")))))))
+
+(defn >device
+  "Returns a device for given device name. Returns nil if device not found."
+  [device-name with-device]
+  (m/ap
+    (when-let [device-info (m/?< (>device-info device-name))]
+      (let [^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!
+        (try
+          (println "Opening device")
+          (m/? (m/via m/blk (.open device)))
+          (println "Device opened")
+          (m/?< (with-device device))
+          (finally
+            (println "Closing device")
+            (m/compel (m/? (m/via m/blk (.close device))))
+            (println "Device closed")
+            ))))))
+
+(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)
+
+(def run
+  (m/ap
+    (prn  (m/?< (>device (m/?< >bus-sel)
+                         (fn [v] (m/ap (m/amb  (m/?< v)))))))
+    ))
+
+(def close ((m/reduce prn {} run) {} {}))
+#_
+(close)
+
+;; OH! You hreally have to think about the supervision tree at all times
+;; It informs your function composition
+;;
+;;It helps to write in a continuation style - see `with-messages`
+;;>device is my most mature fn
diff --git a/src/notation.clj b/src/notation.clj
index 7cf4e86..6e266ce 100644
--- a/src/notation.clj
+++ b/src/notation.clj
@@ -1,5 +1,4 @@
 (ns notation
-  "Experimental notation"
   (:require [missionary.core :as m]
             [clojure.set :refer [union]]))
 
@@ -73,26 +72,22 @@
   ;; - Loops
   )
 
-(def clock (atom 0))
-(def >clock (m/signal  (m/watch clock)))
+;; 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))
+   (if (m/?< (m/latest #(<= start % (dec (+ start duration))) clock))
      #{value}
      #{})))
 
-(defmacro poly
-  [& notes]
-  (let [atoms (repeatedly (count notes) gensym)
-        let-bindings (vec (mapcat (fn [atom] [atom `(atom #{})]) atoms))
-        reset-forms (map (fn [atom note] `(m/amb (reset! ~atom (m/?< ~note)))) atoms notes)
-        union-form (cons `union (map (fn [atom] `(deref ~atom)) atoms))]
-    `(m/relieve {}
-                (m/ap
-                  (let ~let-bindings
-                    (m/amb= ~@reset-forms)
-                    ~union-form)))))
+(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
@@ -104,16 +99,6 @@
        (m/?< content)
        (m/amb #{})))))
 
-(def melody
-  (m/signal
-   (poly (note >clock 0 4 1)
-         (note >clock 0 5 3)
-         (note >clock 0 3 5))))
-
-#_(def cancel
-    ((m/reduce prn #{} melody) {} {}))
-
-#_(cancel)
 #_(reset! clock 0)
 #_(swap! clock inc)
 #_(swap! clock dec)