summaryrefslogtreecommitdiff
path: root/src/unheard/theory.clj
blob: 30977a93ed9d024a8b59b7e9fdeb773cf29636ee (plain)
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
(ns unheard.theory
  (:require [missionary.core :as m]
            [unheard.time-object :refer
             [time-object lift phrase timeline point-query]]
            [unheard.util.missionary :refer [reconcile-merge]]))

(defn note
  [>clock start duration >value]
  (lift (time-object
          start
          duration
          (m/stream (m/ap (let [[c v] (m/?> (m/relieve
                                              (m/latest vector >clock >value)))]
                            v))))))

;; BUG: 2d7f861
(defn read
  [>clock timeline]
  (m/relieve (m/reductions
               {}
               nil
               (m/eduction
                 (map vals)
                 (m/reductions
                   (fn [acc {:keys [id state value]}]
                     (if (= :up state) (assoc acc id value) (dissoc acc id)))
                   {}
                   (reconcile-merge (point-query timeline >clock)))))))

(comment
  (def c (atom 0))
  (def >c (m/signal (m/watch c)))
  (def v (atom 0))
  (def >v (m/signal (m/watch v)))
  (def song (phrase (note >c 4 8 >v) (note >c 6 6 >v)))
  (def t (timeline song))
  (def cancel ((m/reduce prn nil (read >c t)) prn prn))
  (cancel)
  (swap! c dec)
  (swap! c inc)
  (swap! v inc)
  (swap! v dec))