X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmusic-functions.scm;h=cd0ff32e1cd7ec47b34139e382ffe3c3fef797ec;hb=41839ed7390861d2a3f3fa31c5fc93a28599d99e;hp=1b1d07c490fefefbcaeaadfff19f7eec604283fd;hpb=08560a1b8076630c4fc6cb9b902614d8b74fd6fc;p=lilypond.git diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 1b1d07c490..cd0ff32e1c 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -62,8 +62,9 @@ First it recurses over the children, then the function is applied to @var{music}." (let ((es (ly:music-property music 'elements)) (e (ly:music-property music 'element))) - (set! (ly:music-property music 'elements) - (map (lambda (y) (music-map function y)) es)) + (if (pair? es) + (set! (ly:music-property music 'elements) + (map (lambda (y) (music-map function y)) es))) (if (ly:music? e) (set! (ly:music-property music 'element) (music-map function e))) @@ -179,8 +180,7 @@ equivalent to @var{obj}, that is, for a music expression, a (ly:duration? obj) `(ly:make-duration ,(ly:duration-log obj) ,(ly:duration-dot-count obj) - ,(car (ly:duration-factor obj)) - ,(cdr (ly:duration-factor obj)))) + ,(ly:duration-scale obj))) (;; note pitch (ly:pitch? obj) `(ly:make-pitch ,(ly:pitch-octave obj) @@ -236,12 +236,11 @@ which often can be read back in order to generate an equivalent expression." The number of dots in the shifted music may not be less than zero." (let ((d (ly:music-property music 'duration))) (if (ly:duration? d) - (let* ((cp (ly:duration-factor d)) + (let* ((cp (ly:duration-scale d)) (nd (ly:make-duration (+ shift (ly:duration-log d)) (max 0 (+ dot (ly:duration-dot-count d))) - (car cp) - (cdr cp)))) + cp))) (set! (ly:music-property music 'duration) nd))) music)) @@ -255,7 +254,9 @@ properly." (define (first-note-duration music) "Finds the duration of the first NoteEvent by searching depth-first through MUSIC." - (if (memq 'note-event (ly:music-property music 'types)) + ;; 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)) (ly:music-property music 'duration) (let loop ((elts (if (ly:music? (ly:music-property music 'element)) (list (ly:music-property music 'element)) @@ -276,12 +277,12 @@ through MUSIC." (set! (ly:music-property r 'repeat-count) (max times 1)) (set! (ly:music-property r 'elements) talts) (if (and (equal? name "tremolo") - (or (pair? (ly:music-property main 'elements)) - (ly:music? (ly:music-property main 'element)))) + (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)) + (length (extract-named-music main '(EventChord + NoteEvent))) ;; \repeat tremolo n c4 1)) ;; # of dots is equal to the 1 in bitwise representation (minus 1)! @@ -296,8 +297,10 @@ through MUSIC." 1)) (tremolo-type (ash 1 duration-log))) (set! (ly:music-property r 'tremolo-type) tremolo-type) - (if (not (integer? mult)) - (ly:warning (_ "invalid tremolo repeat count: ~a") times)) + (if (not (and (integer? mult) (= (logcount mult) 1))) + (ly:music-warning + main + (ly:format (_ "invalid tremolo repeat count: ~a") times))) ;; Adjust the time of the notes (ly:music-compress r (ly:make-moment 1 children)) ;; Adjust the displayed note durations @@ -309,9 +312,9 @@ through MUSIC." calculate the number of slashes based on the durations. Returns @code{0} 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)) - (extract-named-music music 'EventChord))) + (let* ((durs (map duration-of-note + (extract-named-music music '(EventChord NoteEvent + RestEvent SkipEvent)))) (first-dur (car durs))) (if (every (lambda (d) (equal? d first-dur)) durs) @@ -341,32 +344,35 @@ beats to be distinguished." (let ((es (ly:music-property music 'elements)) (e (ly:music-property music 'element))) - (if (memq 'repeated-music (ly:music-property music 'types)) + (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 (equal? old-name 'TremoloRepeatedMusic) - (let* ((seq-arg? (memq 'sequential-music - (ly:music-property e 'types))) - (count (ly:music-property music 'repeat-count)) - (dot-shift (if (= 0 (remainder count 3)) - -1 0)) - (child-count (if seq-arg? - (length (ly:music-property e 'elements)) - 0))) - - (if (= 0 -1) - (set! count (* 2 (quotient count 3)))) - - (shift-duration-log music (+ (if (= 2 child-count) - 1 0) - (ly:intlog2 count)) dot-shift) - - (if seq-arg? - (ly:music-compress e (ly:make-moment child-count 1))))))) + (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)))))) (if (pair? es) (set! (ly:music-property music 'elements) @@ -424,7 +430,7 @@ in @var{grob}." (make-sequential-music (append (map (lambda (x) (make-grob-property-set x 'direction - (if (odd? n) -1 1))) + (if (odd? n) -1 1))) direction-polyphonic-grobs) (list (make-property-set 'graceSettings @@ -447,6 +453,33 @@ in @var{grob}." (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) +(define-safe-public (make-voice-props-override n) + (make-sequential-music + (append + (map (lambda (x) (make-grob-property-override x 'direction + (if (odd? n) -1 1))) + direction-polyphonic-grobs) + (list + (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) + (Voice Stem length-fraction 0.8) + (Voice Stem no-stem-extend #t) + (Voice Beam beam-thickness 0.384) + (Voice Beam length-fraction 0.8) + (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-override 'NoteColumn 'horizontal-shift (quotient n 2)) + (make-grob-property-override 'MultiMeasureRest 'staff-position (if (odd? n) -4 4)))))) + (define-safe-public (make-voice-props-revert) (make-sequential-music (append @@ -577,6 +610,89 @@ inside of and outside of chord construct." (let ((ts (ly:music-property m 'types))) (memq 'separator ts))) +;;; expanding repeat chords +(define-public (copy-repeat-chord original-chord repeat-chord duration + event-types) + "Copies all events in @var{event-types} (be sure to include +@code{rhythmic-events}) from @var{original-chord} over to +@var{repeat-chord} with their articulations filtered as well. Any +duration is replaced with the specified @var{duration}." + ;; First remove everything from event-types that can already be + ;; found in the repeated chord. We don't need to look for + ;; articulations on individual events since they can't actually get + ;; into a repeat chord given its input syntax. + + (define (keep-element? m) + (any (lambda (t) (music-is-of-type? m t)) + event-types)) + (define origin (ly:music-property repeat-chord 'origin #f)) + (define (set-origin! l) + (if origin + (for-each (lambda (m) (set! (ly:music-property m 'origin) origin)) l)) + l) + + (for-each + (lambda (field) + (for-each (lambda (e) + (for-each (lambda (x) + (set! event-types (delq x event-types))) + (ly:music-property e 'types))) + (ly:music-property repeat-chord field))) + '(elements articulations)) + + ;; now treat the elements + (set! (ly:music-property repeat-chord 'elements) + (let ((elts + (set-origin! (ly:music-deep-copy + (filter keep-element? + (ly:music-property original-chord + 'elements)))))) + (for-each + (lambda (m) + (let ((arts (ly:music-property m 'articulations))) + (if (pair? arts) + (set! (ly:music-property m 'articulations) + (set-origin! (filter! keep-element? arts)))) + (if (ly:duration? (ly:music-property m 'duration)) + (set! (ly:music-property m 'duration) duration)))) + elts) + (append! elts (ly:music-property repeat-chord 'elements)))) + (let ((arts (filter keep-element? + (ly:music-property original-chord + 'articulations)))) + (if (pair? arts) + (set! (ly:music-property repeat-chord 'articulations) + (append! + (set-origin! (ly:music-deep-copy arts)) + (ly:music-property repeat-chord 'articulations)))))) + + +(define-public (expand-repeat-chords! event-types music) + "Walks through @var{music} and fills repeated chords (notable by +having a duration in @code{duration}) with the notes from their +respective predecessor chord." + (let loop ((music music) (last-chord #f)) + (if (music-is-of-type? music 'event-chord) + (let ((chord-repeat (ly:music-property music 'duration))) + (cond + ((not (ly:duration? chord-repeat)) + (if (any (lambda (m) (ly:duration? + (ly:music-property m 'duration))) + (ly:music-property music 'elements)) + music + last-chord)) + (last-chord + (set! (ly:music-property music 'duration) '()) + (copy-repeat-chord last-chord music chord-repeat event-types) + music) + (else + (ly:music-warning music (_ "Bad chord repetition")) + #f))) + (let ((elt (ly:music-property music 'element))) + (fold loop (if (ly:music? elt) (loop elt last-chord) last-chord) + (ly:music-property music 'elements))))) + music) + ;;; splitting chords into voices. (define (voicify-list lst number) "Make a list of Musics. @@ -749,7 +865,7 @@ NUMBER is 0-base, i.e., Voice=1 (upstems) has number 0. (defmacro-public define-syntax-function (type args signature . body) "Helper macro for `ly:make-music-function'. Syntax: - (define-syntax-function (result-type? parser location arg1 arg2 ...) (result-type? arg1-type arg2-type ...) + (define-syntax-function result-type? (parser location arg1 arg2 ...) (arg1-type arg2-type ...) ...function body...) argX-type can take one of the forms @code{predicate?} for mandatory @@ -873,40 +989,42 @@ set to the @code{location} parameter." (if (vector? (ly:music-property quote-music 'quoted-events)) (let* ((dir (ly:music-property quote-music 'quoted-voice-direction)) - (clef (ly:music-property quote-music 'quoted-music-clef)) - (main-voice (if (eq? 1 dir) 1 0)) - (cue-voice (if (eq? 1 dir) 0 1)) + (clef (ly:music-property quote-music 'quoted-music-clef #f)) + (main-voice (case dir ((1) 1) ((-1) 0) (else #f))) + (cue-voice (and main-voice (- 1 main-voice))) (main-music (ly:music-property quote-music 'element)) (return-value quote-music)) - (if (or (eq? 1 dir) (eq? -1 dir)) - - ;; if we have stem dirs, change both quoted and main music - ;; to have opposite stems. - (begin - (set! return-value - ;; cannot context-spec Quote-music, since context - ;; for the quotes is determined in the iterator. - (make-sequential-music - (list - (if (null? clef) - (make-music 'Music) - (make-cue-clef-set clef)) - (context-spec-music (make-voice-props-set cue-voice) 'CueVoice "cue") - quote-music - (context-spec-music (make-voice-props-revert) 'CueVoice "cue") - (if (null? clef) - (make-music 'Music) - (make-cue-clef-unset))))) - (set! main-music - (make-sequential-music - (list - (make-voice-props-set main-voice) - main-music - (make-voice-props-revert)))) - (set! (ly:music-property quote-music 'element) main-music))) - - return-value) + (if main-voice + (set! (ly:music-property quote-music 'element) + (make-sequential-music + (list + (make-voice-props-override main-voice) + main-music + (make-voice-props-revert))))) + + ;; if we have stem dirs, change both quoted and main music + ;; to have opposite stems. + + ;; cannot context-spec Quote-music, since context + ;; for the quotes is determined in the iterator. + + (make-sequential-music + (delq! #f + (list + (and clef (make-cue-clef-set clef)) + + ;; Need to establish CueVoice context even in #CENTER case + (context-spec-music + (if cue-voice + (make-voice-props-override cue-voice) + (make-music 'Music)) + 'CueVoice "cue") + quote-music + (and cue-voice + (context-spec-music + (make-voice-props-revert) 'CueVoice "cue")) + (and clef (make-cue-clef-unset)))))) quote-music)) (define-public ((quote-substitute quote-tab) music) @@ -1037,6 +1155,10 @@ then revert skipTypesetting." (define-public toplevel-music-functions (list + (lambda (music parser) (expand-repeat-chords! + (cons 'rhythmic-event + (ly:parser-lookup parser '$chord-repeat-events)) + music)) (lambda (music parser) (voicify-music music)) (lambda (x parser) (music-map music-check-error x)) (lambda (x parser) (music-map precompute-music-length x)) @@ -1308,14 +1430,14 @@ as a context." `(Staff ,(make-accidental-rule 'same-octave 0)) '() context)) - ;; accidentals from one voice do NOT get cancelled in other voices + ;; accidentals from one voice do NOT get canceled in other voices ((equal? style 'voice) (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 + ;; This includes all the default accidentals, but accidentals also needs canceling ;; in other octaves and in the next measure. ((equal? style 'modern) (set-accidentals-properties #f @@ -1380,7 +1502,7 @@ as a context." 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. + ;; Accidentals are typeset for each voice, but they ARE canceled across voices. ((equal? style 'modern-voice) (set-accidentals-properties #f `(Voice ,(make-accidental-rule 'same-octave 0) @@ -1403,7 +1525,7 @@ as a context." ,(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 + ;; Accidentals are canceled across the staves in the same grand staff as well ((equal? style 'piano) (set-accidentals-properties #f `(Staff ,(make-accidental-rule 'same-octave 0) @@ -1515,32 +1637,123 @@ Entries that conform with the current key signature are not invalidated." (ly:music-property (car evs) 'pitch)))) (define-public (duration-of-note event-chord) - (let ((evs (filter (lambda (x) - (music-has-type x 'rhythmic-event)) - (ly:music-property event-chord 'elements)))) - - (and (pair? evs) - (ly:music-property (car evs) 'duration)))) + (cond + ((pair? event-chord) + (or (duration-of-note (car event-chord)) + (duration-of-note (cdr event-chord)))) + ((ly:music? event-chord) + (let ((dur (ly:music-property event-chord 'duration))) + (if (ly:duration? dur) + dur + (duration-of-note (ly:music-property event-chord 'elements))))) + (else #f))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define-public (map-some-music map? music) + "Walk through @var{music}, transform all elements calling @var{map?} +and only recurse if this returns @code{#f}." + (let loop ((music music)) + (or (map? music) + (let ((elt (ly:music-property music 'element)) + (elts (ly:music-property music 'elements)) + (arts (ly:music-property music 'articulations))) + (if (ly:music? elt) + (set! (ly:music-property music 'element) + (loop elt))) + (if (pair? elts) + (set! (ly:music-property music 'elements) + (map loop elts))) + (if (pair? arts) + (set! (ly:music-property music 'articulations) + (map loop arts))) + music)))) + +(define-public (for-some-music stop? music) + "Walk through @var{music}, process all elements calling @var{stop?} +and only recurse if this returns @code{#f}." + (let loop ((music music)) + (if (not (stop? music)) + (let ((elt (ly:music-property music 'element))) + (if (ly:music? elt) + (loop elt)) + (for-each loop (ly:music-property music 'elements)) + (for-each loop (ly:music-property music 'articulations)))))) + +(define-public (fold-some-music pred? proc init music) + "This works recursively on music like @code{fold} does on a list, +calling @samp{(@var{pred?} music)} on every music element. If +@code{#f} is returned for an element, it is processed recursively +with the same initial value of @samp{previous}, otherwise +@samp{(@var{proc} music previous)} replaces @samp{previous} +and no recursion happens. +The top @var{music} is processed using @var{init} for @samp{previous}." + (let loop ((music music) (previous init)) + (if (pred? music) + (proc music previous) + (fold loop + (fold loop + (let ((elt (ly:music-property music 'element))) + (if (null? elt) + previous + (loop elt previous))) + (ly:music-property music 'elements)) + (ly:music-property music 'articulations))))) + +(define-public (extract-music music pred?) + "Return a flat list of all music matching @var{pred?} inside of +@var{music}, not recursing into matches themselves." + (reverse! (fold-some-music pred? cons '() music))) + (define-public (extract-named-music music music-name) - "Return a flat list of all music named @var{music-name} from @var{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))) + "Return a flat list of all music named @var{music-name} (either a +single event symbol or a list of alternatives) inside of @var{music}, +not recursing into matches themselves." + (extract-music + music + (if (cheap-list? music-name) + (lambda (m) (memq (ly:music-property m 'name) music-name)) + (lambda (m) (eq? (ly:music-property m 'name) music-name))))) + +(define-public (extract-typed-music music type) + "Return a flat list of all music with @var{type} (either a single +type symbol or a list of alternatives) inside of @var{music}, not +recursing into matches themselves." + (extract-music + music + (if (cheap-list? type) + (lambda (m) + (any (lambda (t) (music-is-of-type? m t)) type)) + (lambda (m) (music-is-of-type? m type))))) + +(define*-public (event-chord-wrap! music #:optional parser) + "Wrap isolated rhythmic events and non-postevent events in +@var{music} inside of an @code{EventChord}. If the optional +@var{parser} argument is given, chord repeats @samp{q} are expanded +using the default settings. Otherwise, you need to cater for them +yourself." + (map-some-music + (lambda (m) + (cond ((music-is-of-type? m 'event-chord) + (if (pair? (ly:music-property m 'articulations)) + (begin + (set! (ly:music-property m 'elements) + (append (ly:music-property m 'elements) + (ly:music-property m 'articulations))) + (set! (ly:music-property m 'articulations) '()))) + m) + ((music-is-of-type? m 'rhythmic-event) + (let ((arts (ly:music-property m 'articulations))) + (if (pair? arts) + (set! (ly:music-property m 'articulations) '())) + (make-event-chord (cons m arts)))) + (else #f))) + (if parser + (expand-repeat-chords! + (cons 'rhythmic-event + (ly:parser-lookup parser '$chord-repeat-events)) + music) + music))) (define-public (event-chord-notes event-chord) "Return a list of all notes from @var{event-chord}." @@ -1552,3 +1765,112 @@ Entries that conform with the current key signature are not invalidated." "Return a list of all pitches from @var{event-chord}." (map (lambda (x) (ly:music-property x 'pitch)) (event-chord-notes event-chord))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; The following functions are all associated with the crossStaff +; function + +(define (close-enough? x y) + "Values are close enough to ignore the difference" + (< (abs (- x y)) 0.0001)) + +(define (extent-combine extents) + "Combine a list of extents" + (if (pair? (cdr extents)) + (interval-union (car extents) (extent-combine (cdr extents))) + (car extents))) + +(define ((stem-connectable? ref root) stem) + "Check if the stem is connectable to the root" + ; The root is always connectable to itself + (or (eq? root stem) + (and + ; Horizontal positions of the stems must be almost the same + (close-enough? (car (ly:grob-extent root ref X)) + (car (ly:grob-extent stem ref X))) + ; The stem must be in the direction away from the root's notehead + (positive? (* (ly:grob-property root 'direction) + (- (car (ly:grob-extent stem ref Y)) + (car (ly:grob-extent root ref Y)))))))) + +(define (stem-span-stencil span) + "Connect stems if we have at least one stem connectable to the root" + (let* ((system (ly:grob-system span)) + (root (ly:grob-parent span X)) + (stems (filter (stem-connectable? system root) + (ly:grob-object span 'stems)))) + (if (<= 2 (length stems)) + (let* ((yextents (map (lambda (st) + (ly:grob-extent st system Y)) stems)) + (yextent (extent-combine yextents)) + (layout (ly:grob-layout root)) + (blot (ly:output-def-lookup layout 'blot-diameter))) + ; Hide spanned stems + (map (lambda (st) + (set! (ly:grob-property st 'transparent) #t)) + stems) + ; Draw a nice looking stem with rounded corners + (ly:round-filled-box (ly:grob-extent root root X) yextent blot)) + ; Nothing to connect, don't draw the span + #f))) + +(define ((make-stem-span! stems trans) root) + "Create a stem span as a child of the cross-staff stem (the root)" + (let ((span (ly:engraver-make-grob trans 'Stem '()))) + (ly:grob-set-parent! span X root) + (set! (ly:grob-object span 'stems) stems) + ; Suppress positioning, the stem code is confused by this weird stem + (set! (ly:grob-property span 'X-offset) 0) + (set! (ly:grob-property span 'stencil) stem-span-stencil))) + +(define-public (cross-staff-connect stem) + "Set cross-staff property of the stem to this function to connect it to +other stems automatically" + #t) + +(define (stem-is-root? stem) + "Check if automatic connecting of the stem was requested. Stems connected +to cross-staff beams are cross-staff, but they should not be connected to +other stems just because of that." + (eq? cross-staff-connect (ly:grob-property-data stem 'cross-staff))) + +(define (make-stem-spans! ctx stems trans) + "Create stem spans for cross-staff stems" + ; Cannot do extensive checks here, just make sure there are at least + ; two stems at this musical moment + (if (<= 2 (length stems)) + (let ((roots (filter stem-is-root? stems))) + (map (make-stem-span! stems trans) roots)))) + +(define-public (Span_stem_engraver ctx) + "Connect cross-staff stems to the stems above in the system" + (let ((stems '())) + (make-engraver + ; Record all stems for the given moment + (acknowledgers + ((stem-interface trans grob source) + (set! stems (cons grob stems)))) + ; Process stems and reset the stem list to empty + ((process-acknowledged trans) + (make-stem-spans! ctx stems trans) + (set! stems '()))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; The following is used by the alterBroken function. + +(define-public ((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)) + (siblings (ly:spanner-broken-into orig))) + + (define (helper sibs arg) + (if (null? arg) + arg + (if (eq? (car sibs) grob) + (car arg) + (helper (cdr sibs) (cdr arg))))) + + (if (>= (length siblings) 2) + (helper siblings arg) + (car arg))))