summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/unheard/cycles.clj224
-rw-r--r--src/unheard/dsl.clj52
-rw-r--r--src/unheard/instrument/minilab3.clj48
-rw-r--r--src/unheard/instrument/omx_27.clj11
-rw-r--r--src/unheard/interval.clj17
-rw-r--r--src/unheard/midi_test.clj67
-rw-r--r--src/unheard/strudel/mini_notation_compiler.clj135
-rw-r--r--src/unheard/theory.clj33
-rw-r--r--src/unheard/time_object.clj14
-rw-r--r--src/unheard/time_object_test.clj33
10 files changed, 263 insertions, 371 deletions
diff --git a/src/unheard/cycles.clj b/src/unheard/cycles.clj
index a067142..b73b64a 100644
--- a/src/unheard/cycles.clj
+++ b/src/unheard/cycles.clj
@@ -40,7 +40,7 @@
(l :a :b :c) with cycle-length 1
=> [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]]"
[& args]
- {:v (vec args) :type :l})
+ {:v (vec args), :type :l})
(defn f
"Fork combinator: cycles through children sequentially across iterations.
@@ -55,7 +55,7 @@
(f :a :b :c) with cycle-length 1
=> [[0 1 :a] [1 2 :b] [2 3 :c]]"
[& args]
- {:v (vec args) :type :f})
+ {:v (vec args), :type :f})
(defn p
"Parallel combinator: all children occur simultaneously.
@@ -69,7 +69,7 @@
(p :a :b :c) with cycle-length 1
=> [[0 1 :a] [0 1 :b] [0 1 :c]]"
[& args]
- {:v (vec args) :type :p})
+ {:v (vec args), :type :p})
(defn rate
"Rate modifier: scales the speed of a pattern by a given ratio.
@@ -85,7 +85,7 @@
(rate 2 (l :a :b)) - runs the list twice as fast
(rate 1/2 (f :a :b :c)) - runs the fork at half speed"
[ratio node]
- {:v node :rate ratio :type :rate})
+ {:v node, :rate ratio, :type :rate})
(defn elongate
"Elongation modifier: gives an element temporal weight.
@@ -100,7 +100,7 @@
(l (elongate 2 :a) :b :c) - :a takes twice as long as :b or :c
(l :x (elongate 3 :y) :z) - :y takes 3x as long as :x or :z"
[weight node]
- {:v node :weight weight :type :elongate})
+ {:v node, :weight weight, :type :elongate})
(defn rep
"Replication modifier: repeats an element N times, subdividing its time equally.
@@ -115,10 +115,9 @@
(l (rep 3 :a) :b) - :a repeats 3x in first half, :b in second half
(l :x (rep 2 :y) :z) - :y repeats 2x in middle third"
[times node]
- {:v node :times times :type :rep})
+ {:v node, :times times, :type :rep})
-(defn scalar? [x]
- (not (and (map? x) (:type x))))
+(defn scalar? [x] (not (and (map? x) (:type x))))
(defn paste
"Paste operator: replaces scalar values in a template pattern with provided values.
@@ -146,10 +145,9 @@
(if (scalar? node)
(let [replacement (first @values-seq)]
(swap! values-seq rest)
- (if (nil? replacement)
- node
- replacement))
- ;; Non-scalar: check if :v is a vector (l, f, p) or single value (rate, elongate, rep)
+ (if (nil? replacement) node replacement))
+ ;; Non-scalar: check if :v is a vector (l, f, p) or single
+ ;; value (rate, elongate, rep)
(let [v (:v node)]
(if (vector? v)
;; Combinators with multiple children
@@ -162,118 +160,106 @@
"Returns the weight of a node. Elongated nodes have their specified weight,
all other nodes have a default weight of 1."
[node]
- (if (and (map? node) (= :elongate (:type node)))
- (:weight node)
- 1))
+ (if (and (map? node) (= :elongate (:type node))) (:weight node) 1))
-(defn gcd [a b]
- (if (zero? b) a (recur b (mod a b))))
+(defn gcd [a b] (if (zero? b) a (recur b (mod a b))))
-(defn lcm [a b]
- (/ (* a b) (gcd a b)))
+(defn lcm [a b] (/ (* a b) (gcd a b)))
-(defn compute-cycle [node]
- (cond
- (scalar? node) 1
-
- (= :f (:type node))
- (let [children (:v node)
- n (count children)]
- (* n (reduce lcm 1 (map compute-cycle children))))
-
- (= :l (:type node))
- (let [children (:v node)]
- (reduce lcm 1 (map compute-cycle children)))
-
- (= :p (:type node))
- (let [children (:v node)]
- (reduce lcm 1 (map compute-cycle children)))
-
- (= :rate (:type node))
- ;; Rate doesn't change the cycle count - it just compresses/expands time
- ;; The parent sees the same cycle count as the child
- (compute-cycle (:v node))
-
- (= :elongate (:type node))
- ;; Elongation doesn't change the cycle count - it just affects time division
- ;; The parent sees the same cycle count as the child
- (compute-cycle (:v node))
-
- (= :rep (:type node))
- ;; Replication doesn't change the cycle count - it just subdivides time
- ;; The parent sees the same cycle count as the child
- (compute-cycle (:v node))
-
- :else
- (throw (ex-info "Unknown node type in compute-cycle"
- {:node node :type (:type node)}))))
-
-(defn unfold-node [node start end iteration]
+(defn compute-cycle
+ [node]
+ (cond (scalar? node) 1
+ (= :f (:type node)) (let [children (:v node)
+ n (count children)]
+ (* n (reduce lcm 1 (map compute-cycle children))))
+ (= :l (:type node)) (let [children (:v node)]
+ (reduce lcm 1 (map compute-cycle children)))
+ (= :p (:type node)) (let [children (:v node)]
+ (reduce lcm 1 (map compute-cycle children)))
+ (= :rate (:type node))
+ ;; Rate doesn't change the cycle count - it just
+ ;; compresses/expands time. The parent sees the same cycle count
+ ;; as the child
+ (compute-cycle (:v node))
+ (= :elongate (:type node))
+ ;; Elongation doesn't change the cycle count - it just affects
+ ;; time division. The parent sees the same cycle count as the
+ ;; child
+ (compute-cycle (:v node))
+ (= :rep (:type node))
+ ;; Replication doesn't change the cycle count - it just
+ ;; subdivides time. The parent sees the same cycle count as the
+ ;; child
+ (compute-cycle (:v node))
+ :else (throw (ex-info "Unknown node type in compute-cycle"
+ {:node node, :type (:type node)}))))
+
+(defn unfold-node
+ [node start end iteration]
(let [duration (- end start)]
- (cond
- (scalar? node)
- [[start end node]]
-
- (= :l (:type node))
- (let [children (:v node)
- weights (map get-weight children)
- total-weight (reduce + weights)
- weight-offsets (reductions + 0 weights)]
- (mapcat (fn [i child weight]
- (let [child-start (+ start (* duration (/ (nth weight-offsets i) total-weight)))
- child-end (+ start (* duration (/ (nth weight-offsets (inc i)) total-weight)))]
- (unfold-node child child-start child-end iteration)))
+ (cond (scalar? node) [[start end node]]
+ (= :l (:type node))
+ (let [children (:v node)
+ weights (map get-weight children)
+ total-weight (reduce + weights)
+ weight-offsets (reductions + 0 weights)]
+ (mapcat (fn [i child weight]
+ (let [child-start (+ start
+ (* duration
+ (/ (nth weight-offsets i)
+ total-weight)))
+ child-end (+ start
+ (* duration
+ (/ (nth weight-offsets (inc i))
+ total-weight)))]
+ (unfold-node child child-start child-end iteration)))
(range (count children))
children
weights))
-
- (= :f (:type node))
- (let [children (:v node)
- n (count children)
- child-idx (mod iteration n)]
- (unfold-node (nth children child-idx) start end (quot iteration n)))
-
- (= :p (:type node))
- (let [children (:v node)]
- (mapcat (fn [child]
- (unfold-node child start end iteration))
+ (= :f (:type node)) (let [children (:v node)
+ n (count children)
+ child-idx (mod iteration n)]
+ (unfold-node (nth children child-idx)
+ start
+ end
+ (quot iteration n)))
+ (= :p (:type node))
+ (let [children (:v node)]
+ (mapcat (fn [child] (unfold-node child start end iteration))
children))
-
- (= :rate (:type node))
- (let [ratio (:rate node)
- child (:v node)
- child-base-cycle (compute-cycle child)
- ;; rate scales how many times the base pattern repeats
- ;; rate 2 means fit 2x cycles in this span
- ;; rate 1/2 means fit 0.5x cycles (half a cycle)
- num-child-cycles (* ratio child-base-cycle)
- child-cycle-duration (/ duration num-child-cycles)]
- (mapcat (fn [i]
- (unfold-node child
- (+ start (* i child-cycle-duration))
- (+ start (* (inc i) child-cycle-duration))
- i))
+ (= :rate (:type node))
+ (let [ratio (:rate node)
+ child (:v node)
+ child-base-cycle (compute-cycle child)
+ ;; rate scales how many times the base pattern repeats
+ ;; rate 2 means fit 2x cycles in this span
+ ;; rate 1/2 means fit 0.5x cycles (half a cycle)
+ num-child-cycles (* ratio child-base-cycle)
+ child-cycle-duration (/ duration num-child-cycles)]
+ (mapcat (fn [i]
+ (unfold-node child
+ (+ start (* i child-cycle-duration))
+ (+ start (* (inc i) child-cycle-duration))
+ i))
(range num-child-cycles)))
-
- (= :elongate (:type node))
- ;; Elongate just wraps a child - unfold the child with the same time bounds
- (unfold-node (:v node) start end iteration)
-
- (= :rep (:type node))
- ;; Rep subdivides the time span into N equal parts and repeats the child
- (let [times (:times node)
- child (:v node)
- slice-duration (/ duration times)]
- (mapcat (fn [i]
- (unfold-node child
- (+ start (* i slice-duration))
- (+ start (* (inc i) slice-duration))
- iteration))
+ (= :elongate (:type node))
+ ;; Elongate just wraps a child - unfold the child with the same
+ ;; time bounds
+ (unfold-node (:v node) start end iteration)
+ (= :rep (:type node))
+ ;; Rep subdivides the time span into N equal parts and repeats
+ ;; the child
+ (let [times (:times node)
+ child (:v node)
+ slice-duration (/ duration times)]
+ (mapcat (fn [i]
+ (unfold-node child
+ (+ start (* i slice-duration))
+ (+ start (* (inc i) slice-duration))
+ iteration))
(range times)))
-
- :else
- (throw (ex-info "Unknown node type in unfold-node"
- {:node node :type (:type node)})))))
+ :else (throw (ex-info "Unknown node type in unfold-node"
+ {:node node, :type (:type node)})))))
(defn unfold
"Unfolds a pattern tree into concrete time intervals.
@@ -303,10 +289,8 @@
=> [[0 1 :a] [1 2 :b]]"
[cycle-length node]
(let [cycle-count (compute-cycle node)]
- (vec (mapcat (fn [i]
- (unfold-node node
- (* i cycle-length)
- (* (inc i) cycle-length)
- i))
- (range cycle-count)))))
+ (vec (mapcat
+ (fn [i]
+ (unfold-node node (* i cycle-length) (* (inc i) cycle-length) i))
+ (range cycle-count)))))
diff --git a/src/unheard/dsl.clj b/src/unheard/dsl.clj
index e111725..d2bb286 100644
--- a/src/unheard/dsl.clj
+++ b/src/unheard/dsl.clj
@@ -3,59 +3,33 @@
[clojure.set :refer [union]]))
(comment
- ;; Parallel groups
- ;; Notes 1, 2, and 3 simultaneously
- ;; = should remind you of amb=
- ;; implicit duration of 1
+ ;; Parallel groups. Notes 1, 2, and 3 simultaneously = should remind you
+ ;; of amb= implicit duration of 1
[= 1 2 3]
- ;; Compiles to?
-
- ;; Same as above, but with duration 3
+ ;; Compiles to? Same as above, but with duration 3
([= 1 2 3] 3)
-
;; Notes 1, 2, and 3 all with different durations
- [=
- (1 2)
- (2 3)
- (3 4)]
-
- ;; Inner values override outer values
- ;; In this chord, 1 would have a duration of 3 while 2 and 3 would have a duration of 2
+ [= (1 2) (2 3) (3 4)]
+ ;; Inner values override outer values. In this chord, 1 would have a
+ ;; duration of 3 while 2 and 3 would have a duration of 2
([= (1 3) 2 3] 2)
-
;; Notes 1, 2, and 3 all with different durations and velocities
- [=
- (1 2 100)
- (2 3 110)
- (3 4 123)]
-
- ;; Sequential groups
- ;; Note 1, then note 2, then note 3
+ [= (1 2 100) (2 3 110) (3 4 123)]
+ ;; Sequential groups. Note 1, then note 2, then note 3
[1 2 3]
-
;; Note 1 duration 1, then note 2 duration 2, then note 3 duration 1
- [(1 1)
- (2 2)
- (3 1)]
-
+ [(1 1) (2 2) (3 1)]
;; Three chords played sequentially
- [[= 1 2 3]
- [= 1 2 3]
- [= 1 2 3]]
-
-;; Note 1, followed by a rest, followed by note 3
+ [[= 1 2 3] [= 1 2 3] [= 1 2 3]]
+ ;; Note 1, followed by a rest, followed by note 3
[1 (r) 3]
-
;; Unlike notes, rests are at most 2-tuples
;; (Think about it: Rests never have a note value)
-
- ;; Assign the note sequence 1 2 3 to the name loop1
- ;; The first argument is always the name; the last argument is always either
+ ;; Assign the note sequence 1 2 3 to the name loop1. The first argument
+ ;; is always the name; the last argument is always either
;; a sequential or parallel group
(=loop1 [1 2 3])
-
;; Use loop1
[1 (loop1) 2 3]
-
;; Middle arguments are variable names
(=loop2 dur ([1 2 3] dur)))
diff --git a/src/unheard/instrument/minilab3.clj b/src/unheard/instrument/minilab3.clj
index 65ca2ae..de78f22 100644
--- a/src/unheard/instrument/minilab3.clj
+++ b/src/unheard/instrument/minilab3.clj
@@ -1,31 +1,27 @@
(ns unheard.instrument.minilab3
(:require [unheard.instrument.util :refer [matching-control]]))
-(def device-name
- "CoreMIDI4J - Minilab3 MIDI")
+(def device-name "CoreMIDI4J - Minilab3 MIDI")
(def config
- {:knob
- {1 (matching-control 0 0 74)
- 2 (matching-control 0 0 71)
- 3 (matching-control 0 0 76)
- 4 (matching-control 0 0 77)
- 5 (matching-control 0 0 93)
- 6 (matching-control 0 0 18)
- 7 (matching-control 0 0 19)
- 8 (matching-control 0 0 16)}
- :fader
- {1 (matching-control 0 0 82)
- 2 (matching-control 0 0 83)
- 3 (matching-control 0 0 85)
- 4 (matching-control 0 0 17)}
- ;; TODO: git-bug fdf0f83
- :pad
- {1 (matching-control 0 9 36)
- 2 (matching-control 0 9 37)
- 3 (matching-control 0 9 38)
- 4 (matching-control 0 9 39)
- 5 (matching-control 0 9 40)
- 6 (matching-control 0 9 41)
- 7 (matching-control 0 9 42)
- 8 (matching-control 0 9 43)}})
+ {:knob {1 (matching-control 0 0 74),
+ 2 (matching-control 0 0 71),
+ 3 (matching-control 0 0 76),
+ 4 (matching-control 0 0 77),
+ 5 (matching-control 0 0 93),
+ 6 (matching-control 0 0 18),
+ 7 (matching-control 0 0 19),
+ 8 (matching-control 0 0 16)},
+ :fader {1 (matching-control 0 0 82),
+ 2 (matching-control 0 0 83),
+ 3 (matching-control 0 0 85),
+ 4 (matching-control 0 0 17)},
+ ;; TODO: git-bug fdf0f83
+ :pad {1 (matching-control 0 9 36),
+ 2 (matching-control 0 9 37),
+ 3 (matching-control 0 9 38),
+ 4 (matching-control 0 9 39),
+ 5 (matching-control 0 9 40),
+ 6 (matching-control 0 9 41),
+ 7 (matching-control 0 9 42),
+ 8 (matching-control 0 9 43)}})
diff --git a/src/unheard/instrument/omx_27.clj b/src/unheard/instrument/omx_27.clj
index ab3f28d..35f0ff8 100644
--- a/src/unheard/instrument/omx_27.clj
+++ b/src/unheard/instrument/omx_27.clj
@@ -4,9 +4,8 @@
(def device-name "CoreMIDI4J - omx-27")
(def config
- {:knob
- {1 (matching-control 0 0 21)
- 2 (matching-control 0 0 22)
- 3 (matching-control 0 0 23)
- 4 (matching-control 0 0 24)
- 5 (matching-control 0 0 61)}})
+ {:knob {1 (matching-control 0 0 21),
+ 2 (matching-control 0 0 22),
+ 3 (matching-control 0 0 23),
+ 4 (matching-control 0 0 24),
+ 5 (matching-control 0 0 61)}})
diff --git a/src/unheard/interval.clj b/src/unheard/interval.clj
index c10161c..bd14c0d 100644
--- a/src/unheard/interval.clj
+++ b/src/unheard/interval.clj
@@ -5,16 +5,13 @@
(deftype RatioValueInterval [start end value]
IInterval
- ;; HACK: coerce start to long to work around
- ;; class clojure.lang.BigInt cannot be cast to class java.lang.Comparable
- (getNormStart [_] (if (instance? clojure.lang.BigInt start)
- (long start)
- start))
- ;; HACK: coerce start to long to work around
- ;; class clojure.lang.BigInt cannot be cast to class java.lang.Comparable
- (getNormEnd [_] (if (instance? clojure.lang.BigInt end)
- (long end)
- end))
+ ;; HACK: coerce start to long to work around class clojure.lang.BigInt
+ ;; cannot be cast to class java.lang.Comparable
+ (getNormStart [_]
+ (if (instance? clojure.lang.BigInt start) (long start) start))
+ ;; HACK: coerce start to long to work around class clojure.lang.BigInt
+ ;; cannot be cast to class java.lang.Comparable
+ (getNormEnd [_] (if (instance? clojure.lang.BigInt end) (long end) end))
(getUniqueIdentifier [_] (str "[" start "," end "]"))
(compareTo [_ other]
(let [start-cmp (compare start (.getNormStart ^RatioValueInterval other))]
diff --git a/src/unheard/midi_test.clj b/src/unheard/midi_test.clj
index bcfde3c..790cf69 100644
--- a/src/unheard/midi_test.clj
+++ b/src/unheard/midi_test.clj
@@ -3,50 +3,27 @@
[hyperfiddle.rcf :refer [tests]])
(:import [javax.sound.midi ShortMessage]))
-(defn short-message [cmd ch d1 d2]
- (ShortMessage. cmd ch d1 d2))
+(defn short-message [cmd ch d1 d2] (ShortMessage. cmd ch d1 d2))
(tests "short-message->notes"
- (let [msgs
- [(short-message ShortMessage/NOTE_ON 0 1 100)
- ;; Irrelevant messages don't appear
- (short-message ShortMessage/CONTROL_CHANGE 0 1 100)
- (short-message ShortMessage/NOTE_ON 0 2 100)
- ;; Notes are removed
- (short-message ShortMessage/NOTE_OFF 0 2 100)
- (short-message ShortMessage/NOTE_OFF 0 1 100)
- (short-message ShortMessage/NOTE_ON 0 3 100)
- (short-message ShortMessage/NOTE_ON 0 4 100)
- ;; Specifying channel works
- (short-message ShortMessage/NOTE_ON 1 1 100)
- (short-message ShortMessage/NOTE_ON 1 2 100)
- ;; All notes off works
- (short-message ShortMessage/CONTROL_CHANGE 0 123 0)
- (short-message ShortMessage/CONTROL_CHANGE 1 123 0)]]
-
- (into []
- (transduce
- sut/short-message->notes
- conj
- []
- msgs))
- := [{0 {1 100}}
- {0 {1 100
- 2 100}}
- {0 {1 100}}
- {0 {}}
- {0 {3 100}}
- {0 {3 100
- 4 100}}
- {0 {3 100
- 4 100}
- 1 {1 100}}
- {0 {3 100
- 4 100}
- 1 {1 100
- 2 100}}
- {0 {}
- 1 {1 100
- 2 100}}
- {0 {}
- 1 {}}]))
+ (let [msgs [(short-message ShortMessage/NOTE_ON 0 1 100)
+ ;; Irrelevant messages don't appear
+ (short-message ShortMessage/CONTROL_CHANGE 0 1 100)
+ (short-message ShortMessage/NOTE_ON 0 2 100)
+ ;; Notes are removed
+ (short-message ShortMessage/NOTE_OFF 0 2 100)
+ (short-message ShortMessage/NOTE_OFF 0 1 100)
+ (short-message ShortMessage/NOTE_ON 0 3 100)
+ (short-message ShortMessage/NOTE_ON 0 4 100)
+ ;; Specifying channel works
+ (short-message ShortMessage/NOTE_ON 1 1 100)
+ (short-message ShortMessage/NOTE_ON 1 2 100)
+ ;; All notes off works
+ (short-message ShortMessage/CONTROL_CHANGE 0 123 0)
+ (short-message ShortMessage/CONTROL_CHANGE 1 123 0)]]
+ (into [] (transduce sut/short-message->notes conj [] msgs))
+ :=
+ [{0 {1 100}} {0 {1 100, 2 100}} {0 {1 100}} {0 {}} {0 {3 100}}
+ {0 {3 100, 4 100}} {0 {3 100, 4 100}, 1 {1 100}}
+ {0 {3 100, 4 100}, 1 {1 100, 2 100}} {0 {}, 1 {1 100, 2 100}}
+ {0 {}, 1 {}}]))
diff --git a/src/unheard/strudel/mini_notation_compiler.clj b/src/unheard/strudel/mini_notation_compiler.clj
index 6f469bb..36b2507 100644
--- a/src/unheard/strudel/mini_notation_compiler.clj
+++ b/src/unheard/strudel/mini_notation_compiler.clj
@@ -64,7 +64,8 @@
sym (symbol "unheard.midi.notes" normalized)]
sym))
-(defn- parse-number [s]
+(defn- parse-number
+ [s]
"Parse a number, returning either a long or ratio."
(if (str/includes? s "/")
(let [[num denom] (str/split s #"/")]
@@ -74,15 +75,16 @@
(declare parse-sequence)
(declare parse-element)
-(defn- parse-atom [s get-value]
+(defn- parse-atom
+ [s get-value]
"Parse a single atom (note, number, or rest).
Uses get-value function to convert note names to values."
- (cond
- (= s "~") :r
- (re-matches #"\d+(/\d+)?" s) (parse-number s)
- :else (get-value s)))
+ (cond (= s "~") :r
+ (re-matches #"\d+(/\d+)?" s) (parse-number s)
+ :else (get-value s)))
-(defn- apply-modifiers [expr modifiers]
+(defn- apply-modifiers
+ [expr modifiers]
"Apply modifiers to an expression.
Modifiers is a map with keys: :rate, :elongate, :rep
Order: elongate/rep first (innermost), then rate (outermost)"
@@ -91,33 +93,34 @@
(:rep modifiers) (#(list 'rep (:rep modifiers) %))
(:rate modifiers) (#(list 'rate (:rate modifiers) %))))
-(defn- parse-token-with-modifiers [token]
+(defn- parse-token-with-modifiers
+ [token]
"Parse a token that may have modifiers like *2, /3, @2, !3"
- (let [;; Extract modifiers (note: /N is division, not a rational number in this context)
+ (let [;; Extract modifiers (note: /N is division, not a rational number
+ ;; in this context)
;; Check for *N/M first (multiplication with rational)
rate-match (re-find #"\*(\d+(?:/\d+)?)" token)
- ;; Only match /N if it's NOT part of *N/M (no preceding * and digits)
- div-match (when-not rate-match
- (re-find #"/(\d+)" token))
+ ;; Only match /N if it's NOT part of *N/M (no preceding * and
+ ;; digits)
+ div-match (when-not rate-match (re-find #"/(\d+)" token))
elong-match (re-find #"@(\d+(?:/\d+)?)" token)
rep-match (re-find #"!(\d+)" token)
-
;; Remove modifiers to get base token
base (-> token
(str/replace #"\*\d+(?:/\d+)?" "")
(str/replace #"/\d+" "")
(str/replace #"@\d+(?:/\d+)?" "")
(str/replace #"!\d+" ""))
-
- modifiers (cond-> {}
- rate-match (assoc :rate (parse-number (second rate-match)))
- div-match (assoc :rate (list '/ 1 (parse-long (second div-match))))
- elong-match (assoc :elongate (parse-number (second elong-match)))
- rep-match (assoc :rep (parse-long (second rep-match))))]
-
+ modifiers
+ (cond-> {}
+ rate-match (assoc :rate (parse-number (second rate-match)))
+ div-match (assoc :rate (list '/ 1 (parse-long (second div-match))))
+ elong-match (assoc :elongate (parse-number (second elong-match)))
+ rep-match (assoc :rep (parse-long (second rep-match))))]
[base modifiers]))
-(defn- split-on-comma [s]
+(defn- split-on-comma
+ [s]
"Split string on commas at depth 0 (not inside nested brackets).
Returns vector of substrings."
(loop [chars (seq s)
@@ -130,21 +133,18 @@
(cond
;; Track bracket depth
(or (= c \[) (= c \<) (= c \())
- (recur (rest chars) groups (conj current c) (inc depth))
-
+ (recur (rest chars) groups (conj current c) (inc depth))
(or (= c \]) (= c \>) (= c \)))
- (recur (rest chars) groups (conj current c) (dec depth))
-
+ (recur (rest chars) groups (conj current c) (dec depth))
;; Comma at depth 0 - split here
(and (= c \,) (zero? depth))
- (if (seq current)
- (recur (rest chars) (conj groups (str/join current)) [] depth)
- (recur (rest chars) groups [] depth))
-
- :else
- (recur (rest chars) groups (conj current c) depth))))))
+ (if (seq current)
+ (recur (rest chars) (conj groups (str/join current)) [] depth)
+ (recur (rest chars) groups [] depth))
+ :else (recur (rest chars) groups (conj current c) depth))))))
-(defn- parse-group [s open-char close-char combinator get-value]
+(defn- parse-group
+ [s open-char close-char combinator get-value]
"Parse a bracketed group with a specific combinator."
;; Find the matching closing bracket, then extract modifiers after it
(let [close-idx (.lastIndexOf s (int close-char))
@@ -154,20 +154,19 @@
[_ modifiers] (parse-token-with-modifiers modifiers-part)
;; Extract content between brackets
inner-content (subs brackets-part 1 close-idx)
-
;; Special handling for angle brackets with commas (polymeter)
result (if (and (= combinator 'f) (str/includes? inner-content ","))
- ;; Split on commas and parse each group
- ;; Create parallel composition of forked groups
+ ;; Split on commas and parse each group. Create parallel
+ ;; composition of forked groups
(let [groups (split-on-comma inner-content)
parsed-groups (map #(parse-sequence % get-value) groups)
;; Wrap each group in fork (unless single element)
forked-groups (map (fn [group]
- (let [elements (vec group)]
- (if (= 1 (count elements))
- (first elements)
- (cons 'f elements))))
- parsed-groups)]
+ (let [elements (vec group)]
+ (if (= 1 (count elements))
+ (first elements)
+ (cons 'f elements))))
+ parsed-groups)]
(if (= 1 (count forked-groups))
(first forked-groups)
(cons 'p forked-groups)))
@@ -178,35 +177,31 @@
(cons combinator elements))))]
(apply-modifiers result modifiers)))
-(defn- tokenize [s]
+(defn- tokenize
+ [s]
"Tokenize a mini-notation string, respecting nested brackets."
(loop [chars (seq s)
tokens []
current []
depth 0]
(if (empty? chars)
- (if (seq current)
- (conj tokens (str/join current))
- tokens)
+ (if (seq current) (conj tokens (str/join current)) tokens)
(let [c (first chars)]
(cond
;; Track bracket depth
(or (= c \[) (= c \<) (= c \())
- (recur (rest chars) tokens (conj current c) (inc depth))
-
+ (recur (rest chars) tokens (conj current c) (inc depth))
(or (= c \]) (= c \>) (= c \)))
- (recur (rest chars) tokens (conj current c) (dec depth))
-
+ (recur (rest chars) tokens (conj current c) (dec depth))
;; Space separates tokens only at depth 0
(and (= c \space) (zero? depth))
- (if (seq current)
- (recur (rest chars) (conj tokens (str/join current)) [] depth)
- (recur (rest chars) tokens [] depth))
+ (if (seq current)
+ (recur (rest chars) (conj tokens (str/join current)) [] depth)
+ (recur (rest chars) tokens [] depth))
+ :else (recur (rest chars) tokens (conj current c) depth))))))
- :else
- (recur (rest chars) tokens (conj current c) depth))))))
-
-(defn- parse-parallel [token get-value]
+(defn- parse-parallel
+ [token get-value]
"Parse comma-separated elements into parallel structure."
(if (str/includes? token ",")
(let [parts (str/split token #",")
@@ -214,32 +209,26 @@
(cons 'p elements))
(parse-element token get-value)))
-(defn- parse-element [token get-value]
+(defn- parse-element
+ [token get-value]
"Parse a single element (may be atom, group, or have modifiers)."
(cond
;; Square brackets - subdivision (l)
;; Check if starts with [ (may have modifiers at end)
- (str/starts-with? token "[")
- (parse-group token \[ \] 'l get-value)
-
+ (str/starts-with? token "[") (parse-group token \[ \] 'l get-value)
;; Angle brackets - alternation (f)
;; Check if starts with < (may have modifiers at end)
- (str/starts-with? token "<")
- (parse-group token \< \> 'f get-value)
-
+ (str/starts-with? token "<") (parse-group token \< \> 'f get-value)
;; Contains comma - parallel (p)
- (str/includes? token ",")
- (parse-parallel token get-value)
-
+ (str/includes? token ",") (parse-parallel token get-value)
;; Token with modifiers
- :else
- (let [[base modifiers] (parse-token-with-modifiers token)]
- (apply-modifiers (parse-atom base get-value) modifiers))))
+ :else (let [[base modifiers] (parse-token-with-modifiers token)]
+ (apply-modifiers (parse-atom base get-value) modifiers))))
-(defn- parse-sequence [s get-value]
+(defn- parse-sequence
+ [s get-value]
"Parse a space-separated sequence."
- (let [tokens (tokenize s)]
- (map #(parse-element % get-value) tokens)))
+ (let [tokens (tokenize s)] (map #(parse-element % get-value) tokens)))
(defn compile
"Compile a Strudel mini-notation string to unheard.cycles code.
@@ -284,6 +273,4 @@
([s get-value]
(let [normalized (str/replace s #"\n" " ")
elements (parse-sequence (str/trim normalized) get-value)]
- (if (= 1 (count elements))
- (first elements)
- (cons 'l elements)))))
+ (if (= 1 (count elements)) (first elements) (cons 'l elements)))))
diff --git a/src/unheard/theory.clj b/src/unheard/theory.clj
index 5314ea7..30977a9 100644
--- a/src/unheard/theory.clj
+++ b/src/unheard/theory.clj
@@ -6,27 +6,26 @@
(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))))))
+ (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)))))))
+ (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))
diff --git a/src/unheard/time_object.clj b/src/unheard/time_object.clj
index 8d07361..5b71e0a 100644
--- a/src/unheard/time_object.clj
+++ b/src/unheard/time_object.clj
@@ -37,10 +37,11 @@
(def c (phrase (b 0) (b 3)))
(c 0))
-(defn phrase->spans [phrase]
+(defn phrase->spans
+ [phrase]
(let [{:keys [time-objects]} (phrase 0)]
(map (fn [{:keys [start duration value]}] [start (+ start duration) value])
- time-objects)))
+ time-objects)))
(comment
(phrase->spans c))
@@ -49,9 +50,8 @@
"Primary timeline bookkeeping mehanism."
[spans]
(let [c (i/create-ratio-interval-collection)]
- (doall
- (for [[start end value] spans]
- (.add c (i/ratio-interval start end value))))
+ (doall (for [[start end value] spans]
+ (.add c (i/ratio-interval start end value))))
c))
(comment
@@ -65,8 +65,8 @@
(m/stream (m/ap (let [at (m/?< >at)]
(into #{}
(map #(.value %)
- (i/find-overlaps timeline
- (i/ratio-interval at at nil))))))))
+ (i/find-overlaps timeline
+ (i/ratio-interval at at nil))))))))
(comment
(def at (atom 0))
diff --git a/src/unheard/time_object_test.clj b/src/unheard/time_object_test.clj
index 07e49c3..13d9c91 100644
--- a/src/unheard/time_object_test.clj
+++ b/src/unheard/time_object_test.clj
@@ -11,59 +11,38 @@
>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)
-
- ))
+ #_#_#_#_#_#_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)))
generated by cgit v1.2.3 (git 2.25.1) at 2025-12-10 04:26:29 +0000