From 02dce7d08f92b1d255e3afca33034f481d1371a7 Mon Sep 17 00:00:00 2001 From: Jake Zerrer Date: Wed, 26 Nov 2025 15:10:20 -0500 Subject: Add git-bug to flake --- src/unheard/strudel/mini_notation_compiler.clj | 135 +++++++++++-------------- 1 file changed, 61 insertions(+), 74 deletions(-) (limited to 'src/unheard/strudel') 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))))) -- cgit v1.2.3