Create first draft of time-object

5 files changed, 209 insertions, 16 deletions

diff --git a/deps.edn b/deps.edn
index 3d9844d..a7897c6 100644
--- a/deps.edn
+++ b/deps.edn
@@ -3,6 +3,7 @@
         missionary/missionary {:mvn/version "b.46"}
         djblue/portal {:mvn/version "0.61.0"}
         uk.co.xfactory-librarians/coremidi4j {:mvn/version "1.6"}
+        io.helins/interval {:mvn/version "1.0.0-beta0"}
         com.taoensso/trove {:mvn/version "1.1.0"}}
  :aliases {:dev {:extra-paths ["dev"]
                  :extra-deps {com.hyperfiddle/rcf {:mvn/version "20220926-202227"}}}}}
diff --git a/dev/scratch.clj b/dev/scratch.clj
index 315df29..53267f9 100644
--- a/dev/scratch.clj
+++ b/dev/scratch.clj
@@ -68,3 +68,5 @@
 
 
 (def cancel (run {} {}))
+
+(cancel)
diff --git a/src/unheard/midi.clj b/src/unheard/midi.clj
index c3759fe..93fd6c0 100644
--- a/src/unheard/midi.clj
+++ b/src/unheard/midi.clj
@@ -176,22 +176,21 @@
 
   `flow-handler` should return a flow."
   [name flow-handler]
