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