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