From: David Kastrup <dak@gnu.org>
Date: Thu, 14 Mar 2013 09:02:41 +0000 (+0100)
Subject: Revert "Issue 3203: Clean up bar-line.scm some more"
X-Git-Tag: release/2.17.15-1~17^2~24
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=1b5411dfa53d6a278634865dbab09ddb0af0de95;p=lilypond.git

Revert "Issue 3203: Clean up bar-line.scm some more"

This reverts commit ebd9ee599bed31f19785c1b215ad1c716d071a46.
---

diff --git a/scm/bar-line.scm b/scm/bar-line.scm
index ce3288b205..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