-  (m/ap
-   (try
-     (let [device
-           (first
-            (select-devices (get-all-midi-device-info)
-                            name
-                            true false))]
-       (if device
-         (m/?
-          (with-device device
-            (fn [d]
-              (with-tx d
-                (fn [f]
-                  (m/reduce prn nil (flow-handler f)))))))
-         (m/amb)))
-     (catch missionary.Cancelled _ (m/amb)))))
+  (m/sp
+    (let [device
+          (first
+           (select-devices (get-all-midi-device-info)
+                           name
+                           true false))]
+      (if device
+        (m/?
+         (with-device device
+           (fn [d]
+             (with-tx d
+               (fn [f]
+                 (m/reduce prn nil (flow-handler f)))))))
+        (m/amb)))
+    ))
 
 ;; TODO: Move elsewhere
 (defn echo
diff --git a/src/unheard/time_object.clj b/src/unheard/time_object.clj
new file mode 100644
index 0000000..6f088b6
--- /dev/null
+++ b/src/unheard/time_object.clj
@@ -0,0 +1,122 @@
+(ns unheard.time-object
+  (:require [missionary.core :as m]
+            [helins.interval.map :as imap]))
+
+;; DESIGN
+;; A "time object" is any object with a lifetime that is temporally bounded. The
+;; goal of the time object abstraction is to allow for for efficient,
+;; low-latency allocation and deallocation of an unlimited number of time
+;; objects.
+;;
+;;It is important that a time tree can be efficiently queried by both a range
+;;(for UI) and a point (for a song).
+;;
+;; IMPLEMENTATION
+;; Time objects are stored in an interval tree. 
+
+;; Requirements
+;; - time objects returned by a timeline range query will include metadata like
+;;   start time and end time
+;; - Flows associated with time objects should only mount or dismount when
+;;   the result of the query changes. I think the best way to accomplish this
+;;   is to have the query return a flow of time objects, and then have some
+;;   separate function responsible for "playing" these time objects.
+;; 
+;; Question:
+;; Should time objects take an interval tree as an argument,
+;; or should they return a flow of interval information (start, end, value)
+;; that can be fed into some kind of reactive interval map bookkeeper?
+;; I think the latter.
+;;
+
+(def id-counter (atom 0))
+
+(defn time-object
+  "A time-object takes a start time, and end time, and a value.
+  Value is a flow that will be consumed when the corresponding
+  time tree is consumed at a point in time within the time-object's
+  interval."
+  [>start >end >metadata >flow]
+  (let [action (atom nil)
+        >action (m/watch action)
+        id (swap! id-counter inc)]
+    (m/ap
+     (reset! action
+             [:add
+              id
+              {:start >start
+               :end >end
+               :metadata >metadata
+
+               :flow >flow}])
+     (try
+       (m/?< >action)
+       (catch missionary.Cancelled _ [:remove id])))))
+
+(comment
+  (def cancel
+    ((m/reduce prn nil (time-object 1 2 :a (m/ap)))
+     prn prn))
+
+  (cancel))
+
+(defn time-object-collection
+  "Takes a flow of [diff-action time-object-id time-object], where:
+  - diff-action is one of either :add or :remove
+  - time-object-id is a unique identifier
+  - time-object is the time object in question
+
+  Returns a collection of time objects, represented as a flow."
+  [& time-objects]
+  (apply m/latest vector time-objects))
+
+(comment
+  (def cancel
+    ((m/reduce prn nil
+               (time-object-collection
+                (time-object 1 2 :a (m/ap))
+                (time-object 3 4 :a (m/ap)))) prn prn))
+
+  (cancel))
+
+;; m/store is an optimization, allowing diffs to be dropped prior to processing
+;; by consumer. Think :add 1, :remove 1
+
+(defn merge-tocs
+  "Merge multiple time-object-collections. Returns a new time-object-collection."
+  [& time-object-colletion])
+
+(defn timeline
+  "Primary timeline bookkeeping mehanism."
+  [time-object-collection]
+  (m/ap))
+
+(defn point-query
+  "Query a timeline. Returns a flow of time objects."
+  [>timeline >at]
+  (m/ap
+   (let [[tl at] (m/?< (m/latest vector >timeline >at))]
+     (get tl at))))
+
+(defn range-query
+  "Range query. Returns a flow of time objects."
+  [timeline >range])
+(defn run
+  "Runs the flows associated with a collection of time objects."
+  ;; TODO: "Running" a time object has different meanings for different objects.
+  ;; How should I think about that?
+  [>query-result])
+
+;; How should a time tree work?
+;; Well, we eventually want to end up with a single time tree
+;; Is it important to be able to merge time trees together?
+;; Part of me thinks "yes"
+;; Time objects cannot be composed together - that is, you can't
+;; take two time objects and add them together to get a new time object
+;; However, you _can_ add two time objects together to get a time tree
+;; The alternative to having intermediate time trees would be to have
+;; some kind of time-object-collection abstraction.
+;; time-object-collection would have a merge function.
+;; A time object collection would be responsible for all of the bookkeeping
+;; related to the lifetimes of time objects.
+;; My suspicion is that this will 
diff --git a/src/unheard/time_object_test.clj b/src/unheard/time_object_test.clj
new file mode 100644
index 0000000..07e49c3
--- /dev/null
+++ b/src/unheard/time_object_test.clj
@@ -0,0 +1,69 @@
+(ns unheard.time-object-test
+  (:require [unheard.time-object :as sut]
+            [missionary.core :as m]
+            [hyperfiddle.rcf :refer [tests] :as rcf]))
+
+(tests
+  "behavioral test"
+  (let [to1-start (atom 5)
+        >to1-start (m/watch to1-start)
+        to1-end (atom 10)
+        >to1-end (m/watch to1-end)
+        to1-value (atom :to1-a)
+        >to1-value (m/watch to1-value)
+
+        to1 (sut/time-object >to1-start >to1-end >to1-value)
+
+        to2-start (atom 7)
+        >to2-start (m/watch to2-start)
+        to2-end (atom 15)
+        >to2-end (m/watch to2-end)
+        to2-value (atom :to1-b)
+        >to2-value (m/watch to2-value)
+
+        to2 (sut/time-object >to2-start >to2-end >to2-value)
+
+        toc1 (sut/time-object-collection to1 to2)
+
+        to3-start (atom 2)
+        >to3-start (m/watch to3-start)
+        to3-end (atom 3)
+        >to3-end (m/watch to3-end)
+        to3-value (atom :to3-a)
+        >to3-value (m/watch to3-value)
+
+        to3 (sut/time-object >to3-start >to3-end >to3-value)
+
+        to4-start (atom 8)
+        >to4-start (m/watch to4-start)
+        to4-end (atom 12)
+        >to4-end (m/watch to4-end)
+        to4-value (atom :to3-b)
+        >to4-value (m/watch to4-value)
+
+        to4 (sut/time-object >to4-start >to4-end >to4-value)
+
+        toc2 (sut/time-object-collection to3 to4)
+
+        combined (sut/time-object-collection toc1 toc2)
+
+        timeline (sut/timeline combined)
+
+        point-query-at (atom 0)
+        >point-query-at (m/watch point-query-at)
+
+        point-query-result (sut/point-query timeline >point-query-at)
+
+        #_#_#_#_#_#_
+        range-query-range (atom [0 10])
+        >range-query-range (m/watch range-query-range)
+
+        range-query-result (sut/range-query timeline >range-query-range)
+        ]
+
+    (def cancel
+      ((m/reduce rcf/tap nil point-query-result) #() #(throw %)))
+
+    (cancel)
+
+    ))