diff --git a/crates/forth/src/ops.rs b/crates/forth/src/ops.rs index 003700d..d20e479 100644 --- a/crates/forth/src/ops.rs +++ b/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), diff --git a/crates/forth/src/theory/chords.rs b/crates/forth/src/theory/chords.rs index 9f595cc..caf1180 100644 --- a/crates/forth/src/theory/chords.rs +++ b/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]> { diff --git a/crates/forth/src/vm.rs b/crates/forth/src/vm.rs index a74c9bc..bf626d0 100644 --- a/crates/forth/src/vm.rs +++ b/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>>, + 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, outputs: &mut Vec, @@ -955,14 +966,18 @@ 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 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] - })?; - stack.push(result); + 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; + key + octave_offset * 12 + pattern[idx] + })?; + stack.push(result); + } } Op::Chord(intervals) => { @@ -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)?; diff --git a/crates/forth/src/words/compile.rs b/crates/forth/src/words/compile.rs index 3297810..dd3cd26 100644 --- a/crates/forth/src/words/compile.rs +++ b/crates/forth/src/words/compile.rs @@ -108,6 +108,12 @@ pub(super) fn simple_op(name: &str) -> Option { "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; diff --git a/crates/forth/src/words/music.rs b/crates/forth/src/words/music.rs index b1e64d1..adbf0a7 100644 --- a/crates/forth/src/words/music.rs +++ b/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, + }, ]; diff --git a/demos/02.cagire b/demos/02.cagire index 2a5a85c..44ff314 100644 --- a/demos/02.cagire +++ b/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" } \ No newline at end of file diff --git a/tests/forth.rs b/tests/forth.rs index b78926c..ad504fb 100644 --- a/tests/forth.rs +++ b/tests/forth.rs @@ -63,3 +63,6 @@ mod euclidean; #[path = "forth/case_statement.rs"] mod case_statement; + +#[path = "forth/harmony.rs"] +mod harmony; diff --git a/tests/forth/chords.rs b/tests/forth/chords.rs index 6ceb0ff..aa1ff61 100644 --- a/tests/forth/chords.rs +++ b/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] diff --git a/tests/forth/harmony.rs b/tests/forth/harmony.rs new file mode 100644 index 0000000..faf77b2 --- /dev/null +++ b/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 { + 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"); +}