X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=d7fedb689d9cf3e69a445ec7c4731ce176fe75b0;hb=b92ea16ef75d8aaa7bdb9f492b58d7af906e7945;hp=ed96cfd8d21dcda0cf61430c1596ad2422b72b6b;hpb=7439f9e74f8e33286c8af7f9a51fe4f7a4eb10fd;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index ed96cfd8d2..d7fedb689d 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -278,7 +278,7 @@ through MUSIC." ;; This works for single-note and multi-note tremolos! (let* ((children (if (music-is-of-type? main 'sequential-music) ;; \repeat tremolo n { ... } - (length (ly:music-property main 'elements)) + (length (extract-named-music main 'EventChord)) ;; \repeat tremolo n c4 1)) ;; # of dots is equal to the 1 in bitwise representation (minus 1)! @@ -304,7 +304,7 @@ through MUSIC." (define (calc-repeat-slash-count music) "Given the child-list @var{music} in @code{PercentRepeatMusic}, calculate the number of slashes based on the durations. Returns @code{0} -if durations in in @var{music} vary, allowing slash beats and double-percent +if durations in @var{music} vary, allowing slash beats and double-percent beats to be distinguished." (let* ((durs (map (lambda (elt) (duration-of-note elt)) @@ -411,7 +411,8 @@ in @var{grob}." Slur Stem TextScript - Tie)) + Tie + TupletBracket)) (define-safe-public (make-voice-props-set n) (make-sequential-music @@ -423,6 +424,7 @@ in @var{grob}." (make-property-set 'graceSettings ;; TODO: take this from voicedGraceSettings or similar. '((Voice Stem font-size -3) + (Voice Flag font-size -3) (Voice NoteHead font-size -3) (Voice TabNoteHead font-size -4) (Voice Dots font-size -3) @@ -649,22 +651,6 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (set! (ly:grob-property grob symbol) val)))) -;; -(define-public (smart-bar-check n) - "Make a bar check that checks for a specific bar number." - (let ((m (make-music 'ApplyContext))) - (define (checker tr) - (let* ((bn (ly:context-property tr 'currentBarNumber))) - (if (= bn n) - #t - (ly:error - ;; FIXME: uncomprehensable message - (_ "Bar check failed. Expect to be at ~a, instead at ~a") - n bn)))) - (set! (ly:music-property m 'procedure) checker) - m)) - - (define-public (skip->rest mus) "Replace @var{mus} by @code{RestEvent} of the same duration if it is a @code{SkipEvent}. Useful for extracting parts from crowded scores." @@ -692,12 +678,17 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; warn for bare chords at start. - (define-public (ly:music-message music msg) (let ((ip (ly:music-property music 'origin))) (if (ly:input-location? ip) - (ly:input-message ip msg) - (ly:warning msg)))) + (ly:input-message ip msg) + (ly:message msg)))) + +(define-public (ly:music-warning music msg) + (let ((ip (ly:music-property music 'origin))) + (if (ly:input-location? ip) + (ly:input-warning ip msg) + (ly:warning msg)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -832,9 +823,8 @@ Syntax: (define-public ((quote-substitute quote-tab) music) (let* ((quoted-name (ly:music-property music 'quoted-music-name)) - (quoted-vector (if (string? quoted-name) - (hash-ref quote-tab quoted-name #f) - #f))) + (quoted-vector (and (string? quoted-name) + (hash-ref quote-tab quoted-name #f)))) (if (string? quoted-name) @@ -843,7 +833,7 @@ Syntax: (set! (ly:music-property music 'quoted-events) quoted-vector) (set! (ly:music-property music 'iterator-ctor) ly:quote-iterator::constructor)) - (ly:warning (_ "cannot find quoted music: `~S'") quoted-name))) + (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name)))) music)) @@ -910,12 +900,10 @@ then revert skipTypesetting." (let* ((show-last (ly:parser-lookup parser 'showLastLength)) (show-first (ly:parser-lookup parser 'showFirstLength)) - (show-last-length (if (ly:music? show-last) - (ly:music-length show-last) - #f)) - (show-first-length (if (ly:music? show-first) - (ly:music-length show-first) - #f)) + (show-last-length (and (ly:music? show-last) + (ly:music-length show-last))) + (show-first-length (and (ly:music? show-first) + (ly:music-length show-first))) (orig-length (ly:music-length music))) ;;FIXME: if using either showFirst- or showLastLength, @@ -1004,17 +992,22 @@ then revert skipTypesetting." ;; accidentals (define (recent-enough? bar-number alteration-def laziness) - (if (or (number? alteration-def) - (equal? laziness #t)) - #t + (or (number? alteration-def) + (equal? laziness #t) (<= bar-number (+ (cadr alteration-def) laziness)))) -(define (is-tied? alteration-def) - (let* ((def (if (pair? alteration-def) - (car alteration-def) - alteration-def))) +(define (accidental-invalid? alteration-def) + "Checks an alteration entry for being invalid. + +Non-key alterations are invalidated when tying into the next bar or +when there is a clef change, since neither repetition nor cancellation +can be omitted when the same note occurs again. - (if (equal? def 'tied) #t #f))) +Returns @code{#f} or the reason for the invalidation, a symbol." + (let* ((def (if (pair? alteration-def) + (car alteration-def) + alteration-def))) + (and (symbol? def) def))) (define (extract-alteration alteration-def) (cond ((number? alteration-def) @@ -1047,14 +1040,13 @@ specifies whether accidentals should be canceled in different octaves." (previous-alteration #f) (from-other-octaves #f) (from-same-octave (assoc-get pitch-handle local-key-sig)) - (from-key-sig (assoc-get notename local-key-sig))) + (from-key-sig (or (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 (assoc-get pitch-handle key-sig))) + (assoc-get pitch-handle key-sig)))) ;; loop through localKeySignature to search for a notename match from other octaves (let loop ((l local-key-sig)) @@ -1068,22 +1060,22 @@ specifies whether accidentals should be canceled in different octaves." ;; find previous alteration-def for comparison with pitch (cond ;; from same octave? - ((and (eq? ignore-octave #f) - (not (equal? from-same-octave #f)) + ((and (not ignore-octave) + from-same-octave (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)) + ((and ignore-octave + from-other-octaves (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)) + (from-key-sig (set! previous-alteration from-key-sig))) - (if (is-tied? previous-alteration) + (if (accidental-invalid? previous-alteration) (set! need-accidental #t) (let* ((prev-alt (extract-alteration previous-alteration)) @@ -1093,8 +1085,8 @@ specifies whether accidentals should be canceled in different octaves." (begin (set! need-accidental #t) (if (and (not (= this-alt 0)) - (or (< (abs this-alt) (abs prev-alt)) - (< (* prev-alt this-alt) 0))) + (and (< (abs this-alt) (abs prev-alt)) + (> (* prev-alt this-alt) 0))) (set! need-restore #t)))))) (cons need-restore need-accidental))) @@ -1113,7 +1105,7 @@ active pitch in any octave. @var{laziness} states over how many bars an accidental should be remembered. @code{0}@tie{}is the default -- accidental lasts over 0@tie{}bar lines, that is, to the end of current measure. A positive integer means that the -accidental lasts over that many bar lines. @code{-1} is `forget +accidental lasts over that many bar lines. @w{@code{-1}} is `forget immediately', that is, only look at key signature. @code{#t} is `forever'." (check-pitch-against-signature context pitch barnum laziness octaveness)) @@ -1141,28 +1133,31 @@ immediately', that is, only look at key signature. @code{#t} is `forever'." (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))) + "Return the alteration of an entry in localKeySignature. + +For convenience, returns @code{0} if entry is @code{#f}." + (if entry + (if (number? (car entry)) + (cdr entry) + (cadr entry)) + 0)) (define-public (find-pitch-entry keysig pitch accept-global accept-local) "Return the first entry in @var{keysig} that matches @var{pitch}. @var{accept-global} states whether key signature entries should be included. @var{accept-local} states whether local accidentals should be included. If no matching entry is found, @var{#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)) + (and (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 (not entryoct)) + (and accept-local (equal? oct entryoct)))) + entry + (find-pitch-entry (cdr keysig) pitch accept-global accept-local))))) (define-public (neo-modern-accidental-rule context pitch barnum measurepos) "An accidental rule that typesets an accidental if it differs from the @@ -1171,12 +1166,10 @@ staff line. This rule should not be used alone because it does neither look at bar lines nor different accidentals at the same note name." (let* ((keysig (ly:context-property context 'localKeySignature)) (entry (find-pitch-entry keysig pitch #t #t))) - (if (equal? #f entry) + (if (not 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))) + (key-acc (key-entry-alteration global-entry)) (acc (ly:pitch-alteration pitch)) (entrymp (key-entry-measure-position entry)) (entrybn (key-entry-bar-number entry))) @@ -1189,12 +1182,10 @@ included in the key signature @emph{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) + (if (not 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))) + (key-acc (key-entry-alteration global-entry)) (acc (ly:pitch-alteration pitch)) (entrymp (key-entry-measure-position entry)) (entrybn (key-entry-bar-number entry))) @@ -1378,6 +1369,36 @@ as a context." (ly:warning (_ "unknown accidental style: ~S") style) (make-sequential-music '())))))) +(define-public (invalidate-alterations context) + "Invalidate alterations in @var{context}. + +Elements of @code{'localKeySignature} corresponding to local +alterations of the key signature have the form +@code{'((octave . notename) . (alter barnum . measurepos))}. +Replace them with a version where @code{alter} is set to @code{'clef} +to force a repetition of accidentals. + +Entries that conform with the current key signature are not invalidated." + (let* ((keysig (ly:context-property context 'keySignature))) + (set! (ly:context-property context 'localKeySignature) + (map-in-order + (lambda (entry) + (let* ((localalt (key-entry-alteration entry)) + (localoct (key-entry-octave entry))) + (if (or (accidental-invalid? localalt) + (not localoct) + (= localalt + (key-entry-alteration + (find-pitch-entry + keysig + (ly:make-pitch localoct + (key-entry-notename entry) + 0) + #t #t)))) + entry + (cons (car entry) (cons 'clef (cddr entry)))))) + (ly:context-property context 'localKeySignature))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-public (skip-of-length mus)