diff options
| -rw-r--r-- | DEVLOG.md | 676 | ||||
| -rw-r--r-- | flake.nix | 1 | ||||
| -rw-r--r-- | portal.clj | 65 | ||||
| -rw-r--r-- | src/unheard/clock.clj | 104 | ||||
| -rw-r--r-- | src/unheard/cycles.clj | 224 | ||||
| -rw-r--r-- | src/unheard/dsl.clj | 52 | ||||
| -rw-r--r-- | src/unheard/instrument/minilab3.clj | 48 | ||||
| -rw-r--r-- | src/unheard/instrument/omx_27.clj | 11 | ||||
| -rw-r--r-- | src/unheard/interval.clj | 17 | ||||
| -rw-r--r-- | src/unheard/midi.clj | 12 | ||||
| -rw-r--r-- | src/unheard/midi_test.clj | 67 | ||||
| -rw-r--r-- | src/unheard/strudel/mini_notation_compiler.clj | 135 | ||||
| -rw-r--r-- | src/unheard/theory.clj | 33 | ||||
| -rw-r--r-- | src/unheard/time_object.clj | 14 | ||||
| -rw-r--r-- | src/unheard/time_object_test.clj | 33 | ||||
| -rw-r--r-- | test/unheard/cycles_test.clj | 238 | ||||
| -rw-r--r-- | test/unheard/strudel/mini_notation_compiler_test.clj | 135 |
17 files changed, 1114 insertions, 751 deletions
@@ -931,3 +931,679 @@ TODO upcoming: - Inspired by strudel, define a language of musical modifiers - Read notes of Nov. 28 + +## December 3rd, 2025 + +Unheard made sound for the first time yesterday! Very exciting. + +Some ideas from yesterday that I want to carry forward: + +1. Create a function that takes channel, etc., and returns a note flow. +2. Play with using dynamic variables? For... idk. + +WHOA! Strudel keeps blowing my mind. +I just discovered that anything can take a pattern, e.g. scales: https://strudel.cc/workshop/first-notes/#scales +WTF, so cool! This has broken my brain. + +Trying to unpack this. +I guess this is how I'd think about this: each pattern describes +values. (This is the hole in the mini-notation pattern.) Each pattern +is associated with an _attribute type_: One might be pitch, +another instrument. The attribute patterns are all merged together +as if by parallel composition. In my DSL, I would think about the +value of each attribute being a tuple of e.g. [:pitch :e4] or +[:instrument :piano]. + +What does this mean for me? + +One takeaway (I think) is that a composition has multiple instrument-like +things, and that each instrument-like thing is a union of these +various patterened attributes. At the top level, all of these unions play +together via parallel composition. + +What would it mean for me to completely invert my playback model, +where each instrument is a flow rather than each note? I don't think +this is quite right, though. + +In particular, I'm not sure how to merge this idea into my functional composition +model. + +But there is definitely something cool here: the attributes of +an instrument are the timewise union of all patterns. + +Like, what if a rhythmic flow took as its input flows of other associated +properties. (But what is a rhythmic flow? That idea doesn't exist yet.) + +Need to keep thinking about this + +I'm looking at this version of compiled-tetris: + +```clojure +(defn n [>ch >val >vel] + (let [[ch val vel] (m/?< (m/latest vector >ch >val >vel))] + {ch {val :on}}))) + +(def compiled-tetris + (p + (let [n (fn [val] (n (m/ap 0) (m/ap val) (m/ap 100)))] + (f (l (n e5) (l (n b4) (n c5)) (n d5) (l (n c5) (n b4))) + (l (n a4) (l (n a4) (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l r (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r) + (l (l r (n d5)) (l r (n f5)) (n a5) (l (n g5) (n f5))) + (l (n e5) (l r (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l (n b4) (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r))) + + (let [n (fn [val] (n (m/ap 1) (m/ap val) (m/ap 100)))] + (f (rate 4 (l (n e2) (n e3))) + (rate 4 (l (n a2) (n a3))) + (l (rate 2 (l (n gs2) (n gs3))) (rate 2 (l (n e2) (n e3)))) + (l (n a2) (n a3) (n a2) (n a3) (n a2) (n a3) (n b1) (n c2)) + (rate 4 (l (n d2) (n d3))) + (rate 4 (l (n c2) (n c3))) + (l (rate 2 (l (n b1) (n b2))) (rate 2 (l (n e2) (n e3)))) + (rate 4 (l (n a1) (n a2))))))) +``` + +Notice how it's possible to arbitrarily parameterize the various qualities of `note`. +Cool. But how can I make it possible to _also_ parameterize an attribute of the notes +using strudel syntax? For example, I also want octave to impact this instruments in +this phrase: + +```clojure +(defn n [>ch >val >vel] + (let [[ch val vel] (m/?< (m/latest vector >ch >val >vel))] + {ch {val :on}}))) + +(def compiled-tetris + (p + ;; melody block + (let [n (fn [val] (n (m/ap 0) (m/ap val) (m/ap 100)))] + (f (l (n e5) (l (n b4) (n c5)) (n d5) (l (n c5) (n b4))) + (l (n a4) (l (n a4) (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l r (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r) + (l (l r (n d5)) (l r (n f5)) (n a5) (l (n g5) (n f5))) + (l (n e5) (l r (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l (n b4) (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r))) + + ;; bass block + (let [n (fn [val] (n (m/ap 1) (m/ap val) (m/ap 100)))] + (f (rate 4 (l (n e2) (n e3))) + (rate 4 (l (n a2) (n a3))) + (l (rate 2 (l (n gs2) (n gs3))) (rate 2 (l (n e2) (n e3)))) + (l (n a2) (n a3) (n a2) (n a3) (n a2) (n a3) (n b1) (n c2)) + (rate 4 (l (n d2) (n d3))) + (rate 4 (l (n c2) (n c3))) + (l (rate 2 (l (n b1) (n b2))) (rate 2 (l (n e2) (n e3)))) + (rate 4 (l (n a1) (n a2))))) + + ;; octave block + (l (octave 0) (octave 1)))) + +``` + +Here, octave and note both are returning flows. How do we define +the merge semantics of octave block? Should it merge with the bass +block? The melody block? The melody block has many entities in it. + +This feels on the one hand like a lexical problem. _Maybe_ the +solution should be limited to the speific semantics of the strudel +mini-notation format. But I think probably not? + +Oh, this is very helpful: +https://strudel.cc/learn/effects/#signal-chain + +Strudel has made this very concrete. Each pattern gets a sound, +asdr, some filters, effects, and delay/reverb. + +What if I don't want that? + +Let's jump to a very different idea: name trees +The idea is that nested phrases introduce nested names + +```clojure +(def a (phrase ...)) + +{`[a] ... + `[b a] ...} + +(def b + (phrase (a))) +``` + +Hm, what if `a` is used twice in `b`? +Oh, I wrote about this on Nov. 28. The answer has to do with providing the name at invocation time. + +```clojure +(def b (phrase ...)) + +(def a + (phrase (b :b))) + +(a :a) + +{[:a :b] ... + [:a] ...} +``` + +I bring this up now because it might relate to this merging question. + +```clojure +(defn n [>ch >val >vel] + (let [[ch val vel] (m/?< (m/latest vector >ch >val >vel))] + {ch {val :on}}))) + +(def a + (phrase + (let [n (fn [val] (n (m/ap 0) (m/ap val) (m/ap 100)))] + (f (l (n e5) (l (n b4) (n c5)) (n d5) (l (n c5) (n b4))) + (l (n a4) (l (n a4) (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l r (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r) + (l (l r (n d5)) (l r (n f5)) (n a5) (l (n g5) (n f5))) + (l (n e5) (l r (n c5)) (n e5) (l (n d5) (n c5))) + (l (n b4) (l (n b4) (n c5)) (n d5) (n e5)) + (l (n c5) (n a4) (n a4) r))))) + +(def b + (phrase + (let [n (fn [val] (n (m/ap 1) (m/ap val) (m/ap 100)))] + (f (rate 4 (l (n e2) (n e3))) + (rate 4 (l (n a2) (n a3))) + (l (rate 2 (l (n gs2) (n gs3))) (rate 2 (l (n e2) (n e3)))) + (l (n a2) (n a3) (n a2) (n a3) (n a2) (n a3) (n b1) (n c2)) + (rate 4 (l (n d2) (n d3))) + (rate 4 (l (n c2) (n c3))) + (l (rate 2 (l (n b1) (n b2))) (rate 2 (l (n e2) (n e3)))) + (rate 4 (l (n a1) (n a2))))))) + +(def octave + (phrase + (l (octave 0) (octave 1)))) + +(def tetris + (phrase + (p + ;; melody block + (a :melody) + (octave :melody) + + ;; bass block + (b :bass) + (octave :bass) + ))) + +(tetris :t) + +;; end up with +[[0 1 [[:t :melody] melody-note-flow-1]] + [0 1 [[:t :melody] melody-note-flow-2]] + [0 1 [[:t :melody] melody-octave-flow]]] + +;; melody-note-flow-1 might emit +{:kind :note + :note 60} + +;; melody-octave-flow might emit +{:kind :octave-transform + :dx 10} + +;; Maybe elements with the same name +;; are paired with elements of a different kind? +;; e.g. + +[{:kind :note :note 60} {:kind :octave-transform :dx 10} ;; note-1 + {:kind :note :note 70} {:kind :octave-transform :dx 10} ;; note-2 + ] + +;; Kind of interesting. But where does this merge order come from? Is it global? +;; Maybe local to a phrase? +;; And crucially: how do we know how to interpret any of this when it comes out the pipe at the end? + +;; One answer to the merge question is: merging must be order-independent. Though, I don't know how +;; to prevent merging issues caused by duplicate invocations of the same kind. + + ;; TODO: + ;; What about something with two notes, one octave transform, two cc params? Can these multiply? + ;; [note-1 octave cc-1] + ;; [note-1 octave cc-2] + ;; [note-2 octave cc-1] + ;; [note-2 octave cc-2] + ;; This doesn't really work, does it! Suddenly each note is appearing twice. + +;; This is a contrived example, though. Is there a better one? +``` + +--- + +Oh, but here's another cool observation. The data structure that feeds +into `timeline` - that is, a list of [start end value] tuples - is +more or less ready to lock in. The only question in my mind is how +`v` needs to be defined. + +This is a key observation to document: +I can support arbitrary musical syntaxes, they just need to +compile down to the [start end value] representation. + +## December 9th, 2025 + +A few more observations: + +1. parallel composition is closely related to instruments. (Instruments are trees playing in parallel.) +2. It might make sense to pass instrument specifiers down as arguments + +## December 10th, 2025 + +What about tags? + +Consider: + + +```clojure +;; tetris +(p + (tag :melody + (f (l _ (l _ _) _ (l _ _)) + (l _ (l _ _) _ (l _ _)) + (l _ (l r _) _ _) + (l _ _ _ r) + (l (l r _) (l r _) _ (l _ _)) + (l _ (l r _) _ (l _ _)) + (l _ (l _ _) _ _) + (l _ _ _ r))) + (tag :bass + (f (rate 4 (l _ _)) + (rate 4 (l _ _)) + (l (rate 2 (l _ _)) (rate 2 (l _ _))) + (l _ _ _ _ _ _ _ _) + (rate 4 (l _ _)) + (rate 4 (l _ _)) + (l (rate 2 (l _ _)) (rate 2 (l _ _))) + (rate 4 (l _ _))))) +``` + +When compiled, each interval of the above (except the outer p) would be tagged with either :melody or :bass. + + +```clojure +(tag :theme + (p + (tag :melody + (f (l _ (l _ _) _ (l _ _)) + (l _ (l _ _) _ (l _ _)) + (l _ (l r _) _ _) + (l _ _ _ r) + (l (l r _) (l r _) _ (l _ _)) + (l _ (l r _) _ (l _ _)) + (l _ (l _ _) _ _) + (l _ _ _ r))) + (tag :bass + (f (rate 4 (l _ _)) + (rate 4 (l _ _)) + (l (rate 2 (l _ _)) (rate 2 (l _ _))) + (l _ _ _ _ _ _ _ _) + (rate 4 (l _ _)) + (rate 4 (l _ _)) + (l (rate 2 (l _ _)) (rate 2 (l _ _))) + (rate 4 (l _ _)))))) +``` + +Here, every interval would also be tagged with :theme. + +What might we do with tags? +We could turn the output into tuples like this: + + +``` +[0 1 #{:theme :melody} :c4] +[0 1 #{:theme :bass} :d4] +``` + +That information could aid in interpretation at playback time? + + +Note that every slot (that is, every `_`) is a place where a tag +set can be placed. + +Without a tagging context, the tag is just the empty set. + +That is: + +```clojure +(f (l _ (l _ _) _ (l _ _)) + (l _ (l _ _) _ (l _ _)) + (l _ (l r _) _ _) + (l _ _ _ r) + (l (l r _) (l r _) _ (l _ _)) + (l _ (l r _) _ (l _ _)) + (l _ (l _ _) _ _) + (l _ _ _ r)) +``` + +Would result in each slot (that is, each interval) having a +tag set of `#{}`. + +Let's see how tagging would accomplish a few goals. + +1. Play midi notes, alternating between two instrument types. +2. Play two voices, swapping positions. +3. Write a phrase, and then output it both in OSC and MIDI +4. Write a phrase based on intervals, and then map those intervals + to a scale. +5. Same as 4, but move the scale based on a knob. During t1, the + knob swaps between ionian and mixolydian. During t2, the knob + swaps between dorian and locrian. +6. Two different instruments playing the same phrase, one shifted up + an octave +7. A sine wave adds tremolo to one note in a chord. The frequency + of that tremolo is dictated by a knob. + +### No. 1: + +```clojure + +(import [midi-notes :as m]) + +(def melody + (tag + :m/notes + (l :m/c1 :m/c2 :m/c3 :m/c2))) + +(def inst-changes + (tag + :inst + (l :synth-1 :synth-2))) + +(def song + (tag + :song + (p melody inst-changes))) + +[0 1 #{:song :m/notes} :m/c1] +[0 2 #{:song :inst} :synth-1] +[1 2 #{:song :m/notes} :m/c2] +[2 3 #{:song :m/notes} :m/c3] +[2 4 #{:song :inst} :synth-2] +[3 4 #{:song :m/notes} :m/c2] +``` + +### No. 2: + +```clojure +(import [midi-notes :as m]) + +(def voice-1 + (tag + :m/notes + (l :m/a1 :m/a2))) + +(def voice-2 + (tag + :m/notes + (l :m/a2 :m/a1))) + +(def song + (p + (tag :v1 voice-1) + (tag :v2 voice-2))) + +[0 1 #{:v1 :m/notes} :m/a1] +[0 1 #{:v2 :m/notes} :m/a2] +[1 2 #{:v1 :m/notes} :m/a2] +[1 2 #{:v2 :m/notes} :m/a1] + +``` + +### No. 3 + +```clojure +(def melody + (tag + :an/notes + (l :an/a1 :an/a2 :an/a3))) + +[0 1 #{:an/notes} :an/a1] +[1 2 #{:an/notes} :an/a2] +[2 3 #{:an/notes} :an/a3] +``` + +One thing interesting about the above: +:an/a1 could include its own tag. that is, +it could be replaced with: + +```clojure +(def a1 + (tag + :an/notes + (l :an/a1))) +``` + +Then the whole thing could be rewritten: + +```clojure +(def a1 + (tag + :an/notes + (l :an/a1))) + +(def a2 + (tag + :an/notes + (l :an/a2))) + +(def a3 + (tag + :an/notes + (l :an/a3))) + +(def melody + (l a1 a2 a3)) + +[0 1 #{:an/notes} :an/a1] +[1 2 #{:an/notes} :an/a2] +[2 3 #{:an/notes} :an/a3] +``` + +Note that the result is the same. + +### No. 4 + +```clojure +(def d1 + (tag + :scale/degree + (l :sd/d1))) + +(def d2 + (tag + :scale/degree + (l :sd/d2))) + +(def d3 + (tag + :scale/degree + (l :sd/d3))) + +(def ionian + (tag + :mode + (l :ionian))) + +(def mixolydian + (tag + :mode + (l :mixolydian))) + +(def melody + (tag :tune + (p + (l d1 d2 d3) + (l ionian mixolydian)))) + +[0 1 #{:tune :scale/degree} :sd/d1] +[0 1.5 #{:tune :mode} :ionian] +[1 2 #{:tune :scale/degree} :sd/d2] +[1.5 3 #{:tune :mode} :mixolydian] +[2 3 #{:tune :scale/degree} :sd/d3] +``` + +I think this one makes sense. + +### No. 5 + +```clojure +(def d1 + (tag + :scale/degree + (l :sd/d1))) + +(def d2 + (tag + :scale/degree + (l :sd/d2))) + +(def d3 + (tag + :scale/degree + (l :sd/d3))) + +(def ionian + (tag + :mode + (l :ionian))) + +(def mixolydian + (tag + :mode + (l :mixolydian))) + +(def dorian ...) +(def locrian ...) + +(def melody + (tag :tune + (p + (l d1 d2 d3) + (l + ;; x: flow combinator + (x + (m/ap + (if (< 0 (rescale 0 1 (m/?< (cv :k1-knob-1))) 0.5) + ionian + mixolydian))) + (x + (m/ap + (if (< 0 (rescale 0 1 (m/?< (cv :k1-knob-1))) 0.5) + dorian + locrian))))))) + +[0 1 #{:tune :scale/degree} :sd/d1] +[0 1.5 #{:tune :mode} first-flow] +[1 2 #{:tune :scale/degree} :sd/d2] +[1.5 3 #{:tune :mode} second-flow] +[2 3 #{:tune :scale/degree} :sd/d3] +``` + +Hm, we're back to flows in the value position. +This makes me think that we should _always have a flow in value position_. +This would obviate the x combinator introduced in +the above example. + +Another insight that came from this is that there should be a global +called cv that allows you to fetch control values by name. + +Is :k1-knob-1 compositional? +And how do I ensure that the existence of :k1-knob-1 is known +at compile time as an imput, so I can raise an exception if +it isn't connected to anything? + +```clojure +(def d1 + (tag + :scale/degree + (l (m/ap :sd/d1)))) + +(def ionian + (tag + :mode + (l (m/ap :ionian)))) +``` + +Also, notice that I'm returning items that are themselves tagged entities from the flow. +I think that this implies that tags are part of values. + +Put differently, a value has two components, :tag and :value. + + +## No. 6 + +This is a dumb way to accomplish no.6: + +```clojue +(def c3 + (tag + :an/notes + (l :an/c3))) + +(def d3 + (tag + :an/notes + (l :an/d3))) + +(def e3 + (tag + :an/notes + (l :an/e3))) + +(def f3 + (tag + :an/notes + (l :an/f3))) + +(def riff + (l c3 d3 e3 f3)) + +(def song + (p + (tag :inst-1 + riff) + (tag :inst-3 + (paste riff c4 d4 e4 f4)))) +``` + +I don't love this one. + +### No. 7 + +TODO I'm not even sure where to begin right now. + +--- + +Summarizing a few insights: + +1. Flows will exist in value position. This implies that + values should always be wrapped in a flow. +2. Flows will return tagged items. This implies that tags + must be part of value, not separate metadata. +3. Tags returned by flows should somehow merge with their + container tags. This seems hard? +4. It still isn't clear how we'll avoid naming collisions + with input labels. +5. Interpretation of tagged values remains an open question. +6. It isn't clear how to represent temporally-relative + structures, like make the next note one higher than the + previous. +7. Similarly, counterpoint-like structures cannot currently + be expressed in a relative way. + +Next, need to think about interpretation. + +Should tags be a set? That loses hierarchical information. +Is that bad? + +Oh, what about temporally relative structures, such as +1 tone? +And counterpoint-like relations, like in no. 6? + @@ -30,6 +30,7 @@ python3Packages.sphinx-rtd-theme direnv cloc + git-bug ]; }; } @@ -11,56 +11,38 @@ (defn rec "Record flow f, tagging with id." [id f] - (m/ap - (let [capturing? (atom nil) - [tag value] - (m/amb= [:focused-tags (m/?< >focused-tags)] - [:event (m/?< f)])] - (case tag - :focused-tags - (do - (reset! capturing? (boolean (value id))) - (m/amb)) + (m/ap (let [capturing? (atom nil) + [tag value] (m/amb= [:focused-tags (m/?< >focused-tags)] + [:event (m/?< f)])] + (case tag + :focused-tags (do (reset! capturing? (boolean (value id))) (m/amb)) + :event (do (swap! seen-tags conj id) + (when @capturing? + (m/? (m/via m/blk + ((requiring-resolve 'portal.api/submit) + [id value])))) + value))))) - :event - (do - (swap! seen-tags conj id) - (when @capturing? - (m/? (m/via m/blk ((requiring-resolve 'portal.api/submit) [id value])))) - value))))) - -(defn ptags - "Print all available tags." - [] @seen-tags) +(defn ptags "Print all available tags." [] @seen-tags) (def show-portal? (atom false)) (def >show-portal? (rec :show-portal? (m/signal (m/watch show-portal?)))) -(defn show-portal - "Show portal window." - [] - (reset! show-portal? true)) +(defn show-portal "Show portal window." [] (reset! show-portal? true)) -(defn hide-portal - "Hide portal window." - [] - (reset! show-portal? false)) +(defn hide-portal "Hide portal window." [] (reset! show-portal? false)) (def >portal-ui - (m/ap - (let [ui (m/? (m/via m/blk ((requiring-resolve 'portal.api/open))))] - (m/amb= ui - (try (m/? m/never) - (finally - ;; Were this blocking, I would put this on m/blk - ((requiring-resolve 'portal.api/close) ui) - (m/amb))))))) + (m/ap (let [ui (m/? (m/via m/blk ((requiring-resolve 'portal.api/open))))] + (m/amb= ui + (try (m/? m/never) + (finally + ;; Were this blocking, I would put this on m/blk + ((requiring-resolve 'portal.api/close) ui) + (m/amb))))))) (def >portal-ui-toggle - (m/ap - (when (m/?< >show-portal?) - (m/?< >portal-ui) - (m/amb)))) + (m/ap (when (m/?< >show-portal?) (m/?< >portal-ui) (m/amb)))) (defn cap "Capture flow elements with specified ids to portal" @@ -79,5 +61,4 @@ (def >portal-main "Main entrypoint." - (m/ap (m/amb= (do (m/?< >portal-ui-toggle) - (m/amb))))) + (m/ap (m/amb= (do (m/?< >portal-ui-toggle) (m/amb))))) diff --git a/src/unheard/clock.clj b/src/unheard/clock.clj index d38b52a..b711ebe 100644 --- a/src/unheard/clock.clj +++ b/src/unheard/clock.clj @@ -2,30 +2,23 @@ (:require [missionary.core :as m])) ;; TODO: Put in missionary util -(defn poll [init task] - (m/ap (m/? (m/?> (m/seed (concat [(m/sp init)] - (repeat task))))))) +(defn poll + [init task] + (m/ap (m/? (m/?> (m/seed (concat [(m/sp init)] (repeat task))))))) ;; TODO: Put in missionary util -(defn feedback [f init & args] - (m/ap - (m/amb - init - (let [rdv (m/rdv) - x (m/?> (apply f (poll init rdv) args))] - (m/amb - (do - (m/? (rdv x)) - (m/amb)) - x))))) +(defn feedback + [f init & args] + (m/ap (m/amb init + (let [rdv (m/rdv) + x (m/?> (apply f (poll init rdv) args))] + (m/amb (do (m/? (rdv x)) (m/amb)) x))))) ;; Return value ;; TODO: Make part of public API (defonce mono-clock-freq (atom 120)) ;; hz -(defonce >mono-clock-freq - (m/signal - (m/watch mono-clock-freq))) +(defonce >mono-clock-freq (m/signal (m/watch mono-clock-freq))) (def >mono-clock "This is the base monotonic clock used for driving playback. @@ -38,57 +31,60 @@ frequency." ;; TODO: Change this behavior. I don't want to wait for ;; the current tick to complete during a frequency change.. - (m/signal - (m/relieve - (feedback (fn [v] - (m/ap - (let [[t freq] (m/?< (m/latest vector v >mono-clock-freq))] - (m/? (m/compel (m/sleep (/ 1000 freq)))) - (System/nanoTime)))) - (System/nanoTime))))) + (m/signal (m/relieve + (feedback (fn [v] + (m/ap (let [[t freq] + (m/?< + (m/latest vector v >mono-clock-freq))] + (m/? (m/compel (m/sleep (/ 1000 freq)))) + (System/nanoTime)))) + (System/nanoTime))))) (comment - (def cancel - ((m/reduce prn nil >mono-clock) prn prn)) - + (def cancel ((m/reduce prn nil >mono-clock) prn prn)) (reset! mono-clock-freq 50) (reset! mono-clock-freq 10) (reset! mono-clock-freq 1) (cancel)) (defonce bpm (atom 120)) -(defonce >bpm - (m/signal - (m/watch bpm))) +(defonce >bpm (m/signal (m/watch bpm))) (def >beat-clock "Counts beats at `bpm`. Guaranteed not to lose or gain time." (m/signal - (m/relieve - (let [init-beat 0] - (m/reductions {} init-beat - (m/ap - (let [state (object-array 2) - last-beat-time-idx 0 - last-beat-number-idx 1 - _ (aset state last-beat-time-idx (System/nanoTime)) - _ (aset state last-beat-number-idx init-beat) - [t bpm] (m/?< (m/latest vector >mono-clock >bpm)) - last-beat-time (aget state last-beat-time-idx) - next-beat-time (+ last-beat-time (* 1000000000 (/ 60 bpm))) - last-beat-number (aget state last-beat-number-idx) - t-since-beat-start (- t last-beat-time) - pct-through-current-beat (/ t-since-beat-start (- next-beat-time last-beat-time))] - (when (<= next-beat-time t) - ;; TODO confirm this won't lose or gain time - (aset state last-beat-time-idx next-beat-time) - (aset state last-beat-number-idx (inc last-beat-number))) - (+ last-beat-number pct-through-current-beat)))))))) + (m/relieve + (let [init-beat 0] + (m/reductions + {} + init-beat + (m/ap + (let [state (object-array 2) + last-beat-time-idx 0 + last-beat-number-idx 1 + _ (aset state last-beat-time-idx (System/nanoTime)) + _ (aset state last-beat-number-idx init-beat) + ;; BUG 8a32cde: BPM changes can cause non-monotonic + ;; behavior! + [t bpm] (m/?< (m/latest vector >mono-clock >bpm))] + (if (= bpm 0) + (m/amb) + (let [last-beat-time (aget state last-beat-time-idx) + next-beat-time (+ last-beat-time + (* 1000000000 (/ 60 bpm))) + last-beat-number (aget state last-beat-number-idx) + t-since-beat-start (- t last-beat-time) + pct-through-current-beat (/ t-since-beat-start + (- next-beat-time + last-beat-time))] + (when (<= next-beat-time t) + ;; TODO confirm this won't lose or gain time + (aset state last-beat-time-idx next-beat-time) + (aset state last-beat-number-idx (inc last-beat-number))) + (+ last-beat-number pct-through-current-beat)))))))))) (comment - (def cancel - ((m/reduce prn nil >beat-clock) prn prn)) - + (def cancel ((m/reduce prn nil >beat-clock) prn prn)) (reset! bpm 60) (reset! bpm 120) (reset! mono-clock-freq 120) 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.clj b/src/unheard/midi.clj index f0debad..c5cf925 100644 --- a/src/unheard/midi.clj +++ b/src/unheard/midi.clj @@ -31,6 +31,7 @@ (m/amb)) (m/?< >devices) (try (m/? m/never) + (catch Exception e (println "EEE" e) (throw e)) (finally (m/? (m/via m/blk @@ -69,6 +70,7 @@ :id :midi/device-opened, :data {:device (str device)}}) (m/? (tfn device)) + (catch Exception e (println "EEE" e) (throw e)) (finally (log/log! {:level :info, :id :midi/closing-device}) ;; NOTE: ;; Be careful, (.close device) will wait for (.send @@ -124,6 +126,7 @@ :data {:value (str v)}}) v) (recur))))))) + (catch Exception e (println "EEE" e) (throw e)) (finally (log/log! {:level :info, :id :midi/closing-tx}) (m/? (m/via m/blk (.close transmitter))) (log/log! {:level :info, :id :midi/tx-closed})))))) @@ -154,6 +157,7 @@ (.send receiver v UNSCHEDULED-EVENT))) (log/log! {:level :debug, :id :midi/send-returned}))))) + (catch Exception e (println "EEE" e) (throw e)) (finally (log/log! {:level :info, :id :midi/closing-rx}) (m/? (m/via m/blk (.close receiver))) (log/log! {:level :info, :id :midi/rx-closed})))))) @@ -281,10 +285,10 @@ short-messages (atom nil) >short-messages (m/watch short-messages)] (m/amb= (do (reset! short-messages nil) - (m/? (<bus device-name - (fn [v] - (m/ap (try - (let [msg (m/?< v)] + (m/? + (<bus device-name + (fn [v] + (m/ap (try (let [msg (m/?< v)] (reset! short-messages msg)) (catch missionary.Cancelled c ;; When the upstream flow is 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))) diff --git a/test/unheard/cycles_test.clj b/test/unheard/cycles_test.clj index c395755..552b6e9 100644 --- a/test/unheard/cycles_test.clj +++ b/test/unheard/cycles_test.clj @@ -3,278 +3,160 @@ [unheard.cycles :refer [l f p rate elongate rep paste unfold]])) (deftest unfold-tests - (testing "single scalar" - (is (= [[0 1 :a]] - (unfold 1 :a)))) - + (testing "single scalar" (is (= [[0 1 :a]] (unfold 1 :a)))) (testing "simple list - time subdivision" - (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]] - (unfold 1 (l :a :b :c))))) - + (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]] (unfold 1 (l :a :b :c))))) (testing "simple fork - cycles through children" - (is (= [[0 1 :a] - [1 2 :b] - [2 3 :c]] - (unfold 1 (f :a :b :c))))) - + (is (= [[0 1 :a] [1 2 :b] [2 3 :c]] (unfold 1 (f :a :b :c))))) (testing "list with fork - fork gets time slice" - (is (= [[0 1/2 :1] [1/2 1 :2] - [1 3/2 :1] [3/2 2 :3]] + (is (= [[0 1/2 :1] [1/2 1 :2] [1 3/2 :1] [3/2 2 :3]] (unfold 1 (l :1 (f :2 :3)))))) - (testing "fork with list - each child subdivides its cycle" - (is (= [[0 1/2 :a] [1/2 1 :b] - [1 2 :c]] - (unfold 1 (f (l :a :b) :c))))) - + (is (= [[0 1/2 :a] [1/2 1 :b] [1 2 :c]] (unfold 1 (f (l :a :b) :c))))) (testing "nested lists" - (is (= [[0 1/2 :a] [1/2 3/4 :b] [3/4 1 :c]] - (unfold 1 (l :a (l :b :c)))))) - + (is (= [[0 1/2 :a] [1/2 3/4 :b] [3/4 1 :c]] (unfold 1 (l :a (l :b :c)))))) (testing "nested forks" - (is (= [[0 1 :a] - [1 2 :b] - [2 3 :c] - [3 4 :d] - [4 5 :a] - [5 6 :e] - [6 7 :c] + (is (= [[0 1 :a] [1 2 :b] [2 3 :c] [3 4 :d] [4 5 :a] [5 6 :e] [6 7 :c] [7 8 :d]] (unfold 1 (f :a (f :b :e) :c :d))))) - (testing "complex nested structure from example" - (is (= [[0 1/2 :1] [1/2 3/4 :2] [3/4 1 :9] [1 3/2 :6] [3/2 2 :7] - [2 5/2 :1] [5/2 3 :3] [3 7/2 :6] [7/2 4 :8] - [4 9/2 :1] [9/2 5 :4] [5 11/2 :6] [11/2 6 :7] - [6 13/2 :1] [13/2 27/4 :2] [27/4 7 :9] [7 15/2 :6] [15/2 8 :8] - [8 17/2 :1] [17/2 9 :3] [9 19/2 :6] [19/2 10 :7] + (is (= [[0 1/2 :1] [1/2 3/4 :2] [3/4 1 :9] [1 3/2 :6] [3/2 2 :7] [2 5/2 :1] + [5/2 3 :3] [3 7/2 :6] [7/2 4 :8] [4 9/2 :1] [9/2 5 :4] [5 11/2 :6] + [11/2 6 :7] [6 13/2 :1] [13/2 27/4 :2] [27/4 7 :9] [7 15/2 :6] + [15/2 8 :8] [8 17/2 :1] [17/2 9 :3] [9 19/2 :6] [19/2 10 :7] [10 21/2 :1] [21/2 11 :5] [11 23/2 :6] [23/2 12 :8]] (unfold 2 (l :1 (f (l :2 :9) :3 (f :4 :5)) :6 (f :7 :8)))))) - (testing "different cycle lengths" - (is (= [[0 1/2 :a] [1/2 1 :b]] - (unfold 1 (l :a :b)))) - (is (= [[0 1 :a] [1 2 :b]] - (unfold 2 (l :a :b)))) - (is (= [[0 5/2 :a] [5/2 5 :b]] - (unfold 5 (l :a :b))))) - + (is (= [[0 1/2 :a] [1/2 1 :b]] (unfold 1 (l :a :b)))) + (is (= [[0 1 :a] [1 2 :b]] (unfold 2 (l :a :b)))) + (is (= [[0 5/2 :a] [5/2 5 :b]] (unfold 5 (l :a :b))))) (testing "fork with nested list subdivides correctly" - (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c] - [1 2 :x]] + (is (= [[0 1/3 :a] [1/3 2/3 :b] [2/3 1 :c] [1 2 :x]] (unfold 1 (f (l :a :b :c) :x))))) - (testing "simple parallel - all children at same time" - (is (= [[0 1 :a] [0 1 :b] [0 1 :c]] - (unfold 1 (p :a :b :c))))) - + (is (= [[0 1 :a] [0 1 :b] [0 1 :c]] (unfold 1 (p :a :b :c))))) (testing "parallel with list - children subdivide in parallel" - (is (= [[0 1/2 :a] [1/2 1 :b] - [0 1/2 :c] [1/2 1 :d]] + (is (= [[0 1/2 :a] [1/2 1 :b] [0 1/2 :c] [1/2 1 :d]] (unfold 1 (p (l :a :b) (l :c :d)))))) - (testing "parallel with fork - forks extend together" - (is (= [[0 1 :a] [0 1 :c] - [1 2 :b] [1 2 :d]] + (is (= [[0 1 :a] [0 1 :c] [1 2 :b] [1 2 :d]] (unfold 1 (p (f :a :b) (f :c :d)))))) - (testing "list containing parallel" - (is (= [[0 1/2 :x] [0 1/2 :y] - [1/2 1 :z]] - (unfold 1 (l (p :x :y) :z))))) - + (is (= [[0 1/2 :x] [0 1/2 :y] [1/2 1 :z]] (unfold 1 (l (p :x :y) :z))))) (testing "parallel with different cycle lengths" - (is (= [[0 1 :a] [0 1 :b] - [1 2 :a] [1 2 :c]] - (unfold 1 (p :a (f :b :c)))))) - + (is (= [[0 1 :a] [0 1 :b] [1 2 :a] [1 2 :c]] (unfold 1 (p :a (f :b :c)))))) (testing "rate 2 - doubles speed of scalar" - (is (= [[0 1/2 :a] [1/2 1 :a]] - (unfold 1 (rate 2 :a))))) - + (is (= [[0 1/2 :a] [1/2 1 :a]] (unfold 1 (rate 2 :a))))) (testing "rate 1/2 - halves speed of scalar" - (is (= [[0 2 :a]] - (unfold 1 (rate 1/2 :a))))) - + (is (= [[0 2 :a]] (unfold 1 (rate 1/2 :a))))) (testing "rate 2 - doubles speed of list" - (is (= [[0 1/6 :a] [1/6 1/3 :b] [1/3 1/2 :c] - [1/2 2/3 :a] [2/3 5/6 :b] [5/6 1 :c]] + (is (= [[0 1/6 :a] [1/6 1/3 :b] [1/3 1/2 :c] [1/2 2/3 :a] [2/3 5/6 :b] + [5/6 1 :c]] (unfold 1 (rate 2 (l :a :b :c)))))) - (testing "rate 1/2 - halves speed of list" - (is (= [[0 1 :a] [1 2 :b]] - (unfold 1 (rate 1/2 (l :a :b)))))) - + (is (= [[0 1 :a] [1 2 :b]] (unfold 1 (rate 1/2 (l :a :b)))))) (testing "rate 2 - doubles speed of fork" - ;; Fork has 3 children, cycle count is 3 - ;; rate 2 makes it repeat 2x, so 6 total cycles - (is (= [[0 1/6 :a] [1/6 1/3 :b] [1/3 1/2 :c] - [1/2 2/3 :a] [2/3 5/6 :b] [5/6 1 :c] - [1 7/6 :a] [7/6 4/3 :b] [4/3 3/2 :c] - [3/2 5/3 :a] [5/3 11/6 :b] [11/6 2 :c] - [2 13/6 :a] [13/6 7/3 :b] [7/3 5/2 :c] + ;; Fork has 3 children, cycle count is 3 rate 2 makes it repeat 2x, so + ;; 6 total cycles + (is (= [[0 1/6 :a] [1/6 1/3 :b] [1/3 1/2 :c] [1/2 2/3 :a] [2/3 5/6 :b] + [5/6 1 :c] [1 7/6 :a] [7/6 4/3 :b] [4/3 3/2 :c] [3/2 5/3 :a] + [5/3 11/6 :b] [11/6 2 :c] [2 13/6 :a] [13/6 7/3 :b] [7/3 5/2 :c] [5/2 8/3 :a] [8/3 17/6 :b] [17/6 3 :c]] (unfold 1 (rate 2 (f :a :b :c)))))) - (testing "rate with parallel" ;; Parallel has cycle 1, rate 2 repeats it twice - (is (= [[0 1/2 :a] [0 1/2 :b] - [1/2 1 :a] [1/2 1 :b]] + (is (= [[0 1/2 :a] [0 1/2 :b] [1/2 1 :a] [1/2 1 :b]] (unfold 1 (rate 2 (p :a :b)))))) - (testing "rate inside list" - (is (= [[0 1/2 :x] [1/2 3/4 :y] [3/4 1 :y]] - (unfold 1 (l :x (rate 2 :y)))))) - + (is (= [[0 1/2 :x] [1/2 3/4 :y] [3/4 1 :y]] (unfold 1 (l :x (rate 2 :y)))))) (testing "nested rates" (is (= [[0 1/4 :a] [1/4 1/2 :a] [1/2 3/4 :a] [3/4 1 :a]] (unfold 1 (rate 2 (rate 2 :a)))))) - (testing "elongate 2 - element takes twice as long" (is (= [[0 1/2 :a] [1/2 3/4 :b] [3/4 1 :c]] (unfold 1 (l (elongate 2 :a) :b :c))))) - (testing "elongate 3 - element takes three times as long" (is (= [[0 3/5 :a] [3/5 4/5 :b] [4/5 1 :c]] (unfold 1 (l (elongate 3 :a) :b :c))))) - (testing "multiple elongations" (is (= [[0 2/5 :a] [2/5 4/5 :b] [4/5 1 :c]] (unfold 1 (l (elongate 2 :a) (elongate 2 :b) :c))))) - (testing "elongate with fork" - (is (= [[0 1 :a] [1 2 :b]] - (unfold 1 (f (elongate 2 :a) :b))))) - + (is (= [[0 1 :a] [1 2 :b]] (unfold 1 (f (elongate 2 :a) :b))))) (testing "elongate inside parallel" - (is (= [[0 1 :a] [0 1 :b]] - (unfold 1 (p (elongate 2 :a) :b))))) - + (is (= [[0 1 :a] [0 1 :b]] (unfold 1 (p (elongate 2 :a) :b))))) (testing "elongate with rate" - (is (= [[0 1/2 :a] [1/2 1 :a]] - (unfold 1 (elongate 2 (rate 2 :a)))))) - + (is (= [[0 1/2 :a] [1/2 1 :a]] (unfold 1 (elongate 2 (rate 2 :a)))))) (testing "rate with elongate inside list" - (is (= [[0 1/4 :a] [1/4 3/8 :b] [3/8 1/2 :c] - [1/2 3/4 :a] [3/4 7/8 :b] [7/8 1 :c]] + (is (= [[0 1/4 :a] [1/4 3/8 :b] [3/8 1/2 :c] [1/2 3/4 :a] [3/4 7/8 :b] + [7/8 1 :c]] (unfold 1 (rate 2 (l (elongate 2 :a) :b :c)))))) - (testing "rep 2 - element repeats twice" - (is (= [[0 1/2 :a] [1/2 1 :a]] - (unfold 1 (rep 2 :a))))) - + (is (= [[0 1/2 :a] [1/2 1 :a]] (unfold 1 (rep 2 :a))))) (testing "rep 3 - element repeats three times" - (is (= [[0 1/3 :a] [1/3 2/3 :a] [2/3 1 :a]] - (unfold 1 (rep 3 :a))))) - + (is (= [[0 1/3 :a] [1/3 2/3 :a] [2/3 1 :a]] (unfold 1 (rep 3 :a))))) (testing "rep in list - subdivides its time slot" - (is (= [[0 1/6 :a] [1/6 1/3 :a] [1/3 1/2 :a] - [1/2 1 :b]] + (is (= [[0 1/6 :a] [1/6 1/3 :a] [1/3 1/2 :a] [1/2 1 :b]] (unfold 1 (l (rep 3 :a) :b))))) - (testing "rep with three elements in list" - (is (= [[0 1/6 :x] [1/6 1/3 :x] - [1/3 2/3 :y] - [2/3 1 :z]] + (is (= [[0 1/6 :x] [1/6 1/3 :x] [1/3 2/3 :y] [2/3 1 :z]] (unfold 1 (l (rep 2 :x) :y :z))))) - (testing "multiple reps in list" - (is (= [[0 1/6 :a] [1/6 1/3 :a] - [1/3 1/2 :b] [1/2 2/3 :b] - [2/3 1 :c]] + (is (= [[0 1/6 :a] [1/6 1/3 :a] [1/3 1/2 :b] [1/2 2/3 :b] [2/3 1 :c]] (unfold 1 (l (rep 2 :a) (rep 2 :b) :c))))) - (testing "rep with fork" - (is (= [[0 1/2 :a] [1/2 1 :a] - [1 2 :b]] - (unfold 1 (f (rep 2 :a) :b))))) - + (is (= [[0 1/2 :a] [1/2 1 :a] [1 2 :b]] (unfold 1 (f (rep 2 :a) :b))))) (testing "rep inside parallel" - (is (= [[0 1/2 :a] [1/2 1 :a] - [0 1 :b]] - (unfold 1 (p (rep 2 :a) :b))))) - + (is (= [[0 1/2 :a] [1/2 1 :a] [0 1 :b]] (unfold 1 (p (rep 2 :a) :b))))) (testing "rep with rate" - (is (= [[0 1/4 :a] [1/4 1/2 :a] - [1/2 3/4 :a] [3/4 1 :a]] + (is (= [[0 1/4 :a] [1/4 1/2 :a] [1/2 3/4 :a] [3/4 1 :a]] (unfold 1 (rep 2 (rate 2 :a)))))) - (testing "rate with rep inside" - (is (= [[0 1/4 :a] [1/4 1/2 :a] - [1/2 3/4 :a] [3/4 1 :a]] + (is (= [[0 1/4 :a] [1/4 1/2 :a] [1/2 3/4 :a] [3/4 1 :a]] (unfold 1 (rate 2 (rep 2 :a)))))) - (testing "rep in list without elongate" - (is (= [[0 1/6 :a] [1/6 1/3 :a] - [1/3 2/3 :b] - [2/3 1 :c]] + (is (= [[0 1/6 :a] [1/6 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]] (unfold 1 (l (rep 2 :a) :b :c))))) - (testing "elongate and rep together" - (is (= [[0 1/6 :a] [1/6 1/3 :a] - [1/3 2/3 :b] - [2/3 1 :c]] + (is (= [[0 1/6 :a] [1/6 1/3 :a] [1/3 2/3 :b] [2/3 1 :c]] (unfold 1 (l (rep 2 (elongate 2 :a)) :b :c))))) - (testing "rep of list" - (is (= [[0 1/4 :a] [1/4 1/2 :b] - [1/2 3/4 :a] [3/4 1 :b]] + (is (= [[0 1/4 :a] [1/4 1/2 :b] [1/2 3/4 :a] [3/4 1 :b]] (unfold 1 (rep 2 (l :a :b)))))) - (testing "paste - simple replacement in list" - (is (= (l :a :b :c) - (paste (l :_ :_ :_) :a :b :c)))) - + (is (= (l :a :b :c) (paste (l :_ :_ :_) :a :b :c)))) (testing "paste - simple replacement in fork" (is (= (f :c (f :e :g) :b :d) (paste (f :_ (f :_ :_) :_ :_) :c :e :g :b :d)))) - (testing "paste - with nil preserves original" (is (= (f :c (f :e :_) :b :d) (paste (f :_ (f :_ :_) :_ :_) :c :e nil :b :d)))) - (testing "paste - multiple nils" (is (= (f :_ (f :e :_) :b :_) (paste (f :_ (f :_ :_) :_ :_) nil :e nil :b nil)))) - (testing "paste - with numbers as template" - (is (= (l :a :b :c) - (paste (l 1 2 1) :a :b :c)))) - + (is (= (l :a :b :c) (paste (l 1 2 1) :a :b :c)))) (testing "paste - nested structures" - (is (= (l :x (l :y :z) :w) - (paste (l :_ (l :_ :_) :_) :x :y :z :w)))) - + (is (= (l :x (l :y :z) :w) (paste (l :_ (l :_ :_) :_) :x :y :z :w)))) (testing "paste - with parallel" - (is (= (p :a :b :c) - (paste (p :_ :_ :_) :a :b :c)))) - + (is (= (p :a :b :c) (paste (p :_ :_ :_) :a :b :c)))) (testing "paste - complex nested with parallel" - (is (= (l :a (p :b :c) :d) - (paste (l :_ (p :_ :_) :_) :a :b :c :d)))) - + (is (= (l :a (p :b :c) :d) (paste (l :_ (p :_ :_) :_) :a :b :c :d)))) (testing "paste - with modifiers preserved" - (is (= (l (rate 2 :a) :b) - (paste (l (rate 2 :_) :_) :a :b)))) - + (is (= (l (rate 2 :a) :b) (paste (l (rate 2 :_) :_) :a :b)))) (testing "paste - with elongate" (is (= (l (elongate 2 :x) :y :z) (paste (l (elongate 2 :_) :_ :_) :x :y :z)))) - (testing "paste - with rep" - (is (= (l (rep 3 :a) :b) - (paste (l (rep 3 :_) :_) :a :b)))) - + (is (= (l (rep 3 :a) :b) (paste (l (rep 3 :_) :_) :a :b)))) (testing "paste - unfolds correctly" (is (= [[0 1/3 :c] [1/3 2/3 :e] [2/3 1 :g]] (unfold 1 (paste (l :_ :_ :_) :c :e :g))))) - (testing "paste - complex rhythm unfolds correctly" - (is (= [[0 1 :c] [1 2 :e] [2 3 :b] [3 4 :d] - [4 5 :c] [5 6 :g] [6 7 :b] [7 8 :d]] + (is (= [[0 1 :c] [1 2 :e] [2 3 :b] [3 4 :d] [4 5 :c] [5 6 :g] [6 7 :b] + [7 8 :d]] (unfold 1 (paste (f :_ (f :_ :_) :_ :_) :c :e :g :b :d))))) - (testing "paste - with nil unfolds correctly" - (is (= [[0 1 :c] [1 2 :e] [2 3 :b] [3 4 :d] - [4 5 :c] [5 6 :_] [6 7 :b] [7 8 :d]] + (is (= [[0 1 :c] [1 2 :e] [2 3 :b] [3 4 :d] [4 5 :c] [5 6 :_] [6 7 :b] + [7 8 :d]] (unfold 1 (paste (f :_ (f :_ :_) :_ :_) :c :e nil :b :d)))))) diff --git a/test/unheard/strudel/mini_notation_compiler_test.clj b/test/unheard/strudel/mini_notation_compiler_test.clj index 184a9ea..38ae8be 100644 --- a/test/unheard/strudel/mini_notation_compiler_test.clj +++ b/test/unheard/strudel/mini_notation_compiler_test.clj @@ -4,154 +4,85 @@ [unheard.strudel.mini-notation-compiler :refer [compile]])) (deftest compile-tests - (testing "single atom" - (is (= :c - (compile "c" keyword)))) - - (testing "rest literal" - (is (= :r - (compile "~" keyword)))) - + (testing "single atom" (is (= :c (compile "c" keyword)))) + (testing "rest literal" (is (= :r (compile "~" keyword)))) (testing "simple sequence - space separated" - (is (= '(l :c :e :g) - (compile "c e g" keyword)))) - + (is (= '(l :c :e :g) (compile "c e g" keyword)))) (testing "sequence with rest" - (is (= '(l :c :r :g) - (compile "c ~ g" keyword)))) - + (is (= '(l :c :r :g) (compile "c ~ g" keyword)))) (testing "subdivision with brackets" - (is (= '(l :c (l :e :g) :b) - (compile "c [e g] b" keyword)))) - + (is (= '(l :c (l :e :g) :b) (compile "c [e g] b" keyword)))) (testing "nested brackets" - (is (= '(l :a (l :b (l :c :d))) - (compile "a [b [c d]]" keyword)))) - + (is (= '(l :a (l :b (l :c :d))) (compile "a [b [c d]]" keyword)))) (testing "angle brackets - alternation" - (is (= '(f :c :e :g :b) - (compile "<c e g b>" keyword)))) - + (is (= '(f :c :e :g :b) (compile "<c e g b>" keyword)))) (testing "parallel with commas" - (is (= '(p :c :e :g) - (compile "c,e,g" keyword)))) - + (is (= '(p :c :e :g) (compile "c,e,g" keyword)))) (testing "parallel in sequence" - (is (= '(l (p :c :e :g) (p :d :f :a)) - (compile "[c,e,g] [d,f,a]" keyword)))) - + (is (= '(l (p :c :e :g) (p :d :f :a)) (compile "[c,e,g] [d,f,a]" keyword)))) (testing "rate modifier - multiplication" - (is (= '(rate 2 :c) - (compile "c*2" keyword)))) - + (is (= '(rate 2 :c) (compile "c*2" keyword)))) (testing "rate modifier - division" - (is (= '(rate (/ 1 2) :c) - (compile "c/2" keyword)))) - + (is (= '(rate (/ 1 2) :c) (compile "c/2" keyword)))) (testing "rate on group" - (is (= '(rate 2 (l :e :g)) - (compile "[e g]*2" keyword)))) - + (is (= '(rate 2 (l :e :g)) (compile "[e g]*2" keyword)))) (testing "rate on alternation" - (is (= '(rate 2 (f :c :e :g :b)) - (compile "<c e g b>*2" keyword)))) - + (is (= '(rate 2 (f :c :e :g :b)) (compile "<c e g b>*2" keyword)))) (testing "elongate modifier" - (is (= '(elongate 3 :c) - (compile "c@3" keyword)))) - + (is (= '(elongate 3 :c) (compile "c@3" keyword)))) (testing "elongate in sequence" - (is (= '(l (elongate 2 :a) :b :c) - (compile "a@2 b c" keyword)))) - - (testing "replication modifier" - (is (= '(rep 3 :c) - (compile "c!3" keyword)))) - + (is (= '(l (elongate 2 :a) :b :c) (compile "a@2 b c" keyword)))) + (testing "replication modifier" (is (= '(rep 3 :c) (compile "c!3" keyword)))) (testing "replication in sequence" - (is (= '(l (rep 2 :x) :y) - (compile "x!2 y" keyword)))) - + (is (= '(l (rep 2 :x) :y) (compile "x!2 y" keyword)))) (testing "multiple modifiers" - (is (= '(rate 2 (elongate 3 :c)) - (compile "c@3*2" keyword)))) - + (is (= '(rate 2 (elongate 3 :c)) (compile "c@3*2" keyword)))) (testing "complex nested structure" - (is (= '(l :c (f :e :g) :b :d) - (compile "c <e g> b d" keyword)))) - + (is (= '(l :c (f :e :g) :b :d) (compile "c <e g> b d" keyword)))) (testing "subdivision with parallel" - (is (= '(l :x (p :y :z) :w) - (compile "x [y,z] w" keyword)))) - + (is (= '(l :x (p :y :z) :w) (compile "x [y,z] w" keyword)))) (testing "strudel example from docs" (is (= '(l :e5 (l :b4 :c5) :d5 (l :c5 :b4)) (compile "e5 [b4 c5] d5 [c5 b4]" keyword)))) - (testing "chord sequence" (is (= '(rate 2 (f (p :g3 :b3 :e4) (p :a3 :c3 :e4))) (compile "<[g3,b3,e4] [a3,c3,e4]>*2" keyword)))) - (testing "elongated chord" (is (= '(rate 2 (f (elongate 2 (p :g3 :b3 :e4)) (p :a3 :c3 :e4))) (compile "<[g3,b3,e4]@2 [a3,c3,e4]>*2" keyword)))) - (testing "replicated chord" (is (= '(rate 2 (f (rep 2 (p :g3 :b3 :e4)) (p :a3 :c3 :e4))) (compile "<[g3,b3,e4]!2 [a3,c3,e4]>*2" keyword)))) - (testing "rest in subdivision" - (is (= '(l :b4 (l :r :c5) :d5 :e5) - (compile "b4 [~ c5] d5 e5" keyword)))) - - (testing "numbers as values" - (is (= '(l 1 2 3) - (compile "1 2 3" keyword)))) - + (is (= '(l :b4 (l :r :c5) :d5 :e5) (compile "b4 [~ c5] d5 e5" keyword)))) + (testing "numbers as values" (is (= '(l 1 2 3) (compile "1 2 3" keyword)))) (testing "rational number rate" - (is (= '(rate 3/2 :c) - (compile "c*3/2" keyword)))) - + (is (= '(rate 3/2 :c) (compile "c*3/2" keyword)))) (testing "whitespace handling" - (is (= '(l :a :b :c) - (compile " a b c " keyword)))) - + (is (= '(l :a :b :c) (compile " a b c " keyword)))) (testing "complex real-world pattern" (is (= '(l (rate 2 (f :bd :sd)) (p :hat :hat :hat)) (compile "<bd sd>*2 [hat,hat,hat]" keyword)))) - (testing "newlines are converted to spaces" - (is (= '(f :a :b :c :d) - (compile "<a b\nc d>" keyword)))) - + (is (= '(f :a :b :c :d) (compile "<a b\nc d>" keyword)))) (testing "multi-line pattern with parallel" - (is (= '(f (l :a :b) (p :c :d)) - (compile "<\n[a b]\n[c,d]\n>" keyword)))) - + (is (= '(f (l :a :b) (p :c :d)) (compile "<\n[a b]\n[c,d]\n>" keyword)))) (testing "polymeter - comma creates parallel of forks" - (is (= '(p (f :a :b) (f :c :d)) - (compile "<a b, c d>" keyword)))) - + (is (= '(p (f :a :b) (f :c :d)) (compile "<a b, c d>" keyword)))) (testing "polymeter - three groups" (is (= '(p (f :a :b) (f :c :d) (f :e :f)) (compile "<a b, c d, e f>" keyword)))) - (testing "polymeter - unequal lengths" - (is (= '(p (f :a :b :e) (f :c :d)) - (compile "<a b e, c d>" keyword)))) - + (is (= '(p (f :a :b :e) (f :c :d)) (compile "<a b e, c d>" keyword)))) (testing "polymeter - single element per group" - (is (= '(p :a :c) - (compile "<a, c>" keyword)))) - + (is (= '(p :a :c) (compile "<a, c>" keyword)))) (testing "polymeter - with nested structures" (is (= '(p (f (l :a :b) (l :c :d)) (f (l :e :f) (l :g :h))) (compile "<[a b] [c d], [e f] [g h]>" keyword)))) - (testing "polymeter - with modifiers" - (is (= '(rate 2 (p (f :a :b) (f :c :d))) - (compile "<a b, c d>*2" keyword)))) - + (is (= '(rate 2 (p (f :a :b) (f :c :d))) (compile "<a b, c d>*2" keyword)))) (testing "polymeter - melody and bass pattern" - (is (= '(p (f (l :e5 :b4) (l :a4 :c5)) (f (rate 4 (l :e2 :e3)) (rate 4 (l :a2 :a3)))) + (is (= '(p + (f (l :e5 :b4) (l :a4 :c5)) + (f (rate 4 (l :e2 :e3)) (rate 4 (l :a2 :a3)))) (compile "<[e5 b4] [a4 c5], [[e2 e3]*4] [[a2 a3]*4]>" keyword))))) |