diff options
Diffstat (limited to 'scm/bar-line.scm')
| -rw-r--r-- | scm/bar-line.scm | 134 |
1 files changed, 69 insertions, 65 deletions
diff --git a/scm/bar-line.scm b/scm/bar-line.scm index ad47fbc249..8ac123e11e 100644 --- a/scm/bar-line.scm +++ b/scm/bar-line.scm @@ -814,76 +814,80 @@ no elements." "The print routine for span bars." (let* ((elts-array (ly:grob-object grob 'elements)) (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) - (elts (sort (ly:grob-array->list elts-array) - ly:grob-vertical<?)) + (elts (reverse (sort (ly:grob-array->list elts-array) + ly:grob-vertical<?))) ;; Elements must be ordered according to their y coordinates ;; relative to their common axis group parent. ;; Otherwise, the computation goes mad. - (bar-glyph (ly:grob-property grob 'glyph-name))) + (bar-glyph (ly:grob-property grob 'glyph-name)) + (span-bar empty-stencil)) (if (string? bar-glyph) - (let loop ((extents '()) - (make-span-bars '()) - ;; if there is no bar grob, we use the callback - ;; argument - (model-bar grob) - (bar-list elts)) - - ;; we compute the extents of each system and store them - ;; in a list; dito for the 'allow-span-bar property. - ;; model-bar takes the bar grob, if given. - (if (pair? bar-list) - (let* ((bar (car bar-list)) - (ext (bar-line::bar-y-extent bar refp)) - (staff-symbol (ly:grob-object bar 'staff-symbol))) - (if (ly:grob? staff-symbol) - (if (positive? (interval-length ext)) - (loop (cons (interval-union - ext - (ly:grob-extent staff-symbol refp Y)) - extents) - (cons (ly:grob-property - bar 'allow-span-bar #t) - make-span-bars) - bar - (cdr bar-list)) - (loop extents make-span-bars - model-bar (cdr bar-list)))))) - ;; end of loop - ;; model-bar is the last bar found in the elts list - ;; (former version had the first here). - - ;; the span bar reaches from the lower end of the upper staff - ;; to the upper end of the lower staff - when - ;; allow-span-bar is #t - - (if (pair? extents) - (ly:stencil-translate-axis - (fold - (lambda (curr prev allow-span-bar span-bar) - (if (and allow-span-bar - (positive? (interval-length prev))) - (let ((span-extent (cons (cdr prev) (car curr)))) - ;; draw the span bar only when the staff lines - ;; don't overlap and allow-span-bar is #t: - (if (positive? (interval-length span-extent)) - (ly:stencil-add - span-bar - (span-bar::compound-bar-line - model-bar - bar-glyph - span-extent)) - span-bar)) - span-bar)) - empty-stencil - ;; we discard the first entry in make-span-bars, - ;; because its corresponding bar line is the - ;; uppermost and therefore not connected to - ;; another bar line - (cdr extents) extents (cdr make-span-bars)) - (- (ly:grob-relative-coordinate grob refp Y)) Y) - empty-stencil)) - empty-stencil))) + (let ((extents '()) + (make-span-bars '()) + (model-bar #f)) + + ;; we compute the extents of each system and store them + ;; in a list; dito for the 'allow-span-bar property. + ;; model-bar takes the bar grob, if given. + (map (lambda (bar) + (let ((ext (bar-line::bar-y-extent bar refp)) + (staff-symbol (ly:grob-object bar 'staff-symbol))) + + (if (ly:grob? staff-symbol) + (let ((refp-extent (ly:grob-extent staff-symbol refp Y))) + + (set! ext (interval-union ext refp-extent)) + + (if (> (interval-length ext) 0) + (begin + (set! extents (append extents (list ext))) + (set! model-bar bar) + (set! make-span-bars + (append make-span-bars + (list (ly:grob-property + bar + 'allow-span-bar + #t)))))))))) + elts) + ;; if there is no bar grob, we use the callback argument + (if (not model-bar) + (set! model-bar grob)) + ;; we discard the first entry in make-span-bars, + ;; because its corresponding bar line is the + ;; uppermost and therefore not connected to + ;; another bar line + (if (pair? make-span-bars) + (set! make-span-bars (cdr make-span-bars))) + ;; the span bar reaches from the lower end of the upper staff + ;; to the upper end of the lower staff - when allow-span-bar is #t + (reduce (lambda (curr prev) + (let ((span-extent (cons 0 0)) + (allow-span-bar (car make-span-bars))) + + (set! make-span-bars (cdr make-span-bars)) + (if (> (interval-length prev) 0) + (begin + (set! span-extent (cons (cdr prev) + (car curr))) + ;; draw the span bar only when the staff lines + ;; don't overlap and allow-span-bar is #t: + (and (> (interval-length span-extent) 0) + allow-span-bar + (set! span-bar + (ly:stencil-add + span-bar + (span-bar::compound-bar-line + model-bar + bar-glyph + span-extent)))))) + curr)) + "" extents) + (set! span-bar (ly:stencil-translate-axis + span-bar + (- (ly:grob-relative-coordinate grob refp Y)) + Y)))) + span-bar)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; volta bracket functions |