(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)
(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))))
ly:quote-iterator::constructor))
(ly:music-warning music (ly:format (_ "cannot find quoted music: `~S'") quoted-name))))
music))
+(export quote-substitute)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
(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))
(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))
(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.
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.
(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
0))
(define-public (find-pitch-entry keysig pitch accept-global accept-local)
- "Return the first entry in @var{keysig} that matches @var{pitch}.
+ "Return the first entry in @var{keysig} that matches @var{pitch}
+by notename and octave. Alteration is not considered.
@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."
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)
note (just as in the dodecaphonic accidental style) @emph{except} if
the note is immediately preceded by a note with the same pitch. This
is a common accidental style in contemporary notation."
- (let* ((keysig (ly:context-property context 'localKeySignature))
- (entry (find-pitch-entry keysig pitch #t #t)))
+ (let* ((keysig (ly:context-property context 'localAlterations))
+ (entry (find-pitch-entry keysig pitch #f #t)))
(if (not entry)
- (cons #f #t)
- (let* ((entrymp (key-entry-measure-position entry))
- (entrybn (key-entry-bar-number entry)))
- (cons #f
- (not
- (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
+ (cons #f #t)
+ (let ((entrymp (key-entry-measure-position entry))
+ (entrybn (key-entry-bar-number entry))
+ (entryalt (key-entry-alteration entry))
+ (alt (ly:pitch-alteration pitch)))
+ (cons #t
+ (not (and (equal? entrybn barnum)
+ (or (equal? measurepos entrymp)
+ (ly:moment<? measurepos entrymp))
+ (equal? entryalt alt))))))))
(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 @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)
;; repeated notes (in the same voice) don't get an accidental
((equal? style 'dodecaphonic-no-repeat)
(set-accidentals-properties #f
- `(Staff ,(make-accidental-rule 'same-octave 0)
- ,dodecaphonic-no-repeat-rule)
- '()
- context))
+ `(Staff ,dodecaphonic-no-repeat-rule)
+ '()
+ context))
;; Variety of the dodecaphonic style. Each note gets an accidental,
;; except notes that were already handled in the same measure.
((equal? style 'dodecaphonic-first)
,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
(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)))
#t #t))))
entry
(cons (car entry) (cons 'clef (cddr entry))))))
- (ly:context-property context 'localKeySignature)))))
+ (ly:context-property context 'localAlterations)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))
(if (>= (length siblings) 2)
(helper siblings arg)
(car arg))))
+(export value-for-spanner-piece)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; measure counter
vals))))
; return the closure named `self'
self)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; \magnifyMusic and \magnifyStaff
+
+;; defined as a function instead of a list because the
+;; all-grob-descriptions alist is not available yet
+(define-public (find-all-space-alist-props grob-descriptions)
+ "Used by @code{\\magnifyStaff}. When @var{grob-descriptions} is equal
+to the @code{all-grob-descriptions} alist (defined in
+@file{scm/define-grobs.scm}), this will find all grobs that have an
+initialized value for the @code{space-alist} property, and return them
+as a list in the following format:
+@example
+'((Ambitus space-alist)
+ (BarLine space-alist)
+ ...)
+@end example"
+ (define (has-space-alist? grob-desc)
+ (ly:assoc-get 'space-alist (cdr grob-desc)))
+ (let* ((grob-descriptions-with-space-alist
+ (filter has-space-alist? grob-descriptions))
+ (grob-names-with-space-alist
+ (map car grob-descriptions-with-space-alist)))
+ (map (lambda (grob-name) (list grob-name 'space-alist))
+ grob-names-with-space-alist)))
+
+(define (magnifyStaff-is-set? context mag)
+ (let* ((Staff (ly:context-find context 'Staff))
+ (old-mag (ly:context-property Staff 'magnifyStaffValue)))
+ (not (null? old-mag))))
+
+(define (staff-magnification-is-changing? context mag)
+ (let* ((Staff (ly:context-find context 'Staff))
+ (old-mag (ly:context-property Staff 'magnifyStaffValue 1)))
+ (not (= old-mag mag))))
+
+(define-public (scale-fontSize func-name mag)
+ "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}. Look up the
+current @code{fontSize} in the appropriate context and scale it by the
+magnification factor @var{mag}. @var{func-name} is either
+@code{'magnifyMusic} or @code{'magnifyStaff}."
+ (make-apply-context
+ (lambda (context)
+ (if (or (eq? func-name 'magnifyMusic)
+ ;; for \magnifyStaff, only scale the fontSize
+ ;; if staff magnification is changing
+ (staff-magnification-is-changing? context mag))
+ (let* ((where (case func-name
+ ((magnifyMusic) context)
+ ((magnifyStaff) (ly:context-find context 'Staff))))
+ (fontSize (ly:context-property where 'fontSize 0))
+ (new-fontSize (+ fontSize (magnification->font-size mag))))
+ (ly:context-set-property! where 'fontSize new-fontSize))))))
+
+(define-public (revert-fontSize func-name mag)
+ "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}. Calculate
+the previous @code{fontSize} value (before scaling) by factoring out the
+magnification factor @var{mag} (if @var{func-name} is
+@code{'magnifyMusic}), or by factoring out the context property
+@code{magnifyStaffValue} (if @var{func-name} is @code{'magnifyStaff}).
+Revert the @code{fontSize} in the appropriate context accordingly.
+
+With @code{\\magnifyMusic}, the scaling is reverted after the music
+block it operates on. @code{\\magnifyStaff} does not operate on a music
+block, so the scaling from a previous call (if there is one) is reverted
+before the new scaling takes effect."
+ (make-apply-context
+ (lambda (context)
+ (if (or (eq? func-name 'magnifyMusic)
+ ;; for \magnifyStaff...
+ (and
+ ;; don't revert the user's fontSize choice
+ ;; the first time \magnifyStaff is called
+ (magnifyStaff-is-set? context mag)
+ ;; only revert the previous fontSize
+ ;; if staff magnification is changing
+ (staff-magnification-is-changing? context mag)))
+ (let* ((where
+ (case func-name
+ ((magnifyMusic) context)
+ ((magnifyStaff) (ly:context-find context 'Staff))))
+ (old-mag
+ (case func-name
+ ((magnifyMusic) mag)
+ ((magnifyStaff)
+ (ly:context-property where 'magnifyStaffValue 1))))
+ (fontSize (ly:context-property where 'fontSize 0))
+ (old-fontSize (- fontSize (magnification->font-size old-mag))))
+ (ly:context-set-property! where 'fontSize old-fontSize))))))
+
+(define-public (scale-props func-name mag allowed-to-shrink? props)
+ "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}. 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 in the appropriate
+context. If @var{allowed-to-shrink?} is @code{#f}, don't let the new
+value be less than the current value. @var{func-name} is either
+@code{'magnifyMusic} or @code{'magnifyStaff}. The @var{props} list is
+formatted like:
+@example
+'((Stem thickness)
+ (Slur line-thickness)
+ ...)
+@end example"
+ (make-apply-context
+ (lambda (context)
+ (define (scale-prop grob-prop-list)
+ (let* ((grob (car grob-prop-list))
+ (prop (cadr grob-prop-list))
+ (where (if (eq? grob 'SpacingSpanner)
+ (ly:context-find context 'Score)
+ (case func-name
+ ((magnifyMusic) context)
+ ((magnifyStaff) (ly:context-find context 'Staff)))))
+ (grob-def (ly:context-grob-definition where grob)))
+ (if (eq? prop 'space-alist)
+ (let* ((space-alist (ly:assoc-get prop grob-def))
+ (scale-spacing-tuple (lambda (x)
+ (cons (car x)
+ (cons (cadr x)
+ (* mag (cddr x))))))
+ (scaled-tuples (map scale-spacing-tuple space-alist))
+ (new-alist (append scaled-tuples space-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)))))
+ (if (or (eq? func-name 'magnifyMusic)
+ ;; for \magnifyStaff, only scale the properties
+ ;; if staff magnification is changing
+ (staff-magnification-is-changing? context mag))
+ (for-each scale-prop props)))))
+
+(define-public (revert-props func-name mag props)
+ "Used by @code{\\magnifyMusic} and @code{\\magnifyStaff}. Revert each
+prop in @var{props} in the appropriate context. @var{func-name} is
+either @code{'magnifyMusic} or @code{'magnifyStaff}. The @var{props}
+list is formatted like:
+@example
+'((Stem thickness)
+ (Slur line-thickness)
+ ...)
+@end example"
+ (make-apply-context
+ (lambda (context)
+ (define (revert-prop grob-prop-list)
+ (let* ((grob (car grob-prop-list))
+ (prop (cadr grob-prop-list))
+ (where (if (eq? grob 'SpacingSpanner)
+ (ly:context-find context 'Score)
+ (case func-name
+ ((magnifyMusic) context)
+ ((magnifyStaff) (ly:context-find context 'Staff))))))
+ (ly:context-pushpop-property where grob prop)))
+ (if (or (eq? func-name 'magnifyMusic)
+ ;; for \magnifyStaff...
+ (and
+ ;; don't revert the user's property overrides
+ ;; the first time \magnifyStaff is called
+ (magnifyStaff-is-set? context mag)
+ ;; revert the overrides from the previous \magnifyStaff,
+ ;; but only if staff magnification is changing
+ (staff-magnification-is-changing? context mag)))
+ (for-each revert-prop props)))))
+
+;; \magnifyMusic only
+(define-public (scale-beam-thickness mag)
+ "Used by @code{\\magnifyMusic}. Scaling @code{Beam.beam-thickness}
+exactly to the @var{mag} value will not 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)))))
projects / lilypond.git / blobdiff