Feat: new harmony / melodic words and demo

crates/forth/src/ops.rs

@@ -113,6 +113,14 @@ pub enum Op {
     EuclidRot,
     Times,
     Chord(&'static [i64]),
+    Transpose,
+    Invert,
+    DownInvert,
+    VoiceDrop2,
+    VoiceDrop3,
+    SetKey,
+    DiatonicTriad(&'static [i64]),
+    DiatonicSeventh(&'static [i64]),
     // Audio-rate modulation DSL
     ModLfo(u8),
     ModSlide(u8),

crates/forth/src/theory/chords.rs

@@ -105,6 +105,47 @@ pub static CHORDS: &[Chord] = &[
         name: "madd9",
         intervals: &[0, 3, 7, 14],
     },
+    // Power chord
+    Chord {
+        name: "pwr",
+        intervals: &[0, 7],
+    },
+    // Suspended seventh
+    Chord {
+        name: "7sus4",
+        intervals: &[0, 5, 7, 10],
+    },
+    Chord {
+        name: "9sus4",
+        intervals: &[0, 5, 7, 10, 14],
+    },
+    // Augmented major
+    Chord {
+        name: "augmaj7",
+        intervals: &[0, 4, 8, 11],
+    },
+    // 6/9 chords
+    Chord {
+        name: "maj69",
+        intervals: &[0, 4, 7, 9, 14],
+    },
+    Chord {
+        name: "min69",
+        intervals: &[0, 3, 7, 9, 14],
+    },
+    // Extended
+    Chord {
+        name: "maj11",
+        intervals: &[0, 4, 7, 11, 14, 17],
+    },
+    Chord {
+        name: "maj13",
+        intervals: &[0, 4, 7, 11, 14, 21],
+    },
+    Chord {
+        name: "min13",
+        intervals: &[0, 3, 7, 10, 14, 21],
+    },
     // Altered dominants
     Chord {
         name: "dom7b9",
@@ -122,6 +163,10 @@ pub static CHORDS: &[Chord] = &[
         name: "dom7s5",
         intervals: &[0, 4, 8, 10],
     },
+    Chord {
+        name: "dom7s11",
+        intervals: &[0, 4, 7, 10, 18],
+    },
 ];
 
 pub fn lookup(name: &str) -> Option<&'static [i64]> {

crates/forth/src/vm.rs

@@ -133,6 +133,17 @@ impl Forth {
         let trace_cell = std::cell::RefCell::new(trace);
         let var_writes_cell = std::cell::RefCell::new(Some(var_writes));
 
+        let read_key = |vwc: &std::cell::RefCell<Option<&mut HashMap<String, Value>>>,
+                        vs: &VariablesMap|
+         -> i64 {
+            vwc.borrow()
+                .as_ref()
+                .and_then(|vw| vw.get("__key__"))
+                .or_else(|| vs.get("__key__"))
+                .and_then(|v| v.as_int().ok())
+                .unwrap_or(60)
+        };
+
         let run_quotation = |quot: Value,
                              stack: &mut Vec<Value>,
                              outputs: &mut Vec<String>,
@@ -955,15 +966,19 @@ impl Forth {
                     if pattern.is_empty() {
                         return Err("empty scale pattern".into());
                     }
-                    let val = pop(stack)?;
+                    ensure(stack, 1)?;
                     let len = pattern.len() as i64;
+                    let key = read_key(&var_writes_cell, vars_snapshot);
+                    let values = std::mem::take(stack);
+                    for val in values {
                         let result = lift_unary_int(val, |degree| {
                             let octave_offset = degree.div_euclid(len);
                             let idx = degree.rem_euclid(len) as usize;
-                        60 + octave_offset * 12 + pattern[idx]
+                            key + octave_offset * 12 + pattern[idx]
                         })?;
                         stack.push(result);
                     }
+                }
 
                 Op::Chord(intervals) => {
                     let root = pop_int(stack)?;
@@ -972,6 +987,87 @@ impl Forth {
                     }
                 }
 
+                Op::Transpose => {
+                    let n = pop_int(stack)?;
+                    for val in stack.iter_mut() {
+                        if let Value::Int(v, _) = val {
+                            *v += n;
+                        }
+                    }
+                }
+
+                Op::SetKey => {
+                    let key = pop_int(stack)?;
+                    var_writes_cell
+                        .borrow_mut()
+                        .as_mut()
+                        .expect("var_writes taken")
+                        .insert("__key__".to_string(), Value::Int(key, None));
+                }
+
+                Op::Invert => {
+                    ensure(stack, 2)?;
+                    let start = stack.iter().rposition(|v| !matches!(v, Value::Int(..))).map_or(0, |i| i + 1);
+                    let bottom = stack[start].as_int()? + 12;
+                    stack.remove(start);
+                    stack.push(Value::Int(bottom, None));
+                }
+
+                Op::DownInvert => {
+                    ensure(stack, 2)?;
+                    let top = pop_int(stack)? - 12;
+                    let start = stack.iter().rposition(|v| !matches!(v, Value::Int(..))).map_or(0, |i| i + 1);
+                    stack.insert(start, Value::Int(top, None));
+                }
+
+                Op::VoiceDrop2 => {
+                    ensure(stack, 3)?;
+                    let len = stack.len();
+                    let note = stack[len - 2].as_int()? - 12;
+                    stack.remove(len - 2);
+                    let start = stack.iter().rposition(|v| !matches!(v, Value::Int(..))).map_or(0, |i| i + 1);
+                    stack.insert(start, Value::Int(note, None));
+                }
+
+                Op::VoiceDrop3 => {
+                    ensure(stack, 4)?;
+                    let len = stack.len();
+                    let note = stack[len - 3].as_int()? - 12;
+                    stack.remove(len - 3);
+                    let start = stack.iter().rposition(|v| !matches!(v, Value::Int(..))).map_or(0, |i| i + 1);
+                    stack.insert(start, Value::Int(note, None));
+                }
+
+                Op::DiatonicTriad(pattern) => {
+                    if pattern.is_empty() {
+                        return Err("empty scale pattern".into());
+                    }
+                    let degree = pop_int(stack)?;
+                    let key = read_key(&var_writes_cell, vars_snapshot);
+                    let len = pattern.len() as i64;
+                    for offset in [0, 2, 4] {
+                        let d = degree + offset;
+                        let octave_offset = d.div_euclid(len);
+                        let idx = d.rem_euclid(len) as usize;
+                        stack.push(Value::Int(key + octave_offset * 12 + pattern[idx], None));
+                    }
+                }
+
+                Op::DiatonicSeventh(pattern) => {
+                    if pattern.is_empty() {
+                        return Err("empty scale pattern".into());
+                    }
+                    let degree = pop_int(stack)?;
+                    let key = read_key(&var_writes_cell, vars_snapshot);
+                    let len = pattern.len() as i64;
+                    for offset in [0, 2, 4, 6] {
+                        let d = degree + offset;
+                        let octave_offset = d.div_euclid(len);
+                        let idx = d.rem_euclid(len) as usize;
+                        stack.push(Value::Int(key + octave_offset * 12 + pattern[idx], None));
+                    }
+                }
+
                 Op::Oct => {
                     let shift = pop(stack)?;
                     let note = pop(stack)?;

crates/forth/src/words/compile.rs

@@ -108,6 +108,12 @@ pub(super) fn simple_op(name: &str) -> Option<Op> {
         "mstop" => Op::MidiStop,
         "mcont" => Op::MidiContinue,
         "forget" => Op::Forget,
+        "key!" => Op::SetKey,
+        "tp" => Op::Transpose,
+        "inv" => Op::Invert,
+        "dinv" => Op::DownInvert,
+        "drop2" => Op::VoiceDrop2,
+        "drop3" => Op::VoiceDrop3,
         "lfo" => Op::ModLfo(0),
         "tlfo" => Op::ModLfo(1),
         "wlfo" => Op::ModLfo(2),
@@ -227,6 +233,20 @@ pub(crate) fn compile_word(
         _ => {}
     }
 
+    if name == "triad" || name == "seventh" {
+        if let Some(Op::Degree(pattern)) = ops.last() {
+            let pattern = *pattern;
+            ops.pop();
+            ops.push(if name == "triad" {
+                Op::DiatonicTriad(pattern)
+            } else {
+                Op::DiatonicSeventh(pattern)
+            });
+            return true;
+        }
+        return false;
+    }
+
     if let Some(pattern) = theory::lookup(name) {
         ops.push(Op::Degree(pattern));
         return true;

crates/forth/src/words/music.rs

@@ -23,7 +23,100 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: false,
     },
+    // Harmony
+    Word {
+        name: "key!",
+        aliases: &[],
+        category: "Harmony",
+        stack: "(root --)",
+        desc: "Set tonal center for scale operations",
+        example: "g3 key! 0 major => 55",
+        compile: Simple,
+        varargs: false,
+    },
+    Word {
+        name: "triad",
+        aliases: &[],
+        category: "Harmony",
+        stack: "(degree -- n1 n2 n3)",
+        desc: "Diatonic triad from scale degree (follows a scale word)",
+        example: "0 major triad => 60 64 67",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "seventh",
+        aliases: &[],
+        category: "Harmony",
+        stack: "(degree -- n1 n2 n3 n4)",
+        desc: "Diatonic seventh from scale degree (follows a scale word)",
+        example: "0 major seventh => 60 64 67 71",
+        compile: Simple,
+        varargs: true,
+    },
+    // Chord voicings
+    Word {
+        name: "inv",
+        aliases: &[],
+        category: "Chord",
+        stack: "(a b c.. -- b c.. a+12)",
+        desc: "Inversion: bottom note moves up an octave",
+        example: "c4 maj inv => 64 67 72",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "dinv",
+        aliases: &[],
+        category: "Chord",
+        stack: "(a b.. z -- z-12 a b..)",
+        desc: "Down inversion: top note moves down an octave",
+        example: "c4 maj dinv => 55 60 64",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "drop2",
+        aliases: &[],
+        category: "Chord",
+        stack: "(a b c d -- b-12 a c d)",
+        desc: "Drop-2 voicing: 2nd from top moves down an octave",
+        example: "c4 maj7 drop2 => 55 60 64 71",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "drop3",
+        aliases: &[],
+        category: "Chord",
+        stack: "(a b c d -- c-12 a b d)",
+        desc: "Drop-3 voicing: 3rd from top moves down an octave",
+        example: "c4 maj7 drop3 => 52 60 67 71",
+        compile: Simple,
+        varargs: true,
+    },
+    // Transpose
+    Word {
+        name: "tp",
+        aliases: &[],
+        category: "Harmony",
+        stack: "(n --)",
+        desc: "Transpose all ints on stack by N semitones",
+        example: "c4 maj 3 tp => 63 67 70",
+        compile: Simple,
+        varargs: true,
+    },
     // Chords - Triads
+    Word {
+        name: "pwr",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root fifth)",
+        desc: "Power chord",
+        example: "c4 pwr => 60 67",
+        compile: Simple,
+        varargs: true,
+    },
     Word {
         name: "maj",
         aliases: &[],
@@ -155,6 +248,36 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: true,
     },
+    Word {
+        name: "augmaj7",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth seventh)",
+        desc: "Augmented major 7th",
+        example: "c4 augmaj7 => 60 64 68 71",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "7sus4",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root fourth fifth seventh)",
+        desc: "Dominant 7 sus4",
+        example: "c4 7sus4 => 60 65 67 70",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "9sus4",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root fourth fifth seventh ninth)",
+        desc: "9 sus4",
+        example: "c4 9sus4 => 60 65 67 70 74",
+        compile: Simple,
+        varargs: true,
+    },
     // Chords - Sixth
     Word {
         name: "maj6",
@@ -176,6 +299,26 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: true,
     },
+    Word {
+        name: "maj69",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth sixth ninth)",
+        desc: "Major 6/9",
+        example: "c4 maj69 => 60 64 67 69 74",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "min69",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth sixth ninth)",
+        desc: "Minor 6/9",
+        example: "c4 min69 => 60 63 67 69 74",
+        compile: Simple,
+        varargs: true,
+    },
     // Chords - Extended
     Word {
         name: "dom9",
@@ -217,6 +360,16 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: true,
     },
+    Word {
+        name: "maj11",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth seventh ninth eleventh)",
+        desc: "Major 11th",
+        example: "c4 maj11 => 60 64 67 71 74 77",
+        compile: Simple,
+        varargs: true,
+    },
     Word {
         name: "min11",
         aliases: &[],
@@ -237,6 +390,26 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: true,
     },
