;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 1998--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 1998--2014 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
"Generate an expression that, once evaluated, may return an object
equivalent to @var{obj}, that is, for a music expression, a
@code{(make-music ...)} form."
+ (define (if-nonzero num)
+ (if (zero? num) '() (list num)))
(cond (;; markup expression
(markup? obj)
(markup-expression->make-markup obj))
(ly:music-mutable-properties obj)))))
(;; moment
(ly:moment? obj)
- `(ly:make-moment ,(ly:moment-main-numerator obj)
- ,(ly:moment-main-denominator obj)
- ,(ly:moment-grace-numerator obj)
- ,(ly:moment-grace-denominator obj)))
+ `(ly:make-moment
+ ,@(let ((main (ly:moment-main obj))
+ (grace (ly:moment-grace obj)))
+ (cond ((zero? grace) (list main))
+ ((negative? grace) (list main grace))
+ (else ;;positive grace requires 4-arg form
+ (list (numerator main)
+ (denominator main)
+ (numerator grace)
+ (denominator grace)))))))
(;; note duration
(ly:duration? obj)
`(ly:make-duration ,(ly:duration-log obj)
- ,(ly:duration-dot-count obj)
- ,(ly:duration-scale obj)))
+ ,@(if (= (ly:duration-scale obj) 1)
+ (if-nonzero (ly:duration-dot-count obj))
+ (list (ly:duration-dot-count obj)
+ (ly:duration-scale obj)))))
(;; note pitch
(ly:pitch? obj)
`(ly:make-pitch ,(ly:pitch-octave obj)
,(ly:pitch-notename obj)
- ,(ly:pitch-alteration obj)))
+ ,@(if-nonzero (ly:pitch-alteration obj))))
(;; scheme procedure
(procedure? obj)
(or (procedure-name obj) obj))
(max 0 (+ dot (ly:duration-dot-count d)))
cp)))
(set! (ly:music-property music 'duration) nd)))
+ ;clear cached length, since it's no longer valid
+ (set! (ly:music-property music 'length) '())
music))
(define-public (shift-duration-log music shift dot)
(music-map (lambda (x) (shift-one-duration-log x shift dot))
music))
-(define-public (make-repeat name times main alts)
- "Create a repeat music expression, with all properties initialized
-properly."
+(define-public (tremolo::get-music-list tremolo)
+ "Given a tremolo repeat, return a list of music to engrave for it.
+This will be a stretched copy of its body, plus a TremoloEvent or
+TremoloSpanEvent.
+
+This is called only by Chord_tremolo_iterator."
(define (first-note-duration music)
- "Finds the duration of the first NoteEvent by searching depth-first
-through MUSIC."
+ "Finds the duration of the first NoteEvent by searching
+depth-first through MUSIC."
;; NoteEvent or a non-expanded chord-repetition
;; We just take anything that actually sports an announced duration.
(if (ly:duration? (ly:music-property music 'duration))
(if (ly:duration? dur)
dur
(loop (cdr elts))))))))
-
- (let ((talts (if (< times (length alts))
- (begin
- (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
- (take alts times))
- alts))
- (r (make-repeated-music name)))
- (set! (ly:music-property r 'element) main)
- (set! (ly:music-property r 'repeat-count) (max times 1))
- (set! (ly:music-property r 'elements) talts)
- (if (and (equal? name "tremolo")
- (pair? (extract-named-music main '(EventChord NoteEvent))))
- ;; This works for single-note and multi-note tremolos!
- (let* ((children (if (music-is-of-type? main 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music main '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
+ (let* ((times (ly:music-property tremolo 'repeat-count))
+ (body (ly:music-property tremolo 'element))
+ (children (if (music-is-of-type? body 'sequential-music)
+ ;; \repeat tremolo n { ... }
+ (length (extract-named-music body '(EventChord
+ NoteEvent)))
+ ;; \repeat tremolo n c4
+ 1))
+ (tremolo-type (if (positive? children)
+ (let* ((note-duration (first-note-duration body))
+ (duration-log (if (ly:duration? note-duration)
+ (ly:duration-log note-duration)
+ 1)))
+ (ash 1 duration-log))
+ '()))
+ (stretched (ly:music-deep-copy body)))
+ (if (positive? children)
+ ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
+ (let* ((dots (1- (logcount (* times children))))
+ ;; The remaining missing multiplier to scale the notes by
;; times * children
(mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult))))
- (note-duration (first-note-duration r))
- (duration-log (if (ly:duration? note-duration)
- (ly:duration-log note-duration)
- 1))
- (tremolo-type (ash 1 duration-log)))
- (set! (ly:music-property r 'tremolo-type) tremolo-type)
+ (shift (- (ly:intlog2 (floor mult)))))
(if (not (and (integer? mult) (= (logcount mult) 1)))
(ly:music-warning
- main
+ body
(ly:format (_ "invalid tremolo repeat count: ~a") times)))
- ;; Adjust the time of the notes
- (ly:music-compress r (ly:make-moment 1 children))
+ ;; Make each note take the full duration
+ (ly:music-compress stretched (ly:make-moment 1 children))
;; Adjust the displayed note durations
- (shift-duration-log r shift dots))
- r)))
+ (shift-duration-log stretched shift dots)))
+ ;; Return the stretched body plus a tremolo event
+ (if (= children 1)
+ (list (make-music 'TremoloEvent
+ 'repeat-count times
+ 'tremolo-type tremolo-type
+ 'origin (ly:music-property tremolo 'origin))
+ stretched)
+ (list (make-music 'TremoloSpanEvent
+ 'span-direction START
+ 'repeat-count times
+ 'tremolo-type tremolo-type
+ 'origin (ly:music-property tremolo 'origin))
+ stretched
+ (make-music 'TremoloSpanEvent
+ 'span-direction STOP
+ 'origin (ly:music-property tremolo 'origin))))))
+
+(define-public (make-repeat name times main alts)
+ "Create a repeat music expression, with all properties initialized
+properly."
+ (let ((type (or (assoc-get name '(("volta" . VoltaRepeatedMusic)
+ ("unfold" . UnfoldedRepeatedMusic)
+ ("percent" . PercentRepeatedMusic)
+ ("tremolo" . TremoloRepeatedMusic)))
+ (begin (ly:warning (_ "unknown repeat type `~S': must be volta, unfold, percent, or tremolo") name)
+ 'VoltaRepeatedMusic)))
+ (talts (if (< times (length alts))
+ (begin
+ (ly:warning (_ "More alternatives than repeats. Junking excess alternatives"))
+ (take alts times))
+ alts)))
+ (make-music type
+ 'element main
+ 'repeat-count (max times 1)
+ 'elements talts)))
(define (calc-repeat-slash-count music)
"Given the child-list @var{music} in @code{PercentRepeatMusic},
(define-public (unfold-repeats music)
"Replace all repeats with unfolded repeats."
-
(let ((es (ly:music-property music 'elements))
(e (ly:music-property music 'element)))
-
(if (music-is-of-type? music 'repeated-music)
- (let* ((props (ly:music-mutable-properties music))
- (old-name (ly:music-property music 'name))
- (flattened (flatten-alist props)))
- (set! music (apply make-music (cons 'UnfoldedRepeatedMusic
- flattened)))
-
- (if (and (equal? old-name 'TremoloRepeatedMusic)
- (pair? (extract-named-music e '(EventChord NoteEvent))))
- ;; This works for single-note and multi-note tremolos!
- (let* ((children (if (music-is-of-type? e 'sequential-music)
- ;; \repeat tremolo n { ... }
- (length (extract-named-music e '(EventChord
- NoteEvent)))
- ;; \repeat tremolo n c4
- 1))
- (times (ly:music-property music 'repeat-count))
-
- ;; # of dots is equal to the 1 in bitwise representation (minus 1)!
- (dots (1- (logcount (* times children))))
- ;; The remaining missing multiplicator to scale the notes by
- ;; times * children
- (mult (/ (* times children (ash 1 dots)) (1- (ash 2 dots))))
- (shift (- (ly:intlog2 (floor mult)))))
-
- ;; Adjust the time of the notes
- (ly:music-compress music (ly:make-moment children 1))
- ;; Adjust the displayed note durations
- (shift-duration-log music (- shift) (- dots))))))
-
+ (set! music (make-music 'UnfoldedRepeatedMusic music)))
(if (pair? es)
(set! (ly:music-property music 'elements)
(map unfold-repeats es)))
(and (music-is-of-type? m 'unfolded-repeated-music)
(make-sequential-music
(ly:music-deep-copy
- (let loop ((n (ly:music-property m 'repeat-count))
- (alts (ly:music-property m 'elements))
- (body (ly:music-property m 'element)))
+ (let ((n (ly:music-property m 'repeat-count))
+ (alts (ly:music-property m 'elements))
+ (body (ly:music-property m 'element)))
(cond ((<= n 0) '())
- ((null? alts)
- (cons body (loop (1- n) alts body)))
+ ((null? alts) (make-list n body))
(else
- (cons* body (car alts)
- (loop (1- n)
- (if (pair? (cdr alts))
- (cdr alts)
- alts)
- body)))))))))
+ (concatenate
+ (zip (make-list n body)
+ (append! (make-list (max 0 (- n (length alts)))
+ (car alts))
+ alts))))))))))
(unfold-repeats music)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(car alteration-def))
(else 0)))
-(define (check-pitch-against-signature context pitch barnum laziness octaveness)
+(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."
+specifies whether accidentals should be canceled in different octaves.
+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)
(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))
+ (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))
(let* ((prev-alt (extract-alteration previous-alteration))
(this-alt (ly:pitch-alteration pitch)))
- (if (not (= this-alt prev-alt))
+ (if (or (and all-naturals (eq? #f previous-alteration)) (not (= this-alt prev-alt)))
(begin
(set! need-accidental #t)
(if (and (not (= this-alt 0))
(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.
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))
+ (check-pitch-against-signature context pitch barnum laziness octaveness #f))
+(export make-accidental-rule)
+
+(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
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)
(cons #f (not (or (equal? acc key-acc)
(and (equal? entrybn barnum) (equal? entrymp measurepos)))))))))
+(define-public (dodecaphonic-no-repeat-rule context pitch barnum measurepos)
+ "An accidental rule that typesets an accidental before every
+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)))
+ (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))))))))
+
(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)
- (let* ((entrymp (key-entry-measure-position entry))
+ (let* ((global-entry (find-pitch-entry keysig pitch #f #f))
+ (key-acc (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 (and (equal? entrybn barnum) (equal? entrymp measurepos))))))))
+ (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
`(Staff ,(lambda (c p bn mp) '(#f . #t)))
'()
context))
+ ;; As in dodecaphonic style with the exception that immediately
+ ;; 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))
+ ;; Variety of the dodecaphonic style. Each note gets an accidental,
+ ;; except notes that were already handled in the same measure.
+ ((equal? style 'dodecaphonic-first)
+ (set-accidentals-properties #f
+ `(Staff ,(make-accidental-dodecaphonic-rule 'same-octave 0))
+ '()
+ 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 canceled across voices.
,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)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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))))
projects / lilypond.git / blobdiff