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
 175          ;; middle of the staff and neither should collide with staff
 176          ;; lines.
 177          ;; the required space is measured in line positions,
 178          ;; i.e. in half staff spaces.
 179
 180          ;; dots are to fall into distict spaces, except when there's
 181          ;; only one space (and it's big enough to hold two dots and
 182          ;; some space between them)
 183
 184          ;; choose defaults working without any staff
 185          (center 0.0)
 186          (dist (* 4 dot-y-length)))
 187
 188     (if (> staff-space 0)
 189         (begin
 190           (set! dist (/ dist staff-space))
 191           (let ((staff-symbol (get-staff-symbol grob)))
 192
 193             (if (ly:grob? staff-symbol)
 194                 (let ((line-pos (staff-symbol-line-positions staff-symbol)))
 195
 196                   (if (pair? line-pos)
 197                       (begin
 198                         (set! center
 199                               (interval-center (staff-symbol-line-span
 200                                                 staff-symbol)))
 201                         ;; fold the staff into two at center
 202                         (let* ((folded-staff
 203                                 (sort (map (lambda (lp) (abs (- lp center)))
 204                                            line-pos) <))
 205                                (gap-to-find (/ (+ dot-y-length line-thickness)
 206                                                (/ staff-space 2)))
 207                                (first (car folded-staff))
 208                                (found #f))
 209
 210                           ;; find the first space big enough
 211                           ;; to hold a dot and a staff line
 212                           ;; (a space in the folded staff may be
 213                           ;; narrower but can't be wider than the
 214                           ;; corresponding original spaces)
 215                           (reduce (lambda (x y) (if (and (> (- x y) gap-to-find)
 216                                                          (not found))
 217                                                     (begin
 218                                                       (set! found #t)
 219                                                       (set! dist (+ x y))))
 220                                           x)
 221                                   ""
 222                                   folded-staff)
 223
 224                           (if (not found)
 225                               (set! dist (if (< gap-to-find first)
 226                                              ;; there's a central space big
 227                                              ;; enough to hold both dots
 228                                              first
 229
 230                                              ;; dots should go outside
 231                                              (+ (* 2 (car
 232                                                       (reverse folded-staff)))
 233                                                 (/ (* 4 dot-y-length)
 234                                                    staff-space))))))))))))
 235         (set! staff-space 1.0))
 236
 237     (let* ((stencil empty-stencil)
 238            (stencil (ly:stencil-add stencil dot))
 239            (stencil (ly:stencil-translate-axis
 240                      stencil (* dist (/ staff-space 2)) Y))
 241            (stencil (ly:stencil-add stencil dot))
 242            (stencil (ly:stencil-translate-axis
 243                      stencil (* (- center (/ dist 2))
 244                                 (/ staff-space 2)) Y)))
 245       stencil)))
 246
 247 (define (make-dotted-bar-line grob extent)
 248   (let* ((position (round (* (interval-end extent) 2)))
 249          (correction (if (even? position) 0.5 0.0))
 250          (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot"))
 251          (i (round (+ (interval-start extent)
 252                       (- 0.5 correction))))
 253          (e (round (+ (interval-end extent)
 254                       (- 0.5 correction))))
 255          (counting (interval-length (cons i e)))
 256          (stil-list (map
 257                       (lambda (x)
 258                               (ly:stencil-translate-axis
 259                                 dot (+ x correction) Y))
 260                       (iota counting i 1))))
 261
 262         (define (add-stencils! stil l)
 263           (if (null? l)
 264               stil
 265               (if (null? (cdr l))
 266                   (ly:stencil-add stil (car l))
 267                   (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
 268
 269         (add-stencils! empty-stencil stil-list)))
 270
 271 (define (make-dashed-bar-line grob extent thickness)
 272   (let* ((height (interval-length extent))
 273          (staff-symbol (get-staff-symbol grob))
 274          (staff-space (ly:staff-symbol-staff-space grob))
 275          (line-thickness (layout-line-thickness grob))
 276          (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3)))
 277          (line-count (staff-symbol-line-count staff-symbol)))
 278
 279         (if (< (abs (+ line-thickness
 280                        (* (1- line-count) staff-space)
 281                        (- height)))
 282                0.1)
 283             (let ((blot (layout-blot-diameter grob))
 284                   (half-space (/ staff-space 2.0))
 285                   (half-thick (/ line-thickness 2.0))
 286                   (stencil empty-stencil))
 287
 288                  (map (lambda (i)
 289                       (let ((top-y (min (* (+ i dash-size) half-space)
 290                                         (+ (* (1- line-count) half-space)
 291                                            half-thick)))
 292                             (bot-y (max (* (- i dash-size) half-space)
 293                                         (- 0 (* (1- line-count) half-space)
 294                                            half-thick))))
 295
 296                            (set! stencil
 297                                  (ly:stencil-add
 298                                    stencil
 299                                    (ly:round-filled-box (cons 0 thickness)
 300                                                         (cons bot-y top-y)
 301                                                         blot)))))
 302                       (iota line-count (1- line-count) (- 2)))
 303             stencil)
 304             (let* ((dashes (/ height staff-space))
 305                    (total-dash-size (/ height dashes))
 306                    (factor (/ (- dash-size thickness) staff-space)))
 307
 308                   (ly:stencil-translate-axis
 309                     (ly:make-stencil (list 'dashed-line
 310                                            thickness
 311                                            (* factor total-dash-size)
 312                                            (* (- 1 factor) total-dash-size)
 313                                            0
 314                                            height
 315                                            (* factor total-dash-size 0.5))
 316                                            (cons 0 thickness)
 317                                            (cons 0 height))
 318                                            (interval-start extent)
 319                                            Y)))))
 320
 321 (define (make-segno-bar-line grob glyph extent rounded)
 322   (let* ((line-thickness (layout-line-thickness grob))
 323          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 324          (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
 325          (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness))
 326          (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness))
 327          (thin-stil (make-simple-bar-line grob hair extent rounded))
 328          (thick-stil (make-simple-bar-line grob fatline extent rounded))
 329          (colon-stil (make-colon-bar-line grob))
 330          (segno-stil (ly:stencil-add
 331                        (ly:stencil-combine-at-edge
 332                          (ly:stencil-combine-at-edge
 333                            '() X LEFT thin-stil thinkern)
 334                          X RIGHT thin-stil thinkern)
 335                        (ly:font-get-glyph (ly:grob-default-font grob) "scripts.varsegno")))
 336          (glyph (cond
 337                   ((string=? glyph "|S") "S")
 338                   ((string=? glyph "S|") "S")
 339                   (else glyph)))
 340          (stencil (cond
 341                     ((or (string=? glyph "S|:")
 342                          (string=? glyph ".S|:"))
 343                      (ly:stencil-combine-at-edge
 344                        (ly:stencil-combine-at-edge
 345                          (ly:stencil-combine-at-edge
 346                            thick-stil X RIGHT thin-stil kern)
 347                          X RIGHT colon-stil kern)
 348                        X LEFT segno-stil thinkern))
 349                     ((or (string=? glyph ":|S")
 350                          (string=? glyph ":|S."))
 351                      (ly:stencil-combine-at-edge
 352                        (ly:stencil-combine-at-edge
 353                          (ly:stencil-combine-at-edge
 354                            thick-stil X LEFT thin-stil kern)
 355                          X LEFT colon-stil kern)
 356                        X RIGHT segno-stil thinkern))
 357                     ((or (string=? glyph ":|S|:")
 358                          (string=? glyph ":|S.|:"))
 359                      (ly:stencil-combine-at-edge
 360                        (ly:stencil-combine-at-edge
 361                          (ly:stencil-combine-at-edge
 362                            (ly:stencil-combine-at-edge
 363                              (ly:stencil-combine-at-edge
 364                                (ly:stencil-combine-at-edge
 365                                  thick-stil X LEFT thin-stil kern)
 366                                X LEFT colon-stil kern)
 367                              X RIGHT segno-stil thinkern)
 368                            X RIGHT thick-stil thinkern)
 369                          X RIGHT thin-stil kern)
 370                        X RIGHT colon-stil kern))
 371                     ((string=? glyph "|._.|")
 372                      (ly:stencil-combine-at-edge
 373                        (ly:stencil-combine-at-edge
 374                          (ly:stencil-combine-at-edge
 375                            thick-stil X LEFT thin-stil kern)
 376                          X RIGHT thick-stil (+ (interval-length
 377                                                  (ly:stencil-extent segno-stil X))
 378                                                (* 2 thinkern)))
 379                        X RIGHT thin-stil kern))
 380                     (else segno-stil))))
 381
 382        stencil))
 383
 384 (define (make-kievan-bar-line grob)
 385   (let* ((font (ly:grob-default-font grob))
 386          (stencil (stencil-whiteout
 387                     (ly:font-get-glyph font "scripts.barline.kievan"))))
 388
 389         ;; the kievan bar line has mo staff lines underneath,
 390         ;; so we whiteout them and move ithe grob to a higher layer
 391         (ly:grob-set-property! grob 'layer 1)
 392         stencil))
 393
 394 ;; bar line callbacks
 395
 396 (define-public (ly:bar-line::calc-bar-extent grob)
 397   (let ((staff-symbol (get-staff-symbol grob))
 398         (staff-extent (cons 0 0)))
 399
 400        (if (ly:grob? staff-symbol)
 401            (let* ((bar-line-color (ly:grob-property grob 'color))
 402                   (staff-color (ly:grob-property staff-symbol 'color))
 403                   (staff-line-thickness (ly:staff-symbol-line-thickness grob))
 404                   (staff-space (ly:staff-symbol-staff-space grob)))
 405
 406                  (set! staff-extent (ly:staff-symbol::height staff-symbol))
 407
 408                  (if (zero? staff-space)
 409                      (set! staff-space 1.0))
 410
 411                  (if (< (interval-length staff-extent) staff-space)
 412                      ;; staff is too small (perhaps consists of a single line);
 413                      ;; extend the bar line to make it visible
 414                      (set! staff-extent
 415                            (interval-widen staff-extent staff-space))
 416                      ;; Due to rounding problems, bar lines extending to the outermost edges
 417                      ;; of the staff lines appear wrongly in on-screen display
 418                      ;; (and, to a lesser extent, in print) - they stick out a pixel.
 419                      ;; The solution is to extend bar lines only to the middle
 420                      ;; of the staff line - unless they have different colors,
 421                      ;; when it would be undesirable.
 422                      ;;
 423                      ;; This reduction should not influence whether bar is to be
 424                      ;; expanded later, so length is not updated on purpose.
 425                      (if (eq? bar-line-color staff-color)
 426                          (set! staff-extent
 427                                (interval-widen staff-extent
 428                                                (* -1/2 staff-line-thickness)))))))
 429        staff-extent))
 430
 431 (define (bar-line::bar-y-extent grob refpoint)
 432   (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0)))
 433          (rel-y (ly:grob-relative-coordinate grob refpoint Y))
 434          (y-extent (coord-translate extent rel-y)))
 435
 436         y-extent))
 437
 438 (define-public (ly:bar-line::print grob)
 439   (let ((glyph (ly:grob-property grob 'glyph-name))
 440         (extent (ly:grob-property grob 'bar-extent '(0 . 0))))
 441
 442        (if (and (not (eq? glyph '()))
 443                 (> (interval-length extent) 0))
 444            (bar-line::compound-bar-line grob glyph extent #f)
 445            #f)))
 446
 447 (define-public (bar-line::compound-bar-line grob glyph extent rounded)
 448   (let* ((line-thickness (layout-line-thickness grob))
 449          (height (interval-length extent))
 450          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 451          (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
 452          (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness))
 453          (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness))
 454          (thin-stil (make-simple-bar-line grob hair extent rounded))
 455          (thick-stil (make-simple-bar-line grob fatline extent rounded))
 456          (colon-stil (make-colon-bar-line grob))
 457          (glyph (cond
 458                   ((not glyph) "")
 459                   ((string=? glyph "||:") "|:")
 460                   ;; bar-line::compound-bar-line is called only if
 461                   ;; height > 0, but just in case ...
 462                   ((and (string=? glyph ":|")
 463                         (zero? height)) "|.")
 464                   ((and (string=? glyph "|:")
 465                         (zero? height)) ".|")
 466                   (else glyph)))
 467          (stencil (cond
 468                     ((string=? glyph "|") thin-stil)
 469                     ((string=? glyph ".") thick-stil)
 470                     ((string=? glyph "||")
 471                      (ly:stencil-combine-at-edge
 472                        (ly:stencil-combine-at-edge
 473                          '() X LEFT thin-stil thinkern)
 474                        X RIGHT thin-stil thinkern))
 475                     ((string=? glyph "|.")
 476                      (ly:stencil-combine-at-edge
 477                        thick-stil X LEFT thin-stil kern))
 478                     ((string=? glyph ".|")
 479                      (ly:stencil-combine-at-edge
 480                        thick-stil X RIGHT thin-stil kern))
 481                     ((string=? glyph "|:")
 482                      (ly:stencil-combine-at-edge
 483                        (ly:stencil-combine-at-edge
 484                          thick-stil X RIGHT thin-stil kern)
 485                        X RIGHT colon-stil kern))
 486                     ((string=? glyph ":|")
 487                      (ly:stencil-combine-at-edge
 488                        (ly:stencil-combine-at-edge
 489                          thick-stil X LEFT thin-stil kern)
 490                        X LEFT colon-stil kern))
 491                     ((string=? glyph ":|:")
 492                      (ly:stencil-combine-at-edge
 493                        (ly:stencil-combine-at-edge
 494                          (ly:stencil-combine-at-edge
 495                            (ly:stencil-combine-at-edge
 496                              '() X LEFT thick-stil thinkern)
 497                            X LEFT colon-stil kern)
 498                          X RIGHT thick-stil kern)
 499                        X RIGHT colon-stil kern))
 500                     ((string=? glyph ":|.|:")
 501                      (ly:stencil-combine-at-edge
 502                        (ly:stencil-combine-at-edge
 503                          (ly:stencil-combine-at-edge
 504                            (ly:stencil-combine-at-edge
 505                              thick-stil X LEFT thin-stil kern)
 506                            X LEFT colon-stil kern)
 507                          X RIGHT thin-stil kern)
 508                        X RIGHT colon-stil kern))
 509                     ((string=? glyph ":|.:")
 510                      (ly:stencil-combine-at-edge
 511                        (ly:stencil-combine-at-edge
 512                          (ly:stencil-combine-at-edge
 513                            thick-stil X LEFT thin-stil kern)
 514                          X LEFT colon-stil kern)
 515                        X RIGHT colon-stil kern))
 516                     ((string=? glyph ".|.")
 517                      (ly:stencil-combine-at-edge
 518                        (ly:stencil-combine-at-edge
 519                          '() X LEFT thick-stil thinkern)
 520                        X RIGHT thick-stil kern))
 521                     ((string=? glyph "|.|")
 522                      (ly:stencil-combine-at-edge
 523                        (ly:stencil-combine-at-edge
 524                          thick-stil X LEFT thin-stil kern)
 525                        X RIGHT thin-stil kern))
 526                     ((string=? glyph ":")
 527                      (make-dotted-bar-line grob extent))
 528                     ((or (string=? glyph "|._.|")
 529                          (string-contains glyph "S"))
 530                      (make-segno-bar-line grob glyph extent rounded))
 531                     ((string=? glyph "'")
 532                      (make-tick-bar-line grob (interval-end extent) rounded))
 533                     ((string=? glyph "dashed")
 534                      (make-dashed-bar-line grob extent hair))
 535                     ((string=? glyph "kievan")
 536                      (make-kievan-bar-line grob))
 537                     (else (make-empty-bar-line grob extent)))))
 538          stencil))
 539
 540 (define-public (ly:bar-line::calc-anchor grob)
 541   (let* ((line-thickness (layout-line-thickness grob))
 542          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 543          (glyph (ly:grob-property grob 'glyph-name ""))
 544          (x-extent (ly:grob-extent grob grob X))
 545          (dot-width (+ (interval-length
 546                          (ly:stencil-extent
 547                            (ly:font-get-glyph
 548                              (ly:grob-default-font grob)
 549                              "dots.dot")
 550                            X))
 551                        kern))
 552          (anchor 0.0))
 553
 554         (if (> (interval-length x-extent) 0)
 555             (begin
 556               (set! anchor (interval-center x-extent))
 557               (cond ((string=? glyph "|:")
 558                      (set! anchor (+ anchor (/ dot-width -2.0))))
 559                     ((string=? glyph ":|")
 560                      (set! anchor (+ anchor (/ dot-width 2.0)))))))
 561         anchor))
 562
 563 (define-public (bar-line::calc-glyph-name grob)
 564   (let* ((glyph (ly:grob-property grob 'glyph))
 565          (dir (ly:item-break-dir grob))
 566          (result (assoc-get glyph bar-glyph-alist))
 567          (glyph-name (if (= dir CENTER)
 568                          glyph
 569                          (if (and result
 570                                   (string? (index-cell result dir)))
 571                             (index-cell result dir)
 572                             #f))))
 573         glyph-name))
 574
 575 (define-public (bar-line::calc-break-visibility grob)
 576   (let* ((glyph (ly:grob-property grob 'glyph))
 577          (result (assoc-get glyph bar-glyph-alist)))
 578
 579     (if result
 580         (vector (string? (car result)) #t (string? (cdr result)))
 581         all-invisible)))
 582
 583 ;; which span bar belongs to a bar line?
 584
 585 (define-public span-bar-glyph-alist
 586   '(("|:" . ".|")
 587     ("||:" . ".|")
 588     (":|" . "|.")
 589     (":|.:" . "|.")
 590     (":|:" . ".|.")
 591     (":|.|:" . "|.|")
 592     (":|.|" . "|.")
 593     ("S" . "||" )
 594     ("S|" . "||")
 595     ("|S" . "||")
 596     ("S|:" . ".|")
 597     (".S|:" . ".|")
 598     (":|S" . "|.")
 599     (":|S." . "|.")
 600     (":|S|:" . "|._.|")
 601     (":|S.|:" . "|._.|")
 602     ("kievan" . "")
 603     ("'" . "")))
 604
 605 ;; span bar callbacks
 606
 607 (define-public (ly:span-bar::calc-glyph-name grob)
 608   (let* ((elts (ly:grob-object grob 'elements))
 609          (pos (1- (ly:grob-array-length elts)))
 610          (glyph '()))
 611
 612         (while (and (eq? glyph '())
 613                     (> pos -1))
 614                (begin (set! glyph (ly:grob-property (ly:grob-array-ref elts pos)
 615                                                     'glyph-name))
 616                       (set! pos (1- pos))))
 617          (if (eq? glyph '())
 618              (begin (ly:grob-suicide! grob)
 619                     (set! glyph "")))
 620         (assoc-get glyph span-bar-glyph-alist glyph)))
 621
 622 (define-public (ly:span-bar::width grob)
 623   (let ((width (cons 0 0)))
 624
 625        (if (grob::is-live? grob)
 626            (let* ((glyph (ly:grob-property grob 'glyph-name))
 627                   (stencil (bar-line::compound-bar-line grob glyph (cons -1 1) #f)))
 628
 629                  (set! width (ly:stencil-extent stencil X))))
 630        width))
 631
 632 (define-public (ly:span-bar::before-line-breaking grob)
 633   (let ((elts (ly:grob-object grob 'elements)))
 634
 635        (if (zero? (ly:grob-array-length elts))
 636            (ly:grob-suicide! grob))))
 637
 638 ;; The method used in the following routine depends on bar_engraver
 639 ;; not being removed from staff context.  If bar_engraver is removed,
 640 ;; the size of the staff lines is evaluated as 0, which results in a
 641 ;; solid span bar line with faulty y coordinate.
 642 ;;
 643 ;; This routine was originally by Juergen Reuter, but it was a on the
 644 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl.
 645 (define-public (ly:span-bar::print grob)
 646   (let* ((elts-array (ly:grob-object grob 'elements))
 647          (refp (ly:grob-common-refpoint-of-array grob elts-array Y))
 648          (elts (reverse (sort (ly:grob-array->list elts-array)
 649                               ly:grob-vertical<?)))
 650          ;; Elements must be ordered according to their y coordinates
 651          ;; relative to their common axis group parent.
 652          ;; Otherwise, the computation goes mad.
 653          (glyph (ly:grob-property grob 'glyph-name))
 654          (span-bar empty-stencil))
 655
 656         (if (string? glyph)
 657             (let* ((extents '())
 658                    (make-span-bars '())
 659                    (model-bar #f))
 660
 661                   ;; we compute the extents of each system and store them
 662                   ;; in a list; dito for the 'allow-span-bar property.
 663                   ;; model-bar takes the bar grob, if given.
 664                   (map (lambda (bar)
 665                        (let* ((ext (bar-line::bar-y-extent bar refp))
 666                               (staff-symbol (ly:grob-object bar 'staff-symbol)))
 667
 668                              (if (ly:grob? staff-symbol)
 669                                  (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
 670
 671                                       (set! ext (interval-union ext refp-extent))
 672
 673                                       (if (> (interval-length ext) 0)
 674                                           (begin
 675                                             (set! extents (append extents (list ext)))
 676                                             (set! model-bar bar)
 677                                             (set! make-span-bars
 678                                               (append make-span-bars
 679                                                       (list (ly:grob-property bar 'allow-span-bar #t))))))))))
 680                        elts)
 681                   ;; if there is no bar grob, we use the callback argument
 682                   (if (not model-bar)
 683                       (set! model-bar grob))
 684                   ;; we discard the first entry in make-span-bars, because its corresponding
 685                   ;; bar line is the uppermost and therefore not connected to another bar line
 686                   (if (pair? make-span-bars)
 687                       (set! make-span-bars (cdr make-span-bars)))
 688                   ;; the span bar reaches from the lower end of the upper staff
 689                   ;; to the upper end of the lower staff - when allow-span-bar is #t
 690                   (reduce (lambda (curr prev)
 691                                   (let ((l (cons 0 0))
 692                                         (allow-span-bar (car make-span-bars)))
 693
 694                                        (set! make-span-bars (cdr make-span-bars))
 695                                        (if (> (interval-length prev) 0)
 696                                            (begin
 697                                              (set! l (cons (cdr prev) (car curr)))
 698                                              (if (or (zero? (interval-length l))
 699                                                      (not allow-span-bar))
 700                                                  (begin
 701                                                    ;; there is overlap between the bar lines
 702                                                    ;; or 'allow-span-bar = #f.
 703                                                    ;; Do nothing.
 704                                                  )
 705                                                  (set! span-bar
 706                                                        (ly:stencil-add span-bar
 707                                                                        (bar-line::compound-bar-line
 708                                                                          model-bar
 709                                                                          glyph
 710                                                                          l
 711                                                                          #f))))))
 712                                        curr))
 713                           "" extents)
 714                   (set! span-bar (ly:stencil-translate-axis
 715                                    span-bar
 716                                    (- (ly:grob-relative-coordinate grob refp Y))
 717                                    Y))))
 718         span-bar))