1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
|
(ns unheard.time-object
(: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))
(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))
(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))
(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)))))))
;; 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))
(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."
[>query-result])
|
