X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=b8ceadf5bde6d516fa464ed827c439ec87a80ee8;hb=1d3beed53413315ec6c0553b003b8c5776f8c38f;hp=b0c98769ae967b571274e14739a036a96c97b801;hpb=423deeb9913f9ded5aebac5223fdea1db59a0254;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index b0c98769ae..b8ceadf5bd 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -906,17 +906,19 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (lambda (elt) (grob::has-interface elt symbol))) -(define-public ((outputproperty-compatibility func sym val) grob g-context ao-context) +(define ((outputproperty-compatibility func sym val) grob g-context ao-context) (if (func grob) (set! (ly:grob-property grob sym) val))) +(export outputproperty-compatibility) -(define-public ((set-output-property grob-name symbol val) grob grob-c context) +(define ((set-output-property grob-name symbol val) grob grob-c context) "Usage example: @code{\\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1))}" (let ((meta (ly:grob-property grob 'meta))) (if (equal? (assoc-get 'name meta) grob-name) (set! (ly:grob-property grob symbol) val)))) +(export set-output-property) (define-public (skip->rest mus) @@ -1229,7 +1231,7 @@ set to the @code{location} parameter." (and clef (make-cue-clef-unset)))))) quote-music)) -(define-public ((quote-substitute quote-tab) music) +(define ((quote-substitute quote-tab) music) (let* ((quoted-name (ly:music-property music 'quoted-music-name)) (quoted-vector (and (string? quoted-name) (hash-ref quote-tab quoted-name #f)))) @@ -1243,6 +1245,7 @@ set to the @code{location} parameter." ly:quote-iterator::constructor)) (ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name)))) music)) +(export quote-substitute) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -1431,13 +1434,14 @@ Returns @code{#f} or the reason for the invalidation, a symbol." (define (check-pitch-against-signature context pitch barnum laziness octaveness all-naturals) "Checks the need for an accidental and a @q{restore} accidental against -@code{localKeySignature}. The @var{laziness} is the number of measures +@code{localAlterations} and @code{keyAlterations}. +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. -If @var{all-naturals} is ##t, notes that do not occur in @code{keySignature} +If @var{all-naturals} is ##t, notes that do not occur in @code{keyAlterations} also get an accidental." (let* ((ignore-octave (cond ((equal? octaveness 'any-octave) #t) ((equal? octaveness 'same-octave) #f) @@ -1445,8 +1449,8 @@ also get an accidental." (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)) + (key (ly:context-property context 'keyAlterations)) + (local (ly:context-property context 'localAlterations)) (notename (ly:pitch-notename pitch)) (octave (ly:pitch-octave pitch)) (pitch-handle (cons octave notename)) @@ -1454,17 +1458,17 @@ also get an accidental." (need-accidental #f) (previous-alteration #f) (from-other-octaves #f) - (from-same-octave (assoc-get pitch-handle local-key-sig)) - (from-key-sig (or (assoc-get notename local-key-sig) + (from-same-octave (assoc-get pitch-handle local)) + (from-key-sig (or (assoc-get notename local) - ;; If no key signature match is found from localKeySignature, we may have a custom + ;; If no notename match is found from localAlterations, 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. - (assoc-get pitch-handle key-sig)))) + ;; localAlterations, try extracting from keyAlterations instead. + (assoc-get pitch-handle key)))) - ;; loop through localKeySignature to search for a notename match from other octaves - (let loop ((l local-key-sig)) + ;; loop through localAlterations to search for a notename match from other octaves + (let loop ((l local)) (if (pair? l) (let ((entry (car l))) (if (and (pair? (car entry)) @@ -1506,7 +1510,7 @@ also get an accidental." (cons need-restore need-accidental))) -(define-public ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) +(define ((make-accidental-rule octaveness laziness) context pitch barnum measurepos) "Create an accidental rule that makes its decision based on the octave of the note and a laziness value. @@ -1524,15 +1528,17 @@ 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 #f)) +(export make-accidental-rule) -(define-public ((make-accidental-dodecaphonic-rule octaveness laziness) context pitch barnum measurepos) +(define ((make-accidental-dodecaphonic-rule octaveness laziness) context pitch barnum measurepos) "Variation on function make-accidental-rule that creates an dodecaphonic accidental rule." (check-pitch-against-signature context pitch barnum laziness octaveness #t)) +(export make-accidental-dodecaphonic-rule) (define (key-entry-notename entry) - "Return the pitch of an @var{entry} in @code{localKeySignature}. + "Return the pitch of an @var{entry} in @code{localAlterations}. The @samp{car} of the entry is either of the form @code{notename} or of the form @code{(octave . notename)}. The latter form is used for special key signatures or to indicate an explicit accidental. @@ -1546,25 +1552,25 @@ an accidental in music." (car entry))) (define (key-entry-octave entry) - "Return the octave of an entry in @code{localKeySignature} + "Return the octave of an entry in @code{localAlterations} or @code{#f} if the entry does not have an octave. See @code{key-entry-notename} for details." (and (pair? (car entry)) (caar entry))) (define (key-entry-bar-number entry) - "Return the bar number of an entry in @code{localKeySignature} + "Return the bar number of an entry in @code{localAlterations} or @code {#f} if the entry does not have a bar number. See @code{key-entry-notename} for details." (and (pair? (cdr entry)) (caddr entry))) (define (key-entry-measure-position entry) - "Return the measure position of an entry in @code{localKeySignature} + "Return the measure position of an entry in @code{localAlterations} or @code {#f} if the entry does not have a measure position. See @code{key-entry-notename} for details." (and (pair? (cdr entry)) (cdddr entry))) (define (key-entry-alteration entry) - "Return the alteration of an entry in localKeySignature. + "Return the alteration of an entry in localAlterations For convenience, returns @code{0} if entry is @code{#f}." (if entry @@ -1597,7 +1603,7 @@ If no matching entry is found, @var{#f} is returned." key signature @emph{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 note name." - (let* ((keysig (ly:context-property context 'localKeySignature)) + (let* ((keysig (ly:context-property context 'localAlterations)) (entry (find-pitch-entry keysig pitch #t #t))) (if (not entry) (cons #f #f) @@ -1628,7 +1634,7 @@ is a common accidental style in contemporary notation." "An accidental rule that typesets a cautionary accidental if it is 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)) + (let* ((keysig (ly:context-property context 'localAlterations)) (entry (find-pitch-entry keysig pitch #t #t))) (if (not entry) (cons #f #f) @@ -1809,8 +1815,8 @@ as a context." ,teaching-accidental-rule) context)) - ;; do not set localKeySignature when a note alterated differently from - ;; localKeySignature is found. + ;; do not set localAlterations when a note alterated differently from + ;; localAlterations is found. ;; Causes accidentals to be printed at every note instead of ;; remembered for the duration of a measure. ;; accidentals not being remembered, causing accidentals always to @@ -1835,15 +1841,15 @@ as a context." (define-public (invalidate-alterations context) "Invalidate alterations in @var{context}. -Elements of @code{'localKeySignature} corresponding to local +Elements of @code{'localAlterations} 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) + (let* ((keysig (ly:context-property context 'keyAlterations))) + (set! (ly:context-property context 'localAlterations) (map-in-order (lambda (entry) (let* ((localalt (key-entry-alteration entry))) @@ -1859,7 +1865,7 @@ Entries that conform with the current key signature are not invalidated." #t #t)))) entry (cons (car entry) (cons 'clef (cddr entry)))))) - (ly:context-property context 'localKeySignature))))) + (ly:context-property context 'localAlterations))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -2222,7 +2228,7 @@ other stems just because of that." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The following is used by the alterBroken function. -(define-public ((value-for-spanner-piece arg) grob) +(define ((value-for-spanner-piece arg) grob) "Associate a piece of broken spanner @var{grob} with an element of list @var{arg}." (let* ((orig (ly:grob-original grob)) @@ -2238,6 +2244,7 @@ of list @var{arg}." (if (>= (length siblings) 2) (helper siblings arg) (car arg)))) +(export value-for-spanner-piece) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; measure counter @@ -2391,3 +2398,128 @@ Offsets are restricted to immutable properties and values of type @code{number}, vals)))) ; return the closure named `self' self) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following are used by \magnifyMusic + +(define-public (scale-fontSize mag) + "Used by @code{\\magnifyMusic}. Look up the current fontSize and +scale it by the magnification factor @var{mag}." + (make-apply-context + (lambda (context) + (let* ((fontSize (ly:context-property context 'fontSize 0)) + (new-fontSize (+ fontSize (magnification->font-size mag)))) + (ly:context-set-property! context 'fontSize new-fontSize))))) + +(define-public (revert-fontSize mag) + "Used by @code{\\magnifyMusic}. Calculate the previous fontSize value +(before scaling) by factoring out the magnification factor @var{mag}." + (make-apply-context + (lambda (context) + (let* ((fontSize (ly:context-property context 'fontSize 0)) + (old-fontSize (- fontSize (magnification->font-size mag)))) + (ly:context-set-property! context 'fontSize old-fontSize))))) + +(define-public (scale-props props mag allowed-to-shrink?) + "Used by @code{\\magnifyMusic}. For each prop in @var{props}, find +the current value of the requested prop, scale it by the magnification +factor @var{mag}, and do the equivalent of a +@code{\\temporary@tie{}\\override} with the new value. If +@code{allowed-to-shrink?} is @code{#f}, don't let the new value be less +than the current value. Props are formatted like: + +@example +Slur.height-limit +Slur.details.region-size +@end example" + (make-apply-context + (lambda (context) + (define (scale-prop grob.prop) + (let* ((grob-prop-list (map string->symbol + (string-split + (symbol->string grob.prop) #\.))) + (prop-is-alist? (eq? 3 (length grob-prop-list))) + (grob (car grob-prop-list)) + (prop (cadr grob-prop-list)) + (where (if (eq? grob 'SpacingSpanner) + (ly:context-find context 'Score) + context)) + (grob-def (ly:context-grob-definition where grob))) + (if prop-is-alist? + (let* ((subprop (caddr grob-prop-list)) + (old-alist (ly:assoc-get prop grob-def)) + (val (ly:assoc-get subprop old-alist 1)) + (round-if-needed + (lambda (x) + ;; these props require exact integers + (if (or (eq? subprop 'multi-tie-region-size) + (eq? subprop 'single-tie-region-size)) + (inexact->exact (round x)) + x))) + (new-val (if allowed-to-shrink? + (round-if-needed (* val mag)) + (round-if-needed (* val (max 1 mag))))) + (new-alist (cons (cons subprop new-val) old-alist))) + (ly:context-pushpop-property where grob prop new-alist)) + (let* ((val (ly:assoc-get prop grob-def 1)) + (proc (lambda (x) + (if allowed-to-shrink? + (* x mag) + (* x (max 1 mag))))) + (new-val (if (number-pair? val) + (cons (proc (car val)) + (proc (cdr val))) + (proc val)))) + (ly:context-pushpop-property where grob prop new-val))))) + (for-each scale-prop props)))) + +(define-public (scale-beam-thickness mag) + "Used by @code{\\magnifyMusic}. Scaling @code{Beam.beam-thickness} +exactly to the @var{mag} value won't work. This uses two reference +values for @code{beam-thickness} to determine an acceptable value when +scaling, then does the equivalent of a +@code{\\temporary@tie{}\\override} with the new value." + (make-apply-context + (lambda (context) + (let* ((grob-def (ly:context-grob-definition context 'Beam)) + (val (ly:assoc-get 'beam-thickness grob-def 0.48)) + (ratio-to-default (/ val 0.48)) + ;; gives beam-thickness=0.48 when mag=1 (like default), + ;; gives beam-thickness=0.35 when mag=0.63 (like CueVoice) + (scaled-default (+ 119/925 (* mag 13/37))) + (new-val (* scaled-default ratio-to-default))) + (ly:context-pushpop-property context 'Beam 'beam-thickness new-val))))) + +(define-public (revert-props props) + "Used by @code{\\magnifyMusic}. Revert each prop in @var{props}. +Props are formatted like: + +@example +Slur.height-limit +Slur.details.region-size +@end example + +Nested properties are reverted by reverting the parent property only. +For example, @code{Slur.details.region-size} gets reverted like this: + +@example +\revert Slur.details +@end example + +This is safe as long as the number of reverts matches the number of +overrides. Any user overrides within a @code{\\magnifyMusic} block +should be reverted before closing the block." + (make-apply-context + (lambda (context) + (define (revert-prop grob.prop) + (let* ((grob-prop-list (map string->symbol + (string-split + (symbol->string grob.prop) #\.))) + (grob (car grob-prop-list)) + (prop (cadr grob-prop-list)) + (where (if (eq? grob 'SpacingSpanner) + (ly:context-find context 'Score) + context))) + (ly:context-pushpop-property where grob prop))) + (for-each revert-prop props))))