X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fchord-entry.scm;h=23601a8deaba4e54a3014c0b2fcdc8dd9c324dd1;hb=97a0169312a260933246ab224e4f8b0969871dd5;hp=ec95dff287f0ba2385d79702bfcb73754d210ec2;hpb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;p=lilypond.git diff --git a/scm/chord-entry.scm b/scm/chord-entry.scm index ec95dff287..23601a8dea 100644 --- a/scm/chord-entry.scm +++ b/scm/chord-entry.scm @@ -18,6 +18,8 @@ ;; for define-safe-public when byte-compiling using Guile V2 (use-modules (scm safe-utility-defs) (ice-9 receive)) +(define-session-public chordmodifiers '()) + (define-public (construct-chord-elements root duration modifications) "Build a chord on root using modifiers in @var{modifications}. @code{NoteEvents} have duration @var{duration}. @@ -32,6 +34,8 @@ Entry point for the parser." (inversion #f) (lead-mod #f) (explicit-11 #f) + (explicit-2/4 #f) + (omit-3 #f) (start-additions #t)) (define (interpret-inversion chord mods) @@ -49,7 +53,8 @@ Entry point for the parser." (set! bass (cadr mods)) (set! mods (cddr mods)))) (if (pair? mods) - (ly:warning (_ "Spurious garbage following chord: ~A") mods)) + (ly:parser-error + (format #f (_ "Spurious garbage following chord: ~A") mods))) chord) (define (interpret-removals chord mods) @@ -66,8 +71,10 @@ Entry point for the parser." "Interpret additions. TODO: should restrict modifier use?" (cond ((null? mods) chord) ((ly:pitch? (car mods)) - (if (= (pitch-step (car mods)) 11) - (set! explicit-11 #t)) + (case (pitch-step (car mods)) + ((11) (set! explicit-11 #t)) + ((2 4) (set! explicit-2/4 #t)) + ((3) (set! omit-3 #f))) (interpret-additions (cons (car mods) (remove-step (pitch-step (car mods)) chord)) (cdr mods))) ((procedure? (car mods)) @@ -129,8 +136,10 @@ the bass specified. (ly:pitch? (car flat-mods)) (not (eq? lead-mod sus-modifier))) (begin - (if (= (pitch-step (car flat-mods)) 11) - (set! explicit-11 #t)) + (cond ((= (pitch-step (car flat-mods)) 11) + (set! explicit-11 #t)) + ((equal? (ly:make-pitch 0 4 0) (car flat-mods)) + (set! omit-3 #t))) (set! base-chord (stack-thirds (car flat-mods) the-canonical-chord)) (set! flat-mods (cdr flat-mods)))) @@ -141,6 +150,10 @@ the bass specified. (if start-additions (interpret-additions base-chord flat-mods) (interpret-removals base-chord flat-mods))) + ;; if sus has been given neither 2 or 4, we add 4. + (if (and (eq? lead-mod sus-modifier) + (not explicit-2/4)) + (set! complete-chord (cons (ly:make-pitch 0 4 0) complete-chord))) (set! complete-chord (sort complete-chord ly:pitch