diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/unheard/time_object.clj | 208 |
1 files changed, 50 insertions, 158 deletions
diff --git a/src/unheard/time_object.clj b/src/unheard/time_object.clj index 50deabc..e473411 100644 --- a/src/unheard/time_object.clj +++ b/src/unheard/time_object.clj @@ -2,176 +2,68 @@ (:require [missionary.core :as m] [helins.interval.map :as imap])) -;; A "time object" is any object with a lifetime that is temporally bounded. -;; A musical note that is part of a greater composition is the canonical example: -;; it exists between a start time and an end time, but doesn't exist otherwise. -;; -;; A complex musical composition might consist of tens of thousands of these -;; time objects. However, during playback, only a small subset of all time -;; objects are computationally relevant. That subset is any time objects -;; whose timer interval overlaps with "now". -;; -;; For example, imagine a musical composition with three notes: -;; -;; [note start-time end-time] -;; -;; - [:a 0 10] -;; - [:b 5 15] -;; - [:c 20 25] -;; -;; At time 2, :a is computationally relevant. -;; At time 7, :a and :b are computationally relevant. -;; At time 17, nothing is computationally relevant. -;; -;; This namespace wraps the helins.interval.map data structure in a small -;; collection of functions producting missionary flows, building what amounts -;; to a reactive interval tree. Library users: -;; -;; - Create time objects using the `time-object` function. -;; - Combine time objects with `time-object-collection`. -;; - Combine time object collections with `merge-time-object-collection`. -;; - Instantiate a reactive interval tree with `timeline`. -;; - Query the timeline with `point-query` and `range-query`. - -(def id-counter (atom 0)) - +;; TODO: Update description (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." - ;; NOTE: Might want to replace >flow with something more general like value. - ;; While it's true that in my usecase, I will ultimately end up collecting - ;; and booting flows from all time objects returned by `point-query`, - ;; that is kind of a separate concern. - [>range >metadata >flow] - (m/ap - (let [id (swap! id-counter inc) - v {:id id - :range >range - :metadata >metadata - :flow >flow}] - (m/amb= - [:add v] - (try - (m/? m/never) - (catch missionary.Cancelled _ [:remove v])))))) - -(comment - (def cancel - ((m/reduce prn nil (time-object (m/ap [1 2]) :a (m/ap))) - prn prn)) - - (cancel)) - -(defn merge-flows [& flows] - (m/ap - (m/?< - (m/?> (count flows) (m/seed flows))))) - -(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] - ;; Goal: use group-by to emit just twice per time object - (m/ap (m/?> (try (apply m/zip vector time-objects) (catch missionary.Cancelled _))))) - -(comment - (def cancel - ((m/reduce prn nil - (time-object-collection - (time-object (m/ap [1 2]) :a (m/ap)) - (time-object (m/ap [3 4]) :b (m/ap)) - (time-object (m/ap [5 6]) :c (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-collections] - (apply merge-flows time-object-collections)) + interval. + " + [start duration value] + {:start start, :duration duration, :value value}) + +(defn lift + "Lift collection of time objects to a phrase" + [& children] + {:start 0, :time-objects children}) + +;; FIXME: Currently, composing phrases has exponential +;; time complexity. (Each parent phrase causes recomputation of the +;; time offset of each child phrase.) +(defn phrase + [& children] + (fn [start] + {:start start, + :time-objects (for [child children + time-object (:time-objects child)] + (update time-object :start (partial + start)))})) (comment - (def cancel - ((m/reduce prn nil - (merge-tocs - (time-object-collection - (time-object (m/ap [1 2]) :a (m/ap)) - (time-object (m/ap [3 4]) :b (m/ap)) - (time-object (m/ap [5 6]) :c (m/ap))) - (time-object-collection - (time-object (m/ap [1 2]) :d (m/ap)) - (time-object (m/ap [3 4]) :e (m/ap)) - (time-object (m/ap [5 6]) :f (m/ap))))) prn prn)) - - ;; Whoa! Running cancel twice cancels twice... - ;; https://clojurians.slack.com/archives/CL85MBPEF/p1763154775780589?thread_ts=1763149125.436899&cid=CL85MBPEF - (cancel)) + (def a (phrase (lift (time-object 0 4 :x)))) + (def b + (phrase (a 0) + (a 1) + (lift (time-object 10 2 :x)) + (lift (time-object 0 2 :y)))) + (def c (phrase (b 0) (b 3))) + (c 0)) (defn timeline "Primary timeline bookkeeping mehanism." - [time-object-collection] - (m/ap - (let [actions (m/?< time-object-collection)] - (loop [tree imap/empty - actions actions] - (let [[k {:keys [id range] :as v}] (first actions)] - (case k - :add - ;; TODO: Raise if-let up a level to remove duplication - (let [[s e] (m/?< range)] - (if-let [next (seq (rest actions))] - (recur (imap/mark tree s e [id v]) next) - tree)) - :remove - (let [[s e] (m/?< range)] - (if-let [next (seq (rest actions))] - (do - (println "REMOVING" s e) - (recur (imap/erase tree s e [id v]) next)) - tree)) - :else - (if-let [next (seq (rest actions))] - (recur tree next) - tree))))))) + [{:keys [time-objects]}] + (let [m imap/empty] + (if (seq? time-objects) + (loop [time-objects time-objects + m m] + (let [{:keys [start duration value]} (first time-objects) + rem (rest time-objects)] + (if (seq rem) + (recur rem (imap/mark m start (+ start duration) value)) + m))) + m))) -;; TODO: Don't forget to ensure that ranges are turned into signals -;; (comment - (def cancel - ((m/reduce prn nil - (timeline - (merge-tocs - (time-object-collection - (time-object (m/ap [1 2]) :a (m/ap)) - (time-object (m/ap [3 4]) :b (m/ap)) - (time-object (m/ap [5 6]) :c (m/ap))) - (time-object-collection - (time-object (m/ap [1 2]) :d (m/ap)) - (time-object (m/ap [3 4]) :e (m/ap)) - (time-object (m/ap [5 6]) :f (m/ap)))))) prn prn)) - - ;; NOTE: Cancellation is currently broken due to the above bug in merge-tocs - (cancel)) + (def t (timeline (c 0))) + (get t 2)) (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]) + [timeline >at] + (m/ap (let [at (m/?< >at)] (get timeline at)))) -(defn run - "Runs the flows associated with a collection of time objects." - [>query-result]) +(comment + (def at (atom 0)) + (def >at (m/watch at)) + (def cancel ((m/reduce prn nil (point-query t >at)) prn prn)) + (reset! at 0) + (cancel)) |