X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=fd950bf28a08899c1c23ba50c588e25b3fbf98f9;hb=cfc4cbf34569db6a6c8968694f86e36b206a9d05;hp=928eaf71692a5cf06c4f58fd480e3f7c290fab22;hpb=264d51268e3ba26d6fb8cff9e5ba3d7e08f9de77;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 928eaf7169..fd950bf28a 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2006 Jan Nieuwenhuizen +;;;; (c) 1998--2009 Jan Nieuwenhuizen ;;;; Han-Wen Nienhuys ;; (use-modules (ice-9 optargs)) @@ -233,13 +233,11 @@ Returns `obj'. (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) (if (equal? name "tremolo") - (let* ((dot? (zero? (modulo times 3))) - (dots (if dot? 1 0)) - (mult (if dot? - (quotient (* times 2) 3) - times)) - (shift (- (ly:intlog2 mult)))) - + (let* ((dots (1- (logcount times))) + (mult (/ (* times (ash 1 dots)) (1- (ash 2 dots)))) + (shift (- (ly:intlog2 (floor mult))))) + (if (not (integer? mult)) + (ly:warning (_ "invalid tremolo repeat count: ~a") times)) (if (memq 'sequential-music (ly:music-property main 'types)) ;; \repeat "tremolo" { c4 d4 } (let ((children (length (ly:music-property main 'elements)))) @@ -342,7 +340,18 @@ i.e. this is not an override" 'grob-property gprop)) (define direction-polyphonic-grobs - '(Stem Tie Rest Slur PhrasingSlur Script TextScript Dots DotColumn Fingering)) + '(DotColumn + Dots + Fingering + LaissezVibrerTie + PhrasingSlur + RepeatTie + Rest + Script + Slur + Stem + TextScript + Tie)) (define-safe-public (make-voice-props-set n) (make-sequential-music @@ -360,7 +369,11 @@ i.e. this is not an override" (Voice Stem no-stem-extend #t) (Voice Beam thickness 0.384) (Voice Beam length-fraction 0.8) - (Voice Accidental font-size -4))) + (Voice Accidental font-size -4) + (Voice AccidentalCautionary font-size -4) + (Voice Script font-size -3) + (Voice Fingering font-size -8) + (Voice StringNumber font-size -8))) (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) @@ -441,27 +454,20 @@ i.e. this is not an override" "Either reset middleCPosition to the stored original, or remember old middleCPosition, add OCTAVATION to middleCPosition, and set OTTAVATION to `8va', or whatever appropriate." - (if (number? (ly:context-property context 'middleCPosition)) - (begin - (if (number? (ly:context-property context 'originalMiddleCPosition)) - (let ((where (ly:context-property-where-defined context 'middleCPosition))) - - (ly:context-set-property! context 'middleCPosition - (ly:context-property context 'originalMiddleCPosition)) - (ly:context-unset-property where 'originalMiddleCPosition) - (ly:context-unset-property where 'ottavation))) -ot - (let* ((where (ly:context-property-where-defined context 'middleCPosition)) - (c0 (ly:context-property context 'middleCPosition)) - (new-c0 (+ c0 (* -7 octavation))) - (string (cdr (assoc octavation '((2 . "15ma") - (1 . "8va") - (0 . #f) - (-1 . "8vb") - (-2 . "15mb")))))) - (ly:context-set-property! context 'middleCPosition new-c0) - (ly:context-set-property! context 'originalMiddleCPosition c0) - (ly:context-set-property! context 'ottavation string))))) + (if (number? (ly:context-property context 'middleCOffset)) + (let ((where (ly:context-property-where-defined context 'middleCOffset))) + (ly:context-unset-property where 'middleCOffset) + (ly:context-unset-property where 'ottavation))) + + (let* ((offset (* -7 octavation)) + (string (cdr (assoc octavation '((2 . "15ma") + (1 . "8va") + (0 . #f) + (-1 . "8vb") + (-2 . "15mb")))))) + (ly:context-set-property! context 'middleCOffset offset) + (ly:context-set-property! context 'ottavation string) + (ly:set-middle-C! context))) (set! (ly:music-property m 'procedure) ottava-modify) (context-spec-music m 'Staff))) @@ -477,17 +483,29 @@ of beat groupings " "Some standard subdivisions for time signatures." (let* ((key (cons num den)) - (entry (assoc key '(((6 . 8) . (3 3)) - ((5 . 8) . (3 2)) - ((9 . 8) . (3 3 3)) - ((12 . 8) . (3 3 3 3)) - ((8 . 8) . (3 3 2)) - )))) + (entry (assoc key '( + ; Simple time signatures + (( 3 . 8) . (3)) + (( 4 . 8) . (2 2)) + ; Compound time signatures + (( 6 . 4) . (3 3)) + (( 6 . 8) . (3 3)) + (( 6 . 16) . (3 3)) + (( 9 . 4) . (3 3 3)) + (( 9 . 8) . (3 3 3)) + (( 9 . 16) . (3 3 3)) + ((12 . 4) . (3 3 3 3)) + ((12 . 8) . (3 3 3 3)) + ((12 . 16) . (3 3 3 3)) + ; Some common irregular time signatures + (( 5 . 8) . (3 2)) + (( 8 . 8) . (3 3 2)) + )))) (if entry (cdr entry) - '()))) - + '()))) + (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) (beat (ly:make-moment 1 den)) (len (ly:make-moment num den)) @@ -687,7 +705,6 @@ SkipEvent. Useful for extracting parts from crowded scores" ((< i 0)) (f (vector-ref v i)))) -;; TODO: make a remove-grace-property too. (define-public (add-grace-property context-name grob sym val) "Set SYM=VAL for GROB in CONTEXT-NAME. " (define (set-prop context) @@ -698,10 +715,31 @@ SkipEvent. Useful for extracting parts from crowded scores" (ly:context-set-property! where 'graceSettings new-settings))) (ly:export (context-spec-music (make-apply-context set-prop) 'Voice))) +(define-public (remove-grace-property context-name grob sym) + "Remove all SYM for GROB in CONTEXT-NAME. " + (define (sym-grob-context? property sym grob context-name) + (and (eq? (car property) context-name) + (eq? (cadr property) grob) + (eq? (caddr property) sym))) + (define (delete-prop context) + (let* ((where (ly:context-property-where-defined context 'graceSettings)) + (current (ly:context-property where 'graceSettings)) + (prop-settings (filter + (lambda(x) (sym-grob-context? x sym grob context-name)) + current)) + (new-settings current)) + (for-each (lambda(x) + (set! new-settings (delete x new-settings))) + prop-settings) + (ly:context-set-property! where 'graceSettings new-settings))) + (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice))) -(defmacro-public def-grace-function (start stop) + +(defmacro-public def-grace-function (start stop . docstring) + "Helper macro for defining grace music" `(define-music-function (parser location music) (ly:music?) + ,@docstring (make-music 'GraceMusic 'origin location 'element (make-music 'SequentialMusic @@ -715,9 +753,18 @@ Syntax: (define-music-function (parser location arg1 arg2 ...) (arg1-type? arg2-type? ...) ...function body...) " - `(ly:make-music-function (list ,@signature) - (lambda (,@args) - ,@body))) +(if (and (pair? body) (pair? (car body)) (eqv? '_i (caar body))) + ;; When the music function definition contains a i10n doc string, + ;; (_i "doc string"), keep the literal string only + (let ((docstring (cadar body)) + (body (cdr body))) + `(ly:make-music-function (list ,@signature) + (lambda (,@args) + ,docstring + ,@body))) + `(ly:make-music-function (list ,@signature) + (lambda (,@args) + ,@body)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -803,41 +850,94 @@ Syntax: (ly:music-length music)) music) -(define (skip-to-last music parser) +(define-public (make-duration-of-length moment) + "Make duration of the given MOMENT length." + (ly:make-duration 0 0 + (ly:moment-main-numerator moment) + (ly:moment-main-denominator moment))) - "Replace MUSIC by +(define (skip-this moment) + "set skipTypesetting, make SkipMusic of the given MOMENT length, + and then unset skipTypesetting." + (make-sequential-music + (list + (context-spec-music (make-property-set 'skipTypesetting #t) + 'Score) + (make-music 'SkipMusic 'duration + (make-duration-of-length moment)) + (context-spec-music (make-property-set 'skipTypesetting #f) + 'Score)))) + +(define (unskip-this moment) + "unset skipTypesetting, make SkipMusic of the given MOMENT length, + and then set skipTypesetting." + (make-sequential-music + (list + (context-spec-music (make-property-set 'skipTypesetting #f) + 'Score) + (make-music 'SkipMusic 'duration + (make-duration-of-length moment)) + (context-spec-music (make-property-set 'skipTypesetting #t) + 'Score)))) + +(define (skip-as-needed music parser) + "Replace MUSIC by + << { \\set skipTypesetting = ##f + LENGTHOF(\\showFirstLength) + \\set skipTypesetting = ##t + LENGTHOF(\\showLastLength) } + MUSIC >> + if appropriate. + + When only showFirstLength is set, + the 'length property of the music is + overridden to speed up compiling." + (let* + ((show-last (ly:parser-lookup parser 'showLastLength)) + (show-first (ly:parser-lookup parser 'showFirstLength))) + (cond + + ;; both properties may be set. + ((and (ly:music? show-first) (ly:music? show-last)) + (let* + ((orig-length (ly:music-length music)) + (skip-length (ly:moment-sub orig-length (ly:music-length show-last))) + (begin-length (ly:music-length show-first))) + (make-simultaneous-music + (list + (make-sequential-music + (list + (skip-this skip-length) + ;; let's draw a separator between the beginning and the end + (context-spec-music (make-property-set 'whichBar "||") + 'Timing))) + (unskip-this begin-length) + music)))) + + ;; we may only want to print the last length + ((ly:music? show-last) + (let* + ((orig-length (ly:music-length music)) + (skip-length (ly:moment-sub orig-length (ly:music-length show-last)))) + (make-simultaneous-music + (list + (skip-this skip-length) + music)))) + + ;; we may only want to print the beginning; in this case + ;; only the first length will be processed (much faster). + ((ly:music? show-first) + (let* + ((orig-length (ly:music-length music)) + (begin-length (ly:music-length show-first))) + ;; the first length must not exceed the original length. + (if (ly:moment> + (else music)))) -if appropriate. - " - (let* - ((show-last (ly:parser-lookup parser 'showLastLength))) - - (if (ly:music? show-last) - (let* - ((orig-length (ly:music-length music)) - (skip-length (ly:moment-sub orig-length (ly:music-length show-last)))) - - (make-simultaneous-music - (list - (make-sequential-music - (list - (context-spec-music (make-property-set 'skipTypesetting #t) - 'Score) - (make-music 'SkipMusic 'duration - (ly:make-duration - 0 0 - (ly:moment-main-numerator skip-length) - (ly:moment-main-denominator skip-length))) - (context-spec-music (make-property-set 'skipTypesetting #f) - 'Score))) - music))) - music))) - (define-public toplevel-music-functions (list @@ -852,9 +952,19 @@ if appropriate. (lambda (x parser) (music-map cue-substitute x)) (lambda (x parser) - (skip-to-last x parser) + (skip-as-needed x parser) ))) +;;;;;;;;;; +;;; general purpose music functions + +(define (shift-octave pitch octave-shift) + (_i "Add @var{octave-shift} to the octave of @var{pitch}.") + (ly:make-pitch + (+ (ly:pitch-octave pitch) octave-shift) + (ly:pitch-notename pitch) + (ly:pitch-alteration pitch))) + ;;;;;;;;;;;;;;;;; ;; lyrics @@ -873,6 +983,200 @@ if appropriate. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; accidentals +(define (recent-enough? bar-number alteration-def laziness) + (if (or (number? alteration-def) + (equal? laziness #t)) + #t + (<= bar-number (+ (cadr alteration-def) laziness)))) + +(define (is-tied? alteration-def) + (let* ((def (if (pair? alteration-def) + (car alteration-def) + alteration-def))) + + (if (equal? def 'tied) #t #f))) + +(define (extract-alteration alteration-def) + (cond ((number? alteration-def) + alteration-def) + ((pair? alteration-def) + (car alteration-def)) + (else 0))) + +(define (check-pitch-against-signature context pitch barnum laziness octaveness) + "Checks the need for an accidental and a @q{restore} accidental against +@code{localKeySignature}. The @var{laziness} is the number of measures +for which reminder accidentals are used (i.e., if @var{laziness} is zero, +only cancel accidentals in the same measure; if @var{laziness} is three, +we cancel accidentals up to three measures after they first appear. +@var{octaveness} is either @code{'same-octave} or @code{'any-octave} and +specifies whether accidentals should be canceled in different octaves." + (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t) + ((equal? octaveness 'same-octave) #f) + (else + (ly:warning (_ "Unknown octaveness type: ~S ") octaveness) + (ly:warning (_ "Defaulting to 'any-octave.")) + #t))) + (key-sig (ly:context-property context 'keySignature)) + (local-key-sig (ly:context-property context 'localKeySignature)) + (notename (ly:pitch-notename pitch)) + (octave (ly:pitch-octave pitch)) + (pitch-handle (cons octave notename)) + (need-restore #f) + (need-accidental #f) + (previous-alteration #f) + (from-other-octaves #f) + (from-same-octave (ly:assoc-get pitch-handle local-key-sig)) + (from-key-sig (ly:assoc-get notename local-key-sig))) + + ;; If no key signature match is found from localKeySignature, we may have a custom + ;; type with octave-specific entries of the form ((octave . pitch) alteration) + ;; instead of (pitch . alteration). Since this type cannot coexist with entries in + ;; localKeySignature, try extracting from keySignature instead. + (if (equal? from-key-sig #f) + (set! from-key-sig (ly:assoc-get pitch-handle key-sig))) + + ;; loop through localKeySignature to search for a notename match from other octaves + (let loop ((l local-key-sig)) + (if (pair? l) + (let ((entry (car l))) + (if (and (pair? (car entry)) + (= (cdar entry) notename)) + (set! from-other-octaves (cdr entry)) + (loop (cdr l)))))) + + ;; find previous alteration-def for comparison with pitch + (cond + ;; from same octave? + ((and (eq? ignore-octave #f) + (not (equal? from-same-octave #f)) + (recent-enough? barnum from-same-octave laziness)) + (set! previous-alteration from-same-octave)) + + ;; from any octave? + ((and (eq? ignore-octave #t) + (not (equal? from-other-octaves #f)) + (recent-enough? barnum from-other-octaves laziness)) + (set! previous-alteration from-other-octaves)) + + ;; not recent enough, extract from key signature/local key signature + ((not (equal? from-key-sig #f)) + (set! previous-alteration from-key-sig))) + + (if (is-tied? previous-alteration) + (set! need-accidental #t) + + (let* ((prev-alt (extract-alteration previous-alteration)) + (this-alt (ly:pitch-alteration pitch))) + + (if (not (= this-alt prev-alt)) + (begin + (set! need-accidental #t) + (if (and (not (= this-alt 0)) + (or (< (abs this-alt) (abs prev-alt)) + (< (* prev-alt this-alt) 0))) + (set! need-restore #t)))))) + + (cons need-restore need-accidental))) + +(define-public ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) + "Creates an accidental rule that makes its decision based on the octave of the note + and a laziness value. + octaveness is either 'same-octave or 'any-octave and defines whether the rule should + respond to accidental changes in other octaves than the current. 'same-octave is the + normal way to typeset accidentals - an accidental is made if the alteration is different + from the last active pitch in the same octave. 'any-octave looks at the last active pitch + in any octave. + laziness states over how many bars an accidental should be remembered. + 0 is default - accidental lasts over 0 bar lines, that is, to the end of current measure. + A positive integer means that the accidental lasts over that many bar lines. + -1 is 'forget immediately', that is, only look at key signature. + #t is forever." + (check-pitch-against-signature context pitch barnum laziness octaveness)) + +(define (key-entry-notename entry) + "Return the pitch of an entry in localKeySignature. The entry is either of the form + '(notename . alter) or '((octave . notename) . (alter barnum . measurepos))." + (if (number? (car entry)) + (car entry) + (cdar entry))) + +(define (key-entry-octave entry) + "Return the octave of an entry in localKeySignature (or #f if the entry does not have + an octave)." + (and (pair? (car entry)) (caar entry))) + +(define (key-entry-bar-number entry) + "Return the bar number of an entry in localKeySignature (or #f if the entry does not + have a bar number)." + (and (pair? (car entry)) (caddr entry))) + +(define (key-entry-measure-position entry) + "Return the measure position of an entry in localKeySignature (or #f if the entry does + not have a measure position)." + (and (pair? (car entry)) (cdddr entry))) + +(define (key-entry-alteration entry) + "Return the alteration of an entry in localKeySignature." + (if (number? (car entry)) + (cdr entry) + (cadr entry))) + +(define-public (find-pitch-entry keysig pitch accept-global accept-local) + "Return the first entry in keysig that matches the pitch. + accept-global states whether key signature entries should be included. + accept-local states whether local accidentals should be included. + if no matching entry is found, #f is returned." + (if (pair? keysig) + (let* ((entry (car keysig)) + (entryoct (key-entry-octave entry)) + (entrynn (key-entry-notename entry)) + (oct (ly:pitch-octave pitch)) + (nn (ly:pitch-notename pitch))) + (if (and (equal? nn entrynn) + (or (and accept-global (equal? #f entryoct)) + (and accept-local (equal? oct entryoct)))) + entry + (find-pitch-entry (cdr keysig) pitch accept-global accept-local))) + #f)) + +(define-public (neo-modern-accidental-rule context pitch barnum measurepos) + "an accidental rule that typesets an accidental if it differs from the key signature + AND does not directly follow a note on the same staff-line. + This rule should not be used alone because it does neither look at bar lines + nor different accidentals at the same notename" + (let* ((keysig (ly:context-property context 'localKeySignature)) + (entry (find-pitch-entry keysig pitch #t #t))) + (if (equal? #f entry) + (cons #f #f) + (let* ((global-entry (find-pitch-entry keysig pitch #t #f)) + (key-acc (if (equal? global-entry #f) + 0 + (key-entry-alteration global-entry))) + (acc (ly:pitch-alteration pitch)) + (entrymp (key-entry-measure-position entry)) + (entrybn (key-entry-bar-number entry))) + (cons #f (not (or (equal? acc key-acc) + (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))) + +(define-public (teaching-accidental-rule context pitch barnum measurepos) + "an accidental rule that typesets a cautionary accidental + if it is included in the key signature AND does not directly follow + a note on the same staff-line." + (let* ((keysig (ly:context-property context 'localKeySignature)) + (entry (find-pitch-entry keysig pitch #t #t))) + (if (equal? #f entry) + (cons #f #f) + (let* ((global-entry (find-pitch-entry keysig pitch #f #f)) + (key-acc (if (equal? global-entry #f) + 0 + (key-entry-alteration global-entry))) + (acc (ly:pitch-alteration pitch)) + (entrymp (key-entry-measure-position entry)) + (entrybn (key-entry-bar-number entry))) + (cons #f (not (or (equal? acc key-acc) + (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))) + (define-public (set-accidentals-properties extra-natural auto-accs auto-cauts context) @@ -887,7 +1191,7 @@ if appropriate. (define-public (set-accidental-style style . rest) "Set accidental style to STYLE. Optionally takes a context argument, -e.g. 'Staff or 'Voice. The context defaults to Voice, except for piano styles, which +e.g. 'Staff or 'Voice. The context defaults to Staff, except for piano styles, which use GrandStaff as a context. " (let ((context (if (pair? rest) (car rest) 'Staff)) @@ -897,55 +1201,111 @@ use GrandStaff as a context. " (cond ;; accidentals as they were common in the 18th century. ((equal? style 'default) - (set-accidentals-properties #t '(Staff (same-octave . 0)) - '() context)) + (set-accidentals-properties #t + `(Staff ,(make-accidental-rule 'same-octave 0)) + '() + context)) ;; accidentals from one voice do NOT get cancelled in other voices ((equal? style 'voice) - (set-accidentals-properties #t '(Voice (same-octave . 0)) - '() context)) + (set-accidentals-properties #t + `(Voice ,(make-accidental-rule 'same-octave 0)) + '() + context)) ;; accidentals as suggested by Kurt Stone, Music Notation in the 20th century. ;; This includes all the default accidentals, but accidentals also needs cancelling ;; in other octaves and in the next measure. ((equal? style 'modern) - (set-accidentals-properties #f '(Staff (same-octave . 0) (any-octave . 0) (same-octave . 1)) - '() context)) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) + '() + context)) ;; the accidentals that Stone adds to the old standard as cautionaries ((equal? style 'modern-cautionary) - (set-accidentals-properties #f '(Staff (same-octave . 0)) - '(Staff (any-octave . 0) (same-octave . 1)) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0)) + `(Staff ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) + context)) + ;; same as modern, but accidentals different from the key signature are always + ;; typeset - unless they directly follow a note of the same pitch. + ((equal? style 'neo-modern) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule) + '() + context)) + ((equal? style 'neo-modern-cautionary) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0)) + `(Staff ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + ,neo-modern-accidental-rule) + context)) + ;; Accidentals as they were common in dodecaphonic music with no tonality. + ;; Each note gets one accidental. + ((equal? style 'dodecaphonic) + (set-accidentals-properties #f + `(Staff ,(lambda (c p bn mp) '(#f . #t))) + '() context)) ;; Multivoice accidentals to be read both by musicians playing one voice ;; and musicians playing all voices. ;; Accidentals are typeset for each voice, but they ARE cancelled across voices. ((equal? style 'modern-voice) (set-accidentals-properties #f - '(Voice (same-octave . 0) (any-octave . 0) (same-octave . 1) - Staff (same-octave . 0) (any-octave . 0) (same-octave . 1)) + `(Voice ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) '() context)) ;; same as modernVoiceAccidental eccept that all special accidentals are typeset ;; as cautionaries ((equal? style 'modern-voice-cautionary) (set-accidentals-properties #f - '(Voice (same-octave . 0)) - '(Voice (any-octave . 0) (same-octave . 1) - Staff (same-octave . 0) (any-octave . 0) (same-octave . 1)) + `(Voice ,(make-accidental-rule 'same-octave 0)) + `(Voice ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) context)) ;; stone's suggestions for accidentals on grand staff. ;; Accidentals are cancelled across the staves in the same grand staff as well ((equal? style 'piano) (set-accidentals-properties #f - '(Staff (same-octave . 0) - (any-octave . 0) (same-octave . 1) - GrandStaff (any-octave . 0) (same-octave . 1)) + `(Staff ,(make-accidental-rule 'same-octave 0) + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + GrandStaff + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) '() pcontext)) ((equal? style 'piano-cautionary) (set-accidentals-properties #f - '(Staff (same-octave . 0)) - '(Staff (any-octave . 0) (same-octave . 1) - GrandStaff (any-octave . 0) (same-octave . 1)) + `(Staff ,(make-accidental-rule 'same-octave 0)) + `(Staff ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1) + GrandStaff + ,(make-accidental-rule 'any-octave 0) + ,(make-accidental-rule 'same-octave 1)) pcontext)) + + ;; same as modern, but cautionary accidentals are printed for all sharp or flat + ;; tones specified by the key signature. + ((equal? style 'teaching) + (set-accidentals-properties #f + `(Staff ,(make-accidental-rule 'same-octave 0)) + `(Staff ,(make-accidental-rule 'same-octave 1) + ,teaching-accidental-rule) + context)) ;; do not set localKeySignature when a note alterated differently from ;; localKeySignature is found. @@ -953,21 +1313,21 @@ use GrandStaff as a context. " ;; remembered for the duration of a measure. ;; accidentals not being remembered, causing accidentals always to ;; be typeset relative to the time signature - ((equal? style 'forget) (set-accidentals-properties '() - '(Staff (same-octave . -1)) - '() context)) + `(Staff ,(make-accidental-rule 'same-octave -1)) + '() + context)) ;; Do not reset the key at the start of a measure. Accidentals will be ;; printed only once and are in effect until overridden, possibly many ;; measures later. ((equal? style 'no-reset) (set-accidentals-properties '() - '(Staff (same-octave . #t)) + `(Staff ,(make-accidental-rule 'same-octave #t)) '() context)) (else - (ly:warning (_ "unknown accidental style: ~S" style)) + (ly:warning (_ "unknown accidental style: ~S") style) (make-sequential-music '())))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1000,3 +1360,34 @@ use GrandStaff as a context. " (ly:music-property (car evs) 'pitch) #f))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-public (extract-named-music music music-name) +"Return a flat list of all music named @code{music-name} +from @code{music}." + (let ((extracted-list + (if (ly:music? music) + (if (eq? (ly:music-property music 'name) music-name) + (list music) + (let ((elt (ly:music-property music 'element)) + (elts (ly:music-property music 'elements))) + (if (ly:music? elt) + (extract-named-music elt music-name) + (if (null? elts) + '() + (map (lambda(x) + (extract-named-music x music-name )) + elts))))) + '()))) + (flatten-list extracted-list))) + +(define-public (event-chord-notes event-chord) +"Return a list of all notes from @{event-chord}." + (filter + (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) + (ly:music-property event-chord 'elements))) + +(define-public (event-chord-pitches event-chord) +"Return a list of all pitches from @{event-chord}." + (map (lambda (x) (ly:music-property x 'pitch)) + (event-chord-notes event-chord)))