+    Word {
+        name: "maj13",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth seventh ninth thirteenth)",
+        desc: "Major 13th",
+        example: "c4 maj13 => 60 64 67 71 74 81",
+        compile: Simple,
+        varargs: true,
+    },
+    Word {
+        name: "min13",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth seventh ninth thirteenth)",
+        desc: "Minor 13th",
+        example: "c4 min13 => 60 63 67 70 74 81",
+        compile: Simple,
+        varargs: true,
+    },
     // Chords - Add
     Word {
         name: "add9",
@@ -309,4 +482,14 @@ pub(super) const WORDS: &[Word] = &[
         compile: Simple,
         varargs: true,
     },
+    Word {
+        name: "dom7s11",
+        aliases: &[],
+        category: "Chord",
+        stack: "(root -- root third fifth seventh sharpelev)",
+        desc: "7th sharp 11 (lydian dominant)",
+        example: "c4 dom7s11 => 60 64 67 70 78",
+        compile: Simple,
+        varargs: true,
+    },
 ];

demos/02.cagire

@@ -7,7 +7,11 @@
           "steps": [
             {
               "i": 0,
-              "script": "saw sound ."
+              "script": "0 8 12 rand ..\nc3 c4 g3 g2 4 pcycle key!\n0 1 2 choose 2\n6 12 rand pentatonic\n{ inv } rarely\n{ inv } sometimes arp note\ngrain sound 2 8 rand decay \n2 vib 0.125 2 / vibmod\n0.01 1.0 exprand pan\n2 release\n0.8 verb 1.0 verbdiff\n0.2 chorus\n1 morph\n0.0 1.0 rand \n0.0 1.0 rand timbre\n0.5 gain\n0.8 sustain\n2 8 rand release\n."
+            },
+            {
+              "i": 4,
+              "script": "0 12 20 rand ..\nc3 c4 g3 g2 4 pcycle key!\n0 1 2 choose 2\n6 12 rand pentatonic\n{ inv } rarely\n{ inv } sometimes arp note\ngrain sound 2 8 rand decay \n2 vib 0.125 2 / vibmod\n0.01 1.0 exprand pan\n10 16 rand release\n0.8 verb 1.0 verbdiff\n0.2 chorus\n1 morph\n0.0 1.0 rand 0.0 1.0 rand timbre\n0.5 gain\n{ . } 2 every"
             }
           ],
           "length": 16,
