scm/bar-line.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2009--2012 Marc Hohl <marc@hohlart.de>
   4 ;;;;
   5 ;;;; LilyPond is free software: you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; LilyPond is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;; helper functions
  19
  20 (define (get-staff-symbol grob)
  21   (if (grob::has-interface grob 'staff-symbol-interface)
  22       grob
  23       (ly:grob-object grob 'staff-symbol)))
  24
  25 (define (layout-blot-diameter grob)
  26   (let* ((layout (ly:grob-layout grob))
  27          (blot (ly:output-def-lookup layout 'blot-diameter)))
  28
  29         blot))
  30
  31 (define (layout-line-thickness grob)
  32   (let* ((layout (ly:grob-layout grob))
  33          (line-thickness (ly:output-def-lookup layout 'line-thickness)))
  34
  35         line-thickness))
  36
  37 (define (staff-symbol-line-count grob)
  38   (let ((line-count 0))
  39
  40        (if (ly:grob? grob)
  41            (let ((line-pos (ly:grob-property grob 'line-positions '())))
  42
  43                 (set! line-count (if (pair? line-pos)
  44                                      (length line-pos)
  45                                      (ly:grob-property grob 'line-count 0)))))
  46
  47          line-count))
  48
  49 (define (staff-symbol-line-span grob)
  50   (let ((line-pos (ly:grob-property grob 'line-positions '()))
  51         (iv (cons 0.0 0.0)))
  52
  53        (if (pair? line-pos)
  54            (map (lambda (x)
  55                         (set! iv (cons (min (car iv) x)
  56                                        (max (cdr iv) x))))
  57                 line-pos)
  58            (let ((line-count (ly:grob-property grob 'line-count 0)))
  59
  60                 (set! iv (cons (- 1 line-count)
  61                                (- line-count 1)))))
  62        iv))
  63
  64 (define (staff-symbol-line-positions grob)
  65   (let ((line-pos (ly:grob-property grob 'line-positions '())))
  66
  67        (if (not (pair? line-pos))
  68            (let* ((line-count (ly:grob-property grob 'line-count 0))
  69                   (height (- line-count 1.0)))
  70
  71                  (set! line-pos (map (lambda (x)
  72                                              (- height (* x 2)))
  73                                      (iota line-count)))))
  74        line-pos))
  75
  76 ;; functions used by external routines
  77
  78 (define-public (span-bar::notify-grobs-of-my-existence grob)
  79   (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements)))
  80          (sorted-elts (sort elts ly:grob-vertical<?))
  81          (last-pos (1- (length sorted-elts)))
  82          (idx 0))
  83
  84         (map (lambda (g)
  85                      (ly:grob-set-property!
  86                        g
  87                        'has-span-bar
  88                        (cons (if (eq? idx last-pos)
  89                                  #f
  90                                  grob)
  91                              (if (zero? idx)
  92                                  #f
  93                                  grob)))
  94                       (set! idx (1+ idx)))
  95              sorted-elts)))
  96
  97 ;; How should a bar line behave at a break?
  98 ;; the following alist has the form
  99 ;; ( unbroken-bar-glyph . ( bar-glyph-at-end-of-line . bar-glyph-at-begin-of-line ))
 100
 101 (define bar-glyph-alist
 102   '((":|:" . (":|" . "|:"))
 103     (":|.|:" . (":|" . "|:"))
 104     (":|.:" . (":|" . "|:"))
 105     ("||:" . ("||" . "|:"))
 106     ("dashed" . ("dashed" . '()))
 107     ("|" . ("|" . ()))
 108     ("|s" . (() . "|"))
 109     ("|:" . ("|" . "|:"))
 110     ("|." . ("|." . ()))
 111
 112     ;; hmm... should we end with a bar line here?
 113     (".|" . ("|" . ".|"))
 114     (":|" . (":|" . ()))
 115     ("||" . ("||" . ()))
 116     (".|." . (".|." . ()))
 117     ("|.|" . ("|.|" . ()))
 118     ("" . ("" . ""))
 119     (":" . (":" . ""))
 120     ("." . ("." . ()))
 121     ("'" . ("'" . ()))
 122     ("empty" . (() . ()))
 123     ("brace" . (() . "brace"))
 124     ("bracket" . (() . "bracket"))
 125
 126     ;; segno bar lines
 127     ("S" . ("||" . "S"))
 128     ("|S" . ("|" . "S"))
 129     ("S|" . ("S" . ()))
 130     (":|S" . (":|" . "S"))
 131     (":|S." . (":|S" . ()))
 132     ("S|:" . ("S" . "|:"))
 133     (".S|:" . ("|" . "S|:"))
 134     (":|S|:" . (":|" . "S|:"))
 135     (":|S.|:" . (":|S" . "|:"))
 136
 137     ;; ancient bar lines
 138     ("kievan" . ("kievan" . ""))))
 139
 140 ;; drawing functions for various bar line types
 141
 142 (define (make-empty-bar-line grob extent)
 143   (ly:make-stencil "" (cons 0 0) extent))
 144
 145 (define (make-simple-bar-line grob width extent rounded)
 146   (let ((blot (if rounded
 147                   (layout-blot-diameter grob)
 148                   0)))
 149
 150         (ly:round-filled-box (cons 0 width)
 151                              extent
 152                              blot)))
 153
 154 (define (make-tick-bar-line grob height rounded)
 155   (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob)))
 156         (staff-line-thickness (ly:staff-symbol-line-thickness grob))
 157         (blot (if rounded
 158                   (layout-blot-diameter grob)
 159                   0)))
 160
 161        (ly:round-filled-box (cons 0 staff-line-thickness)
 162                             (cons (- height half-staff) (+ height half-staff))
 163                             blot)))
 164
 165 (define (make-colon-bar-line grob)
 166   (let* ((staff-space (ly:staff-symbol-staff-space grob))
 167          (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot"))
 168          (staff-symbol (get-staff-symbol grob))
 169          (lines (staff-symbol-line-count staff-symbol))
 170          (stencil empty-stencil)
 171          (dist (* (if (or (odd? lines)
 172                           (zero? lines))
 173                       1
 174                       (if (< staff-space 2)
 175                           2
 176                           0.5))
 177                   staff-space)))
 178
 179         (if (zero? staff-space)
 180             (set! staff-space 1.0))
 181
 182         (let* ((stencil (ly:stencil-add stencil dot))
 183                (stencil (ly:stencil-translate-axis
 184                           stencil dist Y))
 185                (stencil (ly:stencil-add stencil dot))
 186                (stencil (ly:stencil-translate-axis
 187                           stencil (/ dist -2) Y)))
 188               stencil)))
 189
 190 (define (make-dotted-bar-line grob extent)
 191   (let* ((position (round (* (interval-end extent) 2)))
 192          (correction (if (even? position) 0.5 0.0))
 193          (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot"))
 194          (i (round (+ (interval-start extent)
 195                       (- 0.5 correction))))
 196          (e (round (+ (interval-end extent)
 197                       (- 0.5 correction))))
 198          (counting (interval-length (cons i e)))
 199          (stil-list (map
 200                       (lambda (x)
 201                               (ly:stencil-translate-axis
 202                                 dot (+ x correction) Y))
 203                       (iota counting i 1))))
 204
 205         (define (add-stencils! stil l)
 206           (if (null? l)
 207               stil
 208               (if (null? (cdr l))
 209                   (ly:stencil-add stil (car l))
 210                   (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
 211
 212         (add-stencils! empty-stencil stil-list)))
 213
 214 (define (make-dashed-bar-line grob extent thickness)
 215   (let* ((height (interval-length extent))
 216          (staff-symbol (get-staff-symbol grob))
 217          (staff-space (ly:staff-symbol-staff-space grob))
 218          (line-thickness (layout-line-thickness grob))
 219          (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3)))
 220          (line-count (staff-symbol-line-count staff-symbol)))
 221
 222         (if (< (abs (+ line-thickness
 223                        (* (1- line-count) staff-space)
 224                        (- height)))
 225                0.1)
 226             (let ((blot (layout-blot-diameter grob))
 227                   (half-space (/ staff-space 2.0))
 228                   (half-thick (/ line-thickness 2.0))
 229                   (stencil empty-stencil))
 230
 231                  (map (lambda (i)
 232                       (let ((top-y (min (* (+ i dash-size) half-space)
 233                                         (+ (* (1- line-count) half-space)
 234                                            half-thick)))
 235                             (bot-y (max (* (- i dash-size) half-space)
 236                                         (- 0 (* (1- line-count) half-space)
 237                                            half-thick))))
 238
 239                            (set! stencil
 240                                  (ly:stencil-add
 241                                    stencil
 242                                    (ly:round-filled-box (cons 0 thickness)
 243                                                         (cons bot-y top-y)
 244                                                         blot)))))
 245                       (iota line-count (1- line-count) (- 2)))
 246             stencil)
 247             (let* ((dashes (/ height staff-space))
 248                    (total-dash-size (/ height dashes))
 249                    (factor (/ (- dash-size thickness) staff-space)))
 250
 251                   (ly:stencil-translate-axis
 252                     (ly:make-stencil (list 'dashed-line
 253                                            thickness
 254                                            (* factor total-dash-size)
 255                                            (* (- 1 factor) total-dash-size)
 256                                            0
 257                                            height
 258                                            (* factor total-dash-size 0.5))
 259                                            (cons 0 thickness)
 260                                            (cons 0 height))
 261                                            (interval-start extent)
 262                                            Y)))))
 263
 264 (define (make-segno-bar-line grob glyph extent rounded)
 265   (let* ((line-thickness (layout-line-thickness grob))
 266          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 267          (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
 268          (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness))
 269          (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness))
 270          (thin-stil (make-simple-bar-line grob hair extent rounded))
 271          (thick-stil (make-simple-bar-line grob fatline extent rounded))
 272          (colon-stil (make-colon-bar-line grob))
 273          (segno-stil (ly:stencil-add
 274                        (ly:stencil-combine-at-edge
 275                          (ly:stencil-combine-at-edge
 276                            '() X LEFT thin-stil thinkern)
 277                          X RIGHT thin-stil thinkern)
 278                        (ly:font-get-glyph (ly:grob-default-font grob) "scripts.varsegno")))
 279          (glyph (cond
 280                   ((string=? glyph "|S") "S")
 281                   ((string=? glyph "S|") "S")
 282                   (else glyph)))
 283          (stencil (cond
 284                     ((or (string=? glyph "S|:")
 285                          (string=? glyph ".S|:"))
 286                      (ly:stencil-combine-at-edge
 287                        (ly:stencil-combine-at-edge
 288                          (ly:stencil-combine-at-edge
 289                            thick-stil X RIGHT thin-stil kern)
 290                          X RIGHT colon-stil kern)
 291                        X LEFT segno-stil thinkern))
 292                     ((or (string=? glyph ":|S")
 293                          (string=? glyph ":|S."))
 294                      (ly:stencil-combine-at-edge
 295                        (ly:stencil-combine-at-edge
 296                          (ly:stencil-combine-at-edge
 297                            thick-stil X LEFT thin-stil kern)
 298                          X LEFT colon-stil kern)
 299                        X RIGHT segno-stil thinkern))
 300                     ((or (string=? glyph ":|S|:")
 301                          (string=? glyph ":|S.|:"))
 302                      (ly:stencil-combine-at-edge
 303                        (ly:stencil-combine-at-edge
 304                          (ly:stencil-combine-at-edge
 305                            (ly:stencil-combine-at-edge
 306                              (ly:stencil-combine-at-edge
 307                                (ly:stencil-combine-at-edge
 308                                  thick-stil X LEFT thin-stil kern)
 309                                X LEFT colon-stil kern)
 310                              X RIGHT segno-stil thinkern)
 311                            X RIGHT thick-stil thinkern)
 312                          X RIGHT thin-stil kern)
 313                        X RIGHT colon-stil kern))
 314                     ((string=? glyph "|._.|")
 315                      (ly:stencil-combine-at-edge
 316                        (ly:stencil-combine-at-edge
 317                          (ly:stencil-combine-at-edge
 318                            thick-stil X LEFT thin-stil kern)
 319                          X RIGHT thick-stil (+ (interval-length
 320                                                  (ly:stencil-extent segno-stil X))
 321                                                (* 2 thinkern)))
 322                        X RIGHT thin-stil kern))
 323                     (else segno-stil))))
 324
 325        stencil))
 326
 327 (define (make-kievan-bar-line grob)
 328   (let* ((font (ly:grob-default-font grob))
 329          (stencil (stencil-whiteout
 330                     (ly:font-get-glyph font "scripts.barline.kievan"))))
 331
 332         ;; the kievan bar line has mo staff lines underneath,
 333         ;; so we whiteout them and move ithe grob to a higher layer
 334         (ly:grob-set-property! grob 'layer 1)
 335         stencil))
 336
 337 ;; bar line callbacks
 338
 339 (define-public (ly:bar-line::calc-bar-extent grob)
 340   (let ((staff-symbol (get-staff-symbol grob))
 341         (staff-extent (cons 0 0)))
 342
 343        (if (ly:grob? staff-symbol)
 344            (let* ((bar-line-color (ly:grob-property grob 'color))
 345                   (staff-color (ly:grob-property staff-symbol 'color))
 346                   (radius (ly:staff-symbol-staff-radius grob))
 347                   (staff-line-thickness (ly:staff-symbol-line-thickness grob)))
 348
 349                  ;; Due to rounding problems, bar lines extending to the outermost edges
 350                  ;; of the staff lines appear wrongly in on-screen display
 351                  ;; (and, to a lesser extent, in print) - they stick out a pixel.
 352                  ;; The solution is to extend bar lines only to the middle
 353                  ;; of the staff line - unless they have different colors,
 354                  ;;when it would be undesirable.
 355                  (set! staff-extent (ly:staff-symbol::height staff-symbol))
 356                  (if (and (eq? bar-line-color staff-color)
 357                           radius)
 358                      (set! staff-extent
 359                        (interval-scale staff-extent
 360                                        (- 1 (* 1/2 (/ staff-line-thickness radius))))))))
 361        staff-extent))
 362
 363 (define (bar-line::bar-y-extent grob refpoint)
 364   (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0)))
 365          (rel-y (ly:grob-relative-coordinate grob refpoint Y))
 366          (y-extent (coord-translate extent rel-y)))
 367
 368         y-extent))
 369
 370 (define-public (ly:bar-line::print grob)
 371   (let ((glyph (ly:grob-property grob 'glyph-name))
 372         (extent (ly:grob-property grob 'bar-extent '(0 . 0))))
 373
 374        (if (and (not (eq? glyph '()))
 375                 (> (interval-length extent) 0))
 376            (bar-line::compound-bar-line grob glyph extent #f)
 377            #f)))
 378
 379 (define-public (bar-line::compound-bar-line grob glyph extent rounded)
 380   (let* ((line-thickness (layout-line-thickness grob))
 381          (height (interval-length extent))
 382          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 383          (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
 384          (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness))
 385          (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness))
 386          (thin-stil (make-simple-bar-line grob hair extent rounded))
 387          (thick-stil (make-simple-bar-line grob fatline extent rounded))
 388          (colon-stil (make-colon-bar-line grob))
 389          (glyph (cond
 390                   ((not glyph) "")
 391                   ((string=? glyph "||:") "|:")
 392                   ;; bar-line::compound-bar-line is called only if
 393                   ;; height > 0, but just in case ...
 394                   ((and (string=? glyph ":|")
 395                         (zero? height)) "|.")
 396                   ((and (string=? glyph "|:")
 397                         (zero? height)) ".|")
 398                   (else glyph)))
 399          (stencil (cond
 400                     ((string=? glyph "|") thin-stil)
 401                     ((string=? glyph ".") thick-stil)
 402                     ((string=? glyph "||")
 403                      (ly:stencil-combine-at-edge
 404                        (ly:stencil-combine-at-edge
 405                          '() X LEFT thin-stil thinkern)
 406                        X RIGHT thin-stil thinkern))
 407                     ((string=? glyph "|.")
 408                      (ly:stencil-combine-at-edge
 409                        thick-stil X LEFT thin-stil kern))
 410                     ((string=? glyph ".|")
 411                      (ly:stencil-combine-at-edge
 412                        thick-stil X RIGHT thin-stil kern))
 413                     ((string=? glyph "|:")
 414                      (ly:stencil-combine-at-edge
 415                        (ly:stencil-combine-at-edge
 416                          thick-stil X RIGHT thin-stil kern)
 417                        X RIGHT colon-stil kern))
 418                     ((string=? glyph ":|")
 419                      (ly:stencil-combine-at-edge
 420                        (ly:stencil-combine-at-edge
 421                          thick-stil X LEFT thin-stil kern)
 422                        X LEFT colon-stil kern))
 423                     ((string=? glyph ":|:")
 424                      (ly:stencil-combine-at-edge
 425                        (ly:stencil-combine-at-edge
 426                          (ly:stencil-combine-at-edge
 427                            (ly:stencil-combine-at-edge
 428                              '() X LEFT thick-stil thinkern)
 429                            X LEFT colon-stil kern)
 430                          X RIGHT thick-stil kern)
 431                        X RIGHT colon-stil kern))
 432                     ((string=? glyph ":|.|:")
 433                      (ly:stencil-combine-at-edge
 434                        (ly:stencil-combine-at-edge
 435                          (ly:stencil-combine-at-edge
 436                            (ly:stencil-combine-at-edge
 437                              thick-stil X LEFT thin-stil kern)
 438                            X LEFT colon-stil kern)
 439                          X RIGHT thin-stil kern)
 440                        X RIGHT colon-stil kern))
 441                     ((string=? glyph ":|.:")
 442                      (ly:stencil-combine-at-edge
 443                        (ly:stencil-combine-at-edge
 444                          (ly:stencil-combine-at-edge
 445                            thick-stil X LEFT thin-stil kern)
 446                          X LEFT colon-stil kern)
 447                        X RIGHT colon-stil kern))
 448                     ((string=? glyph ".|.")
 449                      (ly:stencil-combine-at-edge
 450                        (ly:stencil-combine-at-edge
 451                          '() X LEFT thick-stil thinkern)
 452                        X RIGHT thick-stil kern))
 453                     ((string=? glyph "|.|")
 454                      (ly:stencil-combine-at-edge
 455                        (ly:stencil-combine-at-edge
 456                          thick-stil X LEFT thin-stil kern)
 457                        X RIGHT thin-stil kern))
 458                     ((string=? glyph ":")
 459                      (make-dotted-bar-line grob extent))
 460                     ((or (string=? glyph "|._.|")
 461                          (string-contains glyph "S"))
 462                      (make-segno-bar-line grob glyph extent rounded))
 463                     ((string=? glyph "'")
 464                      (make-tick-bar-line grob (interval-end extent) rounded))
 465                     ((string=? glyph "dashed")
 466                      (make-dashed-bar-line grob extent hair))
 467                     ((string=? glyph "kievan")
 468                      (make-kievan-bar-line grob))
 469                     (else (make-empty-bar-line grob extent)))))
 470          stencil))
 471
 472 (define-public (ly:bar-line::calc-anchor grob)
 473   (let* ((line-thickness (layout-line-thickness grob))
 474          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 475          (glyph (ly:grob-property grob 'glyph-name ""))
 476          (x-extent (ly:grob-extent grob grob X))
 477          (dot-width (+ (interval-length
 478                          (ly:stencil-extent
 479                            (ly:font-get-glyph
 480                              (ly:grob-default-font grob)
 481                              "dots.dot")
 482                            X))
 483                        kern))
 484          (anchor 0.0))
 485
 486         (if (> (interval-length x-extent) 0)
 487             (begin
 488               (set! anchor (interval-center x-extent))
 489               (cond ((string=? glyph "|:")
 490                      (set! anchor (+ anchor (/ dot-width -2.0))))
 491                     ((string=? glyph ":|")
 492                      (set! anchor (+ anchor (/ dot-width 2.0)))))))
 493         anchor))
 494
 495 (define-public (bar-line::calc-glyph-name grob)
 496   (let* ((glyph (ly:grob-property grob 'glyph))
 497          (dir (ly:item-break-dir grob))
 498          (result (assoc-get glyph bar-glyph-alist))
 499          (glyph-name (if (= dir CENTER)
 500                          glyph
 501                          (if (and result
 502                                   (string? (index-cell result dir)))
 503                             (index-cell result dir)
 504                             #f))))
 505         glyph-name))
 506
 507 (define-public (bar-line::calc-break-visibility grob)
 508   (let* ((glyph (ly:grob-property grob 'glyph))
 509          (result (assoc-get glyph bar-glyph-alist)))
 510
 511     (if result
 512         (vector (string? (car result)) #t (string? (cdr result)))
 513         all-invisible)))
 514
 515 ;; which span bar belongs to a bar line?
 516
 517 (define-public span-bar-glyph-alist
 518   '(("|:" . ".|")
 519     ("||:" . ".|")
 520     (":|" . "|.")
 521     (":|.:" . "|.")
 522     (":|:" . ".|.")
 523     (":|.|:" . "|.|")
 524     (":|.|" . "|.")
 525     ("S" . "||" )
 526     ("S|" . "||")
 527     ("|S" . "||")
 528     ("S|:" . ".|")
 529     (".S|:" . ".|")
 530     (":|S" . "|.")
 531     (":|S." . "|.")
 532     (":|S|:" . "|._.|")
 533     (":|S.|:" . "|._.|")
 534     ("kievan" . "")
 535     ("'" . "")))
 536
 537 ;; span bar callbacks
 538
 539 (define-public (ly:span-bar::calc-glyph-name grob)
 540   (let* ((elts (ly:grob-object grob 'elements))
 541          (pos (1- (ly:grob-array-length elts)))
 542          (glyph '()))
 543
 544         (while (and (eq? glyph '())
 545                     (> pos -1))
 546                (begin (set! glyph (ly:grob-property (ly:grob-array-ref elts pos)
 547                                                     'glyph-name))
 548                       (set! pos (1- pos))))
 549          (if (eq? glyph '())
 550              (begin (ly:grob-suicide! grob)
 551                     (set! glyph "")))
 552         (assoc-get glyph span-bar-glyph-alist glyph)))
 553
 554 (define-public (ly:span-bar::width grob)
 555   (let ((width (cons 0 0)))
 556
 557        (if (grob::is-live? grob)
 558            (let* ((glyph (ly:grob-property grob 'glyph-name))
 559                   (stencil (bar-line::compound-bar-line grob glyph (cons -1 1) #f)))
 560
 561                  (set! width (ly:stencil-extent stencil X))))
 562        width))
 563
 564 (define-public (ly:span-bar::before-line-breaking grob)
 565   (let ((elts (ly:grob-object grob 'elements)))
 566
 567        (if (zero? (ly:grob-array-length elts))
 568            (ly:grob-suicide! grob))))
 569
 570 ;; The method used in the following routine depends on bar_engraver
 571 ;; not being removed from staff context.  If bar_engraver is removed,
 572 ;; the size of the staff lines is evaluated as 0, which results in a
 573 ;; solid span bar line with faulty y coordinate.
 574 ;;
 575 ;; This routine was originally by Juergen Reuter, but it was a on the
 576 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl.
 577 (define-public (ly:span-bar::print grob)
 578   (let* ((elts-array (ly:grob-object grob 'elements))
 579          (refp (ly:grob-common-refpoint-of-array grob elts-array Y))
 580          (elts (reverse (sort (ly:grob-array->list elts-array)
 581                               ly:grob-vertical<?)))
 582          ;; Elements must be ordered according to their y coordinates
 583          ;; relative to their common axis group parent.
 584          ;; Otherwise, the computation goes mad.
 585          (glyph (ly:grob-property grob 'glyph-name))
 586          (span-bar empty-stencil))
 587
 588         (if (string? glyph)
 589             (let* ((extents '())
 590                    (make-span-bars '())
 591                    (model-bar #f))
 592
 593                   ;; we compute the extents of each system and store them
 594                   ;; in a list; dito for the 'allow-span-bar property.
 595                   ;; model-bar takes the bar grob, if given.
 596                   (map (lambda (bar)
 597                        (let* ((ext (bar-line::bar-y-extent bar refp))
 598                               (staff-symbol (ly:grob-object bar 'staff-symbol)))
 599
 600                              (if (ly:grob? staff-symbol)
 601                                  (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
 602
 603                                       (set! ext (interval-union ext refp-extent))
 604
 605                                       (if (> (interval-length ext) 0)
 606                                           (begin
 607                                             (set! extents (append extents (list ext)))
 608                                             (set! model-bar bar)
 609                                             (set! make-span-bars
 610                                               (append make-span-bars
 611                                                       (list (ly:grob-property bar 'allow-span-bar #t))))))))))
 612                        elts)
 613                   ;; if there is no bar grob, we use the callback argument
 614                   (if (not model-bar)
 615                       (set! model-bar grob))
 616                   ;; we discard the first entry in make-span-bars, because its corresponding
 617                   ;; bar line is the uppermost and therefore not connected to another bar line
 618                   (if (pair? make-span-bars)
 619                       (set! make-span-bars (cdr make-span-bars)))
 620                   ;; the span bar reaches from the lower end of the upper staff
 621                   ;; to the upper end of the lower staff - when allow-span-bar is #t
 622                   (reduce (lambda (curr prev)
 623                                   (let ((l (cons 0 0))
 624                                         (allow-span-bar (car make-span-bars)))
 625
 626                                        (set! make-span-bars (cdr make-span-bars))
 627                                        (if (> (interval-length prev) 0)
 628                                            (begin
 629                                              (set! l (cons (cdr prev) (car curr)))
 630                                              (if (or (zero? (interval-length l))
 631                                                      (not allow-span-bar))
 632                                                  (begin
 633                                                    ;; there is overlap between the bar lines
 634                                                    ;; or 'allow-span-bar = #f.
 635                                                    ;; Do nothing.
 636                                                  )
 637                                                  (set! span-bar
 638                                                        (ly:stencil-add span-bar
 639                                                                        (bar-line::compound-bar-line
 640                                                                          model-bar
 641                                                                          glyph
 642                                                                          l
 643                                                                          #f))))))
 644                                        curr))
 645                           "" extents)
 646                   (set! span-bar (ly:stencil-translate-axis
 647                                    span-bar
 648                                    (- (ly:grob-relative-coordinate grob refp Y))
 649                                    Y))))
 650         span-bar))