@@ -8366,5 +8370,6 @@
       0,
       0
     ]
-  ]
+  ],
+  "prelude": ";; BIG VOICES"
 }

tests/forth.rs

@@ -63,3 +63,6 @@ mod euclidean;
 
 #[path = "forth/case_statement.rs"]
 mod case_statement;
+
+#[path = "forth/harmony.rs"]
+mod harmony;

tests/forth/chords.rs

@@ -158,6 +158,68 @@ fn chord_dom7s5() {
     expect_stack("c4 dom7s5", &ints(&[60, 64, 68, 70]));
 }
 
+// Power chord
+
+#[test]
+fn chord_power() {
+    expect_stack("c4 pwr", &ints(&[60, 67]));
+}
+
+// Suspended seventh
+
+#[test]
+fn chord_7sus4() {
+    expect_stack("c4 7sus4", &ints(&[60, 65, 67, 70]));
+}
+
+#[test]
+fn chord_9sus4() {
+    expect_stack("c4 9sus4", &ints(&[60, 65, 67, 70, 74]));
+}
+
+// Augmented major
+
+#[test]
+fn chord_augmaj7() {
+    expect_stack("c4 augmaj7", &ints(&[60, 64, 68, 71]));
+}
+
+// 6/9 chords
+
+#[test]
+fn chord_maj69() {
+    expect_stack("c4 maj69", &ints(&[60, 64, 67, 69, 74]));
+}
+
+#[test]
+fn chord_min69() {
+    expect_stack("c4 min69", &ints(&[60, 63, 67, 69, 74]));
+}
+
+// Extended - major
+
+#[test]
+fn chord_maj11() {
+    expect_stack("c4 maj11", &ints(&[60, 64, 67, 71, 74, 77]));
+}
+
+#[test]
+fn chord_maj13() {
+    expect_stack("c4 maj13", &ints(&[60, 64, 67, 71, 74, 81]));
+}
+
+#[test]
+fn chord_min13() {
+    expect_stack("c4 min13", &ints(&[60, 63, 67, 70, 74, 81]));
+}
+
+// Altered - lydian dominant
+
+#[test]
+fn chord_dom7s11() {
+    expect_stack("c4 dom7s11", &ints(&[60, 64, 67, 70, 78]));
+}
+
 // Different roots
 
 #[test]

tests/forth/harmony.rs

@@ -0,0 +1,193 @@
+use cagire::forth::Value;
+
+use super::harness::{expect_error, expect_int, expect_stack};
+
+fn ints(vals: &[i64]) -> Vec<Value> {
+    vals.iter().map(|&v| Value::Int(v, None)).collect()
+}
+
+// Inversions
+
+#[test]
+fn invert_major_triad() {
+    expect_stack("c4 maj inv", &ints(&[64, 67, 72]));
+}
+
+#[test]
+fn invert_twice() {
+    expect_stack("c4 maj inv inv", &ints(&[67, 72, 76]));
+}
+
+#[test]
+fn down_invert_major_triad() {
+    expect_stack("c4 maj dinv", &ints(&[55, 60, 64]));
+}
+
+#[test]
+fn down_invert_min7() {
+    expect_stack("c4 min7 dinv", &ints(&[58, 60, 63, 67]));
+}
+
+#[test]
+fn invert_min7() {
+    expect_stack("c4 min7 inv", &ints(&[63, 67, 70, 72]));
+}
+
+// Voicings
+
+#[test]
+fn drop2_maj7() {
+    // c4 maj7 = [60, 64, 67, 71], 2nd from top = 67, drop to 55
+    expect_stack("c4 maj7 drop2", &ints(&[55, 60, 64, 71]));
+}
+
+#[test]
+fn drop3_maj7() {
+    // c4 maj7 = [60, 64, 67, 71], 3rd from top = 64, drop to 52
+    expect_stack("c4 maj7 drop3", &ints(&[52, 60, 67, 71]));
+}
+
+// Key
+
+#[test]
+fn key_sets_tonal_center() {
+    expect_int("g3 key! 0 major", 55);
+}
+
+#[test]
+fn key_with_degree() {
+    // G3=55, degree 4 of major = semitone 7, so 55+7=62
+    expect_int("g3 key! 4 major", 62);
+}
+
+#[test]
+fn key_default_is_c4() {
+    expect_int("0 major", 60);
+}
+
+#[test]
+fn key_a3_minor() {
+    expect_int("a3 key! 0 minor", 57);
+}
+
+// Diatonic triads
+
+#[test]
+fn diatonic_triad_degree_0() {
+    // C major: degrees 0,2,4 = C,E,G = 60,64,67
+    expect_stack("0 major triad", &ints(&[60, 64, 67]));
+}
+
+#[test]
+fn diatonic_triad_degree_1() {
+    // D minor: degrees 1,3,5 = D,F,A = 62,65,69
+    expect_stack("1 major triad", &ints(&[62, 65, 69]));
+}
+
+#[test]
+fn diatonic_triad_degree_3() {
+    // F major: degrees 3,5,7(=0+12) = F,A,C = 65,69,72
+    expect_stack("3 major triad", &ints(&[65, 69, 72]));
+}
+
+#[test]
+fn diatonic_triad_degree_4() {
+    // G major: degrees 4,6,8(=1+12) = G,B,D = 67,71,74
+    expect_stack("4 major triad", &ints(&[67, 71, 74]));
+}
+
+// Diatonic sevenths
+
+#[test]
+fn diatonic_seventh_degree_0() {
+    // C major7: degrees 0,2,4,6 = C,E,G,B = 60,64,67,71
+    expect_stack("0 major seventh", &ints(&[60, 64, 67, 71]));
+}
+
+#[test]
+fn diatonic_seventh_degree_1() {
+    // D minor7: degrees 1,3,5,7(=0+12) = D,F,A,C = 62,65,69,72
+    expect_stack("1 major seventh", &ints(&[62, 65, 69, 72]));
+}
+
+#[test]
+fn diatonic_seventh_degree_4() {
+    // G dom7: degrees 4,6,8(=1+12),10(=3+12) = G,B,D,F = 67,71,74,77
+    expect_stack("4 major seventh", &ints(&[67, 71, 74, 77]));
+}
+
+// Combined
+
+#[test]
+fn key_with_diatonic_triad() {
+    // G3=55 key, degree 0 major triad = G,B,D = 55,59,62
+    expect_stack("g3 key! 0 major triad", &ints(&[55, 59, 62]));
+}
+
+#[test]
+fn key_with_triad_inv() {
+    // C4 key, degree 0 minor triad = C,Eb,G = 60,63,67, then inv = Eb,G,C+12 = 63,67,72
+    expect_stack("0 minor triad inv", &ints(&[63, 67, 72]));
+}
+
+#[test]
+fn key_degree_4_triad_in_g() {
+    // G3=55, degree 4 of major = notes at degrees 4,6,8(=1+12)
+    // major pattern: [0,2,4,5,7,9,11]
+    // degree 4 -> semitone 7, degree 6 -> semitone 11, degree 8(=1+12) -> 12+2=14
+    // 55+7=62, 55+11=66, 55+14=69 -> D, F#, A
+    expect_stack("g3 key! 4 major triad", &ints(&[62, 66, 69]));
+}
+
+// Backwards compatibility
+
+#[test]
+fn scale_degree_still_works() {
+    expect_int("0 major", 60);
+    expect_int("7 major", 72);
+}
+
+#[test]
+fn chords_still_work() {
+    expect_stack("c4 maj", &ints(&[60, 64, 67]));
+    expect_stack("c4 min7", &ints(&[60, 63, 67, 70]));
+}
+
+// Transpose
+
+#[test]
+fn transpose_major_triad() {
+    expect_stack("c4 maj 3 tp", &ints(&[63, 67, 70]));
+}
+
+#[test]
+fn transpose_down() {
+    expect_stack("c4 maj -2 tp", &ints(&[58, 62, 65]));
+}
+
+#[test]
+fn transpose_zero() {
+    expect_stack("c4 maj 0 tp", &ints(&[60, 64, 67]));
+}
+
+#[test]
+fn transpose_single_note() {
+    expect_int("60 7 tp", 67);
+}
+
+#[test]
+fn transpose_octave() {
+    expect_stack("c4 min7 12 tp", &ints(&[72, 75, 79, 82]));
+}
+
+// Error cases
+
+#[test]
+fn triad_without_scale_errors() {
+    expect_error("0 triad", "unknown word");
+}
+
+#[test]
+fn seventh_without_scale_errors() {
+    expect_error("0 seventh", "unknown word");
+}