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
  19
  20 ;; TODO:
  21 ;; (1) Dashed bar lines may stick out above and below the staff lines
  22 ;;
  23 ;; (2) Dashed and dotted lines look ugly in combination with span bars
  24 ;;
  25 ;; (This was the case in the c++-version of (span) bar stuff)
  26
  27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28 ;; helper functions for staff and layout properties
  29
  30 (define (calc-blot thickness extent grob)
  31   "Calculate the blot diameter by taking @code{'rounded}
  32 and the dimensions of the extent into account."
  33   (let* ((rounded (ly:grob-property grob 'rounded #f))
  34          (blot (if rounded
  35                    (let ((blot-diameter (layout-blot-diameter grob))
  36                          (height (interval-length extent)))
  37
  38                         (cond ((< thickness blot-diameter) thickness)
  39                               ((< height blot-diameter) height)
  40                               (else blot-diameter)))
  41                    0)))
  42
  43         blot))
  44
  45 (define (get-span-glyph bar-glyph)
  46   "Get the corresponding span glyph from the @code{span-glyph-bar-alist}.
  47 Pad the string with @code{annotation-char}s to the length of the
  48 @var{bar-glyph} string."
  49   (let ((span-glyph (assoc-get bar-glyph span-bar-glyph-alist bar-glyph)))
  50
  51        (if (string? span-glyph)
  52            (set! span-glyph (string-pad-right
  53                           span-glyph
  54                           (string-length bar-glyph)
  55                           replacement-char)))
  56        span-glyph))
  57
  58 (define (get-staff-symbol grob)
  59   "Return the staff symbol corresponding to Grob @var{grob}."
  60   (if (grob::has-interface grob 'staff-symbol-interface)
  61       grob
  62       (ly:grob-object grob 'staff-symbol)))
  63
  64 (define (layout-blot-diameter grob)
  65   "Get the blot diameter of the @var{grob}'s corresponding layout."
  66   (let* ((layout (ly:grob-layout grob))
  67          (blot-diameter (ly:output-def-lookup layout 'blot-diameter)))
  68
  69         blot-diameter))
  70
  71 (define (layout-line-thickness grob)
  72   "Get the line thickness of the @var{grob}'s corresponding layout."
  73   (let* ((layout (ly:grob-layout grob))
  74          (line-thickness (ly:output-def-lookup layout 'line-thickness)))
  75
  76         line-thickness))
  77
  78 (define (staff-symbol-line-count staff)
  79   "Get or compute the number of lines of staff @var{staff}."
  80   (let ((line-count 0))
  81
  82        (if (ly:grob? staff)
  83            (let ((line-pos (ly:grob-property staff 'line-positions '())))
  84
  85                 (set! line-count (if (pair? line-pos)
  86                                      (length line-pos)
  87                                      (ly:grob-property staff 'line-count 0)))))
  88
  89          line-count))
  90
  91 (define (staff-symbol-line-span grob)
  92   (let ((line-pos (ly:grob-property grob 'line-positions '()))
  93         (iv (cons 0.0 0.0)))
  94
  95        (if (pair? line-pos)
  96            (begin
  97              (set! iv (cons (car line-pos) (car line-pos)))
  98              (map (lambda (x)
  99                     (set! iv (cons (min (car iv) x)
 100                                    (max (cdr iv) x))))
 101                   (cdr line-pos)))
 102
 103            (let ((line-count (ly:grob-property grob 'line-count 0)))
 104
 105                 (set! iv (cons (- 1 line-count)
 106                                (- line-count 1)))))
 107        iv))
 108
 109 (define (staff-symbol-line-positions grob)
 110   "Get or compute the @code{'line-positions} list from @var{grob}."
 111   (let ((line-pos (ly:grob-property grob 'line-positions '())))
 112
 113        (if (not (pair? line-pos))
 114            (let* ((line-count (ly:grob-property grob 'line-count 0))
 115                   (height (- line-count 1.0)))
 116
 117                  (set! line-pos (map (lambda (x)
 118                                              (- height (* x 2)))
 119                                      (iota line-count)))))
 120        line-pos))
 121
 122 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 123 ;; internal helper functions
 124
 125 (define annotation-char #\-)
 126 (define replacement-char #\ )
 127
 128 (define dummy-extent (cons -1 1))
 129
 130
 131 (define (glyph->stencil glyph grob extent)
 132   "Return a stencil computed by the procedure associated with
 133 glyph @var{glyph}. The arguments @var{grob} and @var{extent} are
 134 mandatory to the procedures stored in @code{bar-glyph-print-procedures}."
 135   (let ((proc (assoc-get glyph bar-glyph-print-procedures))
 136         (stencil empty-stencil))
 137
 138        (if (procedure? proc)
 139            (set! stencil (proc grob extent))
 140            (ly:warning (_ "Bar glyph ~a not known. Ignoring.") glyph))
 141        stencil))
 142
 143 (define (string->string-list str)
 144   "Convert a string into a list of strings with length 1.
 145 @code{"aBc"} will be converted to @code{("a" "B" "c")}.
 146 An empty string will be converted to a list containing @code{""}."
 147   (if (and (string? str)
 148            (not (zero? (string-length str))))
 149       (map (lambda (s)
 150                    (string s))
 151            (string->list str))
 152       (list "")))
 153
 154 (define (strip-string-annotation str)
 155   "Strip annotations starting with and including the
 156 annotation char from string @var{str}."
 157   (let ((pos (string-index str annotation-char)))
 158
 159        (if pos
 160            (substring str 0 pos)
 161            str)))
 162
 163 (define (check-for-annotation str)
 164   "Check whether the annotation char is present in string @var{str}."
 165   (if (string? str)
 166       (if (string-index str annotation-char)
 167           (ly:warning
 168             (_ "Annotation '~a' is allowed in the first argument of a bar line definition only.")
 169             str))))
 170
 171 (define (check-for-replacement str)
 172   "Check whether the replacement char is present in string @var{str}."
 173   (if (string? str)
 174       (if (string-index str replacement-char)
 175           (ly:warning
 176             (_ "Replacement '~a' is allowed in the last argument of a bar line definition only.")
 177             str))))
 178
 179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 180 ;; functions used by external routines
 181
 182 (define-public (span-bar::notify-grobs-of-my-existence grob)
 183   "Set the @code{'has-span-bar} property for all elements of Grob @var{grob}."
 184   (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements)))
 185          (sorted-elts (sort elts ly:grob-vertical<?))
 186          (last-pos (1- (length sorted-elts)))
 187          (idx 0))
 188
 189         (map (lambda (g)
 190                      (ly:grob-set-property!
 191                        g
 192                        'has-span-bar
 193                        (cons (if (eq? idx last-pos)
 194                                  #f
 195                                  grob)
 196                              (if (zero? idx)
 197                                  #f
 198                                  grob)))
 199                       (set! idx (1+ idx)))
 200              sorted-elts)))
 201
 202 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 203 ;; Line break decisions.
 204
 205 (define-public (define-bar-line bar-glyph eol-glyph bol-glyph span-glyph)
 206   "Define a bar glyph @var{bar-glyph} and its substitute at the end of a line
 207 (@var{eol-glyph}), at the beginning of a new line (@var{bol-glyph})
 208 and as a span bar (@var{span-glyph}) respectively."
 209   ;; the last argument may not include annotations
 210   (check-for-annotation span-glyph)
 211   ;; only the last argument may call for replacements
 212   (for-each (lambda (s)
 213                     (check-for-replacement s))
 214             (list bar-glyph eol-glyph bol-glyph))
 215   ;; the bar-glyph-alist has entries like
 216   ;; (bar-glyph . ( eol-glyph . bol-glyph))
 217   (set! bar-glyph-alist
 218     (acons bar-glyph (cons eol-glyph bol-glyph) bar-glyph-alist))
 219
 220   ;; the span-bar-glyph-alist has entries like
 221   ;; (bar-glyph . span-glyph)
 222   (set! span-bar-glyph-alist
 223     (acons bar-glyph span-glyph span-bar-glyph-alist)))
 224
 225 (define-session bar-glyph-alist '())
 226
 227 (define-session span-bar-glyph-alist '())
 228
 229 (define-public (add-bar-glyph-print-procedure glyph proc)
 230   "Specify the single glyph @var{glyph} that calls print procedure @var{proc}.
 231 The procedure @var{proc} has to be defined in the form
 232 @code{(make-...-bar-line grob extent)} even if the @var{extent}
 233 is not used within the routine."
 234   (if (or (not (string? glyph))
 235           (> (string-length glyph) 1))
 236       (ly:warning
 237         (_ "add-bar-glyph-print-procedure: glyph '~a' has to be a single ASCII character.")
 238         glyph)
 239       (set! bar-glyph-print-procedures
 240         (acons glyph proc bar-glyph-print-procedures))))
 241
 242 (define-session bar-glyph-print-procedures `())
 243
 244 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 245 ;; drawing functions for various bar line types
 246 ;; to include them and other user-defined functions,
 247 ;; all of them have the form
 248 ;; (make-...-bar-line grob extent)
 249 ;; even if the extent is not used.
 250
 251 (define (make-empty-bar-line grob extent)
 252   "Draw an empty bar line."
 253   (ly:make-stencil "" (cons 0 0) extent))
 254
 255 (define (make-simple-bar-line grob extent)
 256   "Draw a simple bar line."
 257   (let* ((line-thickness (layout-line-thickness grob))
 258          (thickness (* (ly:grob-property grob 'hair-thickness 1)
 259                        line-thickness))
 260          (blot (calc-blot thickness extent grob))
 261          (extent (bar-line::widen-bar-extent-on-span grob extent)))
 262
 263         (ly:round-filled-box (cons 0 thickness)
 264                              extent
 265                              blot)))
 266
 267 (define (make-thick-bar-line grob extent)
 268   "Draw a thick bar line."
 269   (let* ((line-thickness (layout-line-thickness grob))
 270          (thickness (* (ly:grob-property grob 'thick-thickness 1)
 271                        line-thickness))
 272          (blot (calc-blot thickness extent grob))
 273          (extent (bar-line::widen-bar-extent-on-span grob extent)))
 274
 275         (ly:round-filled-box (cons 0 thickness)
 276                              extent
 277                              blot)))
 278
 279 (define (make-tick-bar-line grob extent)
 280   "Draw a tick bar line."
 281   (let* ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob)))
 282          (staff-line-thickness (ly:staff-symbol-line-thickness grob))
 283          (height (interval-end extent))
 284          (blot (calc-blot staff-line-thickness extent grob)))
 285
 286         (ly:round-filled-box (cons 0 staff-line-thickness)
 287                              (cons (- height half-staff) (+ height half-staff))
 288                              blot)))
 289
 290 (define (make-colon-bar-line grob extent)
 291   "Draw repeat dots."
 292   (let* ((staff-space (ly:staff-symbol-staff-space grob))
 293          (line-thickness (ly:staff-symbol-line-thickness grob))
 294          (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot"))
 295          (dot-y-length (interval-length (ly:stencil-extent dot Y)))
 296          (stencil empty-stencil)
 297          ;; the two dots of the repeat sign should be centred at the
 298          ;; middle of the staff and neither should collide with staff
 299          ;; lines.
 300          ;; the required space is measured in line positions,
 301          ;; i.e. in half staff spaces.
 302
 303          ;; dots are to fall into distict spaces, except when there's
 304          ;; only one space (and it's big enough to hold two dots and
 305          ;; some space between them)
 306
 307          ;; choose defaults working without any staff
 308          (center 0.0)
 309          (dist (* 4 dot-y-length)))
 310
 311     (if (> staff-space 0)
 312         (begin
 313           (set! dist (/ dist staff-space))
 314           (let ((staff-symbol (get-staff-symbol grob)))
 315
 316             (if (ly:grob? staff-symbol)
 317                 (let ((line-pos (staff-symbol-line-positions staff-symbol)))
 318
 319                   (if (pair? line-pos)
 320                       (begin
 321                         (set! center
 322                               (interval-center (staff-symbol-line-span
 323                                                 staff-symbol)))
 324                         ;; fold the staff into two at center
 325                         (let* ((folded-staff
 326                                 (sort (map (lambda (lp) (abs (- lp center)))
 327                                            line-pos) <))
 328                                (gap-to-find (/ (+ dot-y-length line-thickness)
 329                                                (/ staff-space 2)))
 330                                (first (car folded-staff)))
 331
 332                           ;; find the first space big enough
 333                           ;; to hold a dot and a staff line
 334                           ;; (a space in the folded staff may be
 335                           ;; narrower but can't be wider than the
 336                           ;; corresponding original spaces)
 337                           (set! dist
 338                                 (or
 339                                  (any (lambda (x y)
 340                                         (and (> (- y x) gap-to-find)
 341                                              (+ x y)))
 342                                       folded-staff (cdr folded-staff))
 343                                  (if (< gap-to-find first)
 344                                      ;; there's a central space big
 345                                      ;; enough to hold both dots
 346                                      first
 347
 348                                      ;; dots should go outside
 349                                      (+ (* 2 (last folded-staff))
 350                                         (/ (* 4 dot-y-length)
 351                                            staff-space))))))))))))
 352         (set! staff-space 1.0))
 353
 354     (let* ((stencil empty-stencil)
 355            (stencil (ly:stencil-add stencil dot))
 356            (stencil (ly:stencil-translate-axis
 357                      stencil (* dist (/ staff-space 2)) Y))
 358            (stencil (ly:stencil-add stencil dot))
 359            (stencil (ly:stencil-translate-axis
 360                      stencil (* (- center (/ dist 2))
 361                                 (/ staff-space 2)) Y)))
 362       stencil)))
 363
 364
 365 (define (make-dotted-bar-line grob extent)
 366   "Draw a dotted bar line."
 367   (let* ((position (round (* (interval-end extent) 2)))
 368          (correction (if (even? position) 0.5 0.0))
 369          (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot"))
 370          (i (round (+ (interval-start extent)
 371                       (- 0.5 correction))))
 372          (e (round (+ (interval-end extent)
 373                       (- 0.5 correction))))
 374          (counting (interval-length (cons i e)))
 375          (stil-list (map
 376                       (lambda (x)
 377                               (ly:stencil-translate-axis
 378                                 dot (+ x correction) Y))
 379                       (iota counting i 1))))
 380
 381         (define (add-stencils! stil l)
 382           (if (null? l)
 383               stil
 384               (if (null? (cdr l))
 385                   (ly:stencil-add stil (car l))
 386                   (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
 387
 388         (add-stencils! empty-stencil stil-list)))
 389
 390 (define (make-dashed-bar-line grob extent)
 391   "Draw a dashed bar line."
 392   (let* ((height (interval-length extent))
 393          (staff-symbol (get-staff-symbol grob))
 394          (staff-space (ly:staff-symbol-staff-space grob))
 395          (line-thickness (layout-line-thickness grob))
 396          (thickness (* (ly:grob-property grob 'hair-thickness 1)
 397                        line-thickness))
 398          (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3)))
 399          (line-count (staff-symbol-line-count staff-symbol)))
 400
 401         (if (< (abs (+ line-thickness
 402                        (* (1- line-count) staff-space)
 403                        (- height)))
 404                0.1)
 405             (let ((blot (layout-blot-diameter grob))
 406                   (half-space (/ staff-space 2.0))
 407                   (half-thick (/ line-thickness 2.0))
 408                   (stencil empty-stencil))
 409
 410                  (map (lambda (i)
 411                       (let ((top-y (min (* (+ i dash-size) half-space)
 412                                         (+ (* (1- line-count) half-space)
 413                                            half-thick)))
 414                             (bot-y (max (* (- i dash-size) half-space)
 415                                         (- 0 (* (1- line-count) half-space)
 416                                            half-thick))))
 417
 418                            (set! stencil
 419                                  (ly:stencil-add
 420                                    stencil
 421                                    (ly:round-filled-box (cons 0 thickness)
 422                                                         (cons bot-y top-y)
 423                                                         blot)))))
 424                       (iota line-count (1- line-count) (- 2)))
 425             stencil)
 426             (let* ((dashes (/ height staff-space))
 427                    (total-dash-size (/ height dashes))
 428                    (factor (/ (- dash-size thickness) staff-space))
 429                    (stencil (ly:stencil-translate-axis
 430                               (ly:make-stencil (list 'dashed-line
 431                                                      thickness
 432                                                      (* factor total-dash-size)
 433                                                      (* (- 1 factor) total-dash-size)
 434                                                      0
 435                                                      height
 436                                                      (* factor total-dash-size 0.5))
 437                                                (cons (/ thickness -2) (/ thickness 2))
 438                                                (cons 0 height))
 439                             (interval-start extent)
 440                             Y)))
 441
 442                  (ly:stencil-translate-axis stencil (/ thickness 2) X)))))
 443
 444
 445 (define ((make-segno-bar-line show-segno) grob extent)
 446   "Draw a segno bar line. If @var{show-segno} is set to @code{#t},
 447 the segno sign is drawn over the double bar line; otherwise, it
 448 draws the span bar variant, i.e. without the segno sign."
 449   (let* ((line-thickness (layout-line-thickness grob))
 450          (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness))
 451          (thin-stil (make-simple-bar-line grob extent))
 452          (double-line-stil (ly:stencil-combine-at-edge
 453                              thin-stil
 454                              X
 455                              LEFT
 456                              thin-stil
 457                              thinkern))
 458          (segno (ly:font-get-glyph (ly:grob-default-font grob)
 459                                    "scripts.varsegno"))
 460          (stencil (ly:stencil-add
 461                     (if show-segno
 462                         segno
 463                         (ly:make-stencil
 464                           ""
 465                           (ly:stencil-extent segno X)
 466                           (cons 0 0)))
 467                     (ly:stencil-translate-axis
 468                       double-line-stil
 469                       (* 1/2 thinkern)
 470                       X))))
 471
 472        stencil))
 473
 474 (define (make-kievan-bar-line grob extent)
 475   "Draw a kievan bar line."
 476   (let* ((font (ly:grob-default-font grob))
 477          (stencil (stencil-whiteout
 478                     (ly:font-get-glyph font "scripts.barline.kievan"))))
 479
 480         ;; the kievan bar line has no staff lines underneath,
 481         ;; so we whiteout them and move the grob to a higher layer
 482         (ly:grob-set-property! grob 'layer 1)
 483         stencil))
 484
 485 (define ((make-bracket-bar-line dir) grob extent)
 486   "Draw a bracket-style bar line. If @var{dir} is set to @code{LEFT}, the
 487 opening bracket will be drawn, for @code{RIGHT} we get the closing bracket."
 488   (let* ((thick-stil (make-thick-bar-line grob extent))
 489          (brackettips-up (ly:font-get-glyph (ly:grob-default-font grob)
 490                                             "brackettips.up"))
 491          (brackettips-down (ly:font-get-glyph (ly:grob-default-font grob)
 492                                               "brackettips.down"))
 493          ;; the x-extent of the brackettips must not be taken into account
 494          ;; for bar line constructs like "[|:", so we set new bounds:
 495          (tip-up-stil (ly:make-stencil (ly:stencil-expr brackettips-up)
 496                                        (cons 0 0)
 497                                        (ly:stencil-extent brackettips-up Y)))
 498          (tip-down-stil (ly:make-stencil (ly:stencil-expr brackettips-down)
 499                                        (cons 0 0)
 500                                        (ly:stencil-extent brackettips-down Y)))
 501          (stencil (ly:stencil-add
 502                     thick-stil
 503                     (ly:stencil-translate-axis tip-up-stil
 504                                                (interval-end extent)
 505                                                Y)
 506                     (ly:stencil-translate-axis tip-down-stil
 507                                                (interval-start extent)
 508                                                Y))))
 509
 510         (if (eq? dir LEFT)
 511             stencil
 512             (ly:stencil-scale stencil -1 1))))
 513
 514 (define ((make-spacer-bar-line glyph) grob extent)
 515   "Draw an invisible bar line which has the same dimensions as the one
 516 drawn by the procedure associated with glyph @var{glyph}."
 517   (let* ((stil (glyph->stencil glyph grob extent))
 518          (stil-x-extent (ly:stencil-extent stil X)))
 519
 520         (ly:make-stencil "" stil-x-extent extent)))
 521
 522 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 523 ;; bar line callbacks
 524
 525 (define-public (ly:bar-line::calc-bar-extent grob)
 526   (let ((staff-symbol (get-staff-symbol grob))
 527         (staff-extent (cons 0 0)))
 528
 529        (if (ly:grob? staff-symbol)
 530            (let ((bar-line-color (ly:grob-property grob 'color))
 531                  (staff-color (ly:grob-property staff-symbol 'color))
 532                  (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2))
 533                  (staff-space (ly:staff-symbol-staff-space grob)))
 534
 535                 (set! staff-extent (ly:staff-symbol::height staff-symbol))
 536
 537                 (if (zero? staff-space)
 538                     (set! staff-space 1.0))
 539
 540                 (if (< (interval-length staff-extent) staff-space)
 541                     ;; staff is too small (perhaps consists of a single line);
 542                     ;; extend the bar line to make it visible
 543                     (set! staff-extent
 544                           (interval-widen staff-extent staff-space))
 545                     ;; Due to rounding problems, bar lines extending to the outermost edges
 546                     ;; of the staff lines appear wrongly in on-screen display
 547                     ;; (and, to a lesser extent, in print) - they stick out a pixel.
 548                     ;; The solution is to extend bar lines only to the middle
 549                     ;; of the staff line - unless they have different colors,
 550                     ;; when it would be undesirable.
 551                     ;;
 552                     ;; This reduction should not influence whether the bar is to be
 553                     ;; expanded later, so length is not updated on purpose.
 554                     (if (eq? bar-line-color staff-color)
 555                         (set! staff-extent
 556                               (interval-widen staff-extent
 557                                               (- half-staff-line-thickness)))))))
 558        staff-extent))
 559
 560 ;; this function may come in handy when defining new bar line glyphs, so
 561 ;; we make it public.
 562 ;; This code should not be included in ly:bar-line::calc-bar-extent, because
 563 ;; this may confuse the drawing functions for dashed and dotted bar lines.
 564 (define-public (bar-line::widen-bar-extent-on-span grob extent)
 565   "Widens the bar line @var{extent} towards span bars adjacent to grob @var{grob}."
 566   (let ((staff-symbol (get-staff-symbol grob))
 567         (has-span-bar (ly:grob-property grob 'has-span-bar #f)))
 568
 569        (if (and (ly:grob? staff-symbol)
 570                 (pair? has-span-bar))
 571            (let ((bar-line-color (ly:grob-property grob 'color))
 572                  (staff-color (ly:grob-property staff-symbol 'color))
 573                  (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2)))
 574                 (if (eq? bar-line-color staff-color)
 575                     ;; if the colors are equal, ly:bar-line::calc-bar-extent has
 576                     ;; shortened the bar line extent by a half-staff-line-thickness
 577                     ;; this is reverted on the interval bounds where span bars appear:
 578                     (begin
 579                       (and (ly:grob? (car has-span-bar))
 580                            (set! extent (cons (- (car extent) half-staff-line-thickness)
 581                                               (cdr extent))))
 582                       (and (ly:grob? (cdr has-span-bar))
 583                            (set! extent (cons (car extent)
 584                                               (+ (cdr extent) half-staff-line-thickness))))))))
 585    extent))
 586
 587 (define (bar-line::bar-y-extent grob refpoint)
 588   "Compute the y-extent of the bar line relative to @var{refpoint}."
 589   (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0)))
 590          (rel-y (ly:grob-relative-coordinate grob refpoint Y))
 591          (y-extent (coord-translate extent rel-y)))
 592
 593         y-extent))
 594
 595 (define-public (ly:bar-line::print grob)
 596   "The print routine for bar lines."
 597   (let ((glyph-name (ly:grob-property grob 'glyph-name))
 598         (extent (ly:grob-property grob 'bar-extent '(0 . 0))))
 599
 600        (if (and glyph-name
 601                 (> (interval-length extent) 0))
 602            (bar-line::compound-bar-line grob glyph-name extent)
 603            #f)))
 604
 605 (define-public (bar-line::compound-bar-line grob bar-glyph extent)
 606   "Build the bar line stencil."
 607   (let* ((line-thickness (layout-line-thickness grob))
 608          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 609          (bar-glyph-list (string->string-list
 610                            (strip-string-annotation bar-glyph)))
 611          (span-glyph (get-span-glyph bar-glyph))
 612          (span-glyph-list (string->string-list span-glyph))
 613          (neg-stencil empty-stencil)
 614          (stencil empty-stencil)
 615          (is-first-neg-stencil #t)
 616          (is-first-stencil #t))
 617
 618         ;; We build up two separate stencils first:
 619         ;; (1) the neg-stencil is built from all glyphs that have
 620         ;;     a replacement-char in the span bar
 621         ;; (2) the main stencil is built from all remaining glyphs
 622         ;;
 623         ;; Afterwards the neg-stencil is attached left to the
 624         ;; stencil; this ensures that the main stencil starts
 625         ;; at x = 0.
 626         ;;
 627         ;; For both routines holds:
 628         ;; we stack the stencils obtained by the corresponding
 629         ;; single glyphs with spacing 'kern' except for the
 630         ;; first stencil
 631         ;; (Thanks to Harm who came up with this idea!)
 632         (for-each (lambda (bar span)
 633                           (if (and (string=? span (string replacement-char))
 634                                    is-first-stencil)
 635                               (begin
 636                                 (set! neg-stencil
 637                                       (ly:stencil-combine-at-edge
 638                                         neg-stencil
 639                                         X
 640                                         RIGHT
 641                                         (glyph->stencil bar grob extent)
 642                                         (if is-first-neg-stencil 0 kern)))
 643                                 (set! is-first-neg-stencil #f))
 644                               (begin
 645                                 (set! stencil
 646                                       (ly:stencil-combine-at-edge
 647                                         stencil
 648                                         X
 649                                         RIGHT
 650                                         (glyph->stencil bar grob extent)
 651                                         (if is-first-stencil 0 kern)))
 652                                 (set! is-first-stencil #f))))
 653                   bar-glyph-list span-glyph-list)
 654         ;; if we have a non-empty neg-stencil,
 655         ;; we attach it to the left side of the stencil
 656         (and (not is-first-neg-stencil)
 657              (set! stencil
 658                    (ly:stencil-combine-at-edge
 659                      stencil
 660                      X
 661                      LEFT
 662                      neg-stencil
 663                      kern)))
 664         stencil))
 665
 666 (define-public (ly:bar-line::calc-anchor grob)
 667   "Calculate the anchor position of a bar line. The anchor is used for
 668 the correct placement of bar numbers etc."
 669   (let* ((bar-glyph (ly:grob-property grob 'glyph-name ""))
 670          (bar-glyph-list (string->string-list (strip-string-annotation bar-glyph)))
 671          (span-glyph (assoc-get bar-glyph span-bar-glyph-alist bar-glyph))
 672          (x-extent (ly:grob-extent grob grob X))
 673          (anchor 0.0))
 674
 675         (and (> (interval-length x-extent) 0)
 676              (if (or (= (length bar-glyph-list) 1)
 677                      (string=? bar-glyph span-glyph)
 678                      (string=? span-glyph ""))
 679                  ;; We use the x-extent of the stencil if either
 680                  ;; - we have a single bar-glyph
 681                  ;; - bar-glyph and span-glyph are identical
 682                  ;; - we have no span-glyph
 683                  (set! anchor (interval-center x-extent))
 684                  ;; If the conditions above do not hold,the anchor is the
 685                  ;; center of the corresponding span bar stencil extent
 686                  (set! anchor (interval-center
 687                                 (ly:stencil-extent
 688                                   (span-bar::compound-bar-line grob bar-glyph dummy-extent)
 689                                   X)))))
 690          anchor))
 691
 692 (define-public (bar-line::calc-glyph-name grob)
 693   "Determine the @code{glyph-name} of the bar line depending on the
 694 line break status."
 695   (let* ((glyph (ly:grob-property grob 'glyph))
 696          (dir (ly:item-break-dir grob))
 697          (result (assoc-get glyph bar-glyph-alist))
 698          (glyph-name (if (= dir CENTER)
 699                          glyph
 700                          (if (and result
 701                                   (string? (index-cell result dir)))
 702                             (index-cell result dir)
 703                             #f))))
 704         glyph-name))
 705
 706 (define-public (bar-line::calc-break-visibility grob)
 707   "Calculate the visibility of a bar line at line breaks."
 708   (let* ((glyph (ly:grob-property grob 'glyph))
 709          (result (assoc-get glyph bar-glyph-alist)))
 710
 711     (if result
 712         (vector (string? (car result)) #t (string? (cdr result)))
 713         all-invisible)))
 714
 715 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 716 ;; span bar callbacks
 717
 718 (define-public (ly:span-bar::calc-glyph-name grob)
 719   "Return the @code{'glyph-name} of the corresponding BarLine grob.
 720 The corresponding SpanBar glyph is computed within
 721 @code{span-bar::compound-bar-line}."
 722   (let* ((elts (ly:grob-object grob 'elements))
 723          (pos (1- (ly:grob-array-length elts)))
 724          (glyph-name '()))
 725
 726         (while (and (eq? glyph-name '())
 727                     (> pos -1))
 728                (begin (set! glyph-name
 729                             (ly:grob-property (ly:grob-array-ref elts pos)
 730                                               'glyph-name))
 731                       (set! pos (1- pos))))
 732          (if (eq? glyph-name '())
 733              (begin (ly:grob-suicide! grob)
 734                     (set! glyph-name "")))
 735         glyph-name))
 736
 737 (define-public (ly:span-bar::width grob)
 738   "Compute the width of the SpanBar stencil."
 739   (let ((width (cons 0 0)))
 740
 741        (if (grob::is-live? grob)
 742            (let* ((glyph-name (ly:grob-property grob 'glyph-name))
 743                   (stencil (span-bar::compound-bar-line grob
 744                                                         glyph-name
 745                                                         dummy-extent)))
 746
 747                  (set! width (ly:stencil-extent stencil X))))
 748        width))
 749
 750 (define-public (ly:span-bar::before-line-breaking grob)
 751   "A dummy callback that kills the Grob @var{grob} if it contains
 752 no elements."
 753   (let ((elts (ly:grob-object grob 'elements)))
 754
 755        (if (zero? (ly:grob-array-length elts))
 756            (ly:grob-suicide! grob))))
 757
 758 (define-public (span-bar::compound-bar-line grob bar-glyph extent)
 759   "Build the stencil of the span bar."
 760   (let* ((line-thickness (layout-line-thickness grob))
 761          (kern (* (ly:grob-property grob 'kern 1) line-thickness))
 762          (bar-glyph-list (string->string-list
 763                            (strip-string-annotation bar-glyph)))
 764          (span-glyph (assoc-get bar-glyph span-bar-glyph-alist 'undefined))
 765          (stencil empty-stencil))
 766
 767         (if (string? span-glyph)
 768             (let ((span-glyph-list (string->string-list span-glyph))
 769                   (is-first-stencil #t))
 770
 771                  (for-each (lambda (bar span)
 772                            ;; the stencil stack routine is similar to the one
 773                            ;; used in bar-line::compound-bar-line, but here,
 774                            ;; leading replacement-chars are discarded.
 775                            (if (not (and (string=? span (string replacement-char))
 776                                          is-first-stencil))
 777                                (begin
 778                                  (set! stencil
 779                                        (ly:stencil-combine-at-edge
 780                                          stencil
 781                                          X
 782                                          RIGHT
 783                                          ;; if the current glyph is the replacement-char,
 784                                          ;; we take the corresponding glyph from the
 785                                          ;; bar-glyph-list and insert an empty stencil
 786                                          ;; with the appropriate width.
 787                                          ;; (this method would fail if the bar-glyph-list
 788                                          ;; were shorter than the span-glyph-list,
 789                                          ;; but this makes hardly any sense from a
 790                                          ;; typographical point of view
 791                                          (if (string=? span (string replacement-char))
 792                                              ((make-spacer-bar-line bar) grob extent)
 793                                              (glyph->stencil span grob extent))
 794                                          (if is-first-stencil 0 kern)))
 795                                  (set! is-first-stencil #f))))
 796                    bar-glyph-list span-glyph-list))
 797             ;; if span-glyph is not a string, it may be #f or 'undefined;
 798             ;; the latter signals that the span bar for the current bar-glyph
 799             ;; is undefined, so we raise a warning.
 800             (if (eq? span-glyph 'undefined)
 801                 (ly:warning
 802                   (_ "No span bar glyph defined for bar glyph '~a'; ignoring.")
 803                   bar-glyph)))
 804         stencil))
 805
 806 ;; The method used in the following routine depends on bar_engraver
 807 ;; not being removed from staff context.  If bar_engraver is removed,
 808 ;; the size of the staff lines is evaluated as 0, which results in a
 809 ;; solid span bar line with faulty y coordinate.
 810 ;;
 811 ;; This routine was originally by Juergen Reuter, but it was a on the
 812 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl.
 813 (define-public (ly:span-bar::print grob)
 814   "The print routine for span bars."
 815   (let* ((elts-array (ly:grob-object grob 'elements))
 816          (refp (ly:grob-common-refpoint-of-array grob elts-array Y))
 817          (elts (reverse (sort (ly:grob-array->list elts-array)
 818                               ly:grob-vertical<?)))
 819          ;; Elements must be ordered according to their y coordinates
 820          ;; relative to their common axis group parent.
 821          ;; Otherwise, the computation goes mad.
 822          (bar-glyph (ly:grob-property grob 'glyph-name))
 823          (span-bar empty-stencil))
 824
 825         (if (string? bar-glyph)
 826             (let ((extents '())
 827                   (make-span-bars '())
 828                   (model-bar #f))
 829
 830                  ;; we compute the extents of each system and store them
 831                  ;; in a list; dito for the 'allow-span-bar property.
 832                  ;; model-bar takes the bar grob, if given.
 833                  (map (lambda (bar)
 834                       (let ((ext (bar-line::bar-y-extent bar refp))
 835                             (staff-symbol (ly:grob-object bar 'staff-symbol)))
 836
 837                            (if (ly:grob? staff-symbol)
 838                                (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
 839
 840                                     (set! ext (interval-union ext refp-extent))
 841
 842                                     (if (> (interval-length ext) 0)
 843                                         (begin
 844                                           (set! extents (append extents (list ext)))
 845                                           (set! model-bar bar)
 846                                           (set! make-span-bars
 847                                             (append make-span-bars
 848                                                     (list (ly:grob-property
 849                                                             bar
 850                                                             'allow-span-bar
 851                                                             #t))))))))))
 852                      elts)
 853                  ;; if there is no bar grob, we use the callback argument
 854                  (if (not model-bar)
 855                      (set! model-bar grob))
 856                  ;; we discard the first entry in make-span-bars,
 857                  ;; because its corresponding bar line is the
 858                  ;; uppermost and therefore not connected to
 859                  ;; another bar line
 860                  (if (pair? make-span-bars)
 861                      (set! make-span-bars (cdr make-span-bars)))
 862                  ;; the span bar reaches from the lower end of the upper staff
 863                  ;; to the upper end of the lower staff - when allow-span-bar is #t
 864                  (reduce (lambda (curr prev)
 865                                  (let ((span-extent (cons 0 0))
 866                                        (allow-span-bar (car make-span-bars)))
 867
 868                                       (set! make-span-bars (cdr make-span-bars))
 869                                       (if (> (interval-length prev) 0)
 870                                           (begin
 871                                             (set! span-extent (cons (cdr prev)
 872                                                                     (car curr)))
 873                                             ;; draw the span bar only when the staff lines
 874                                             ;; don't overlap and allow-span-bar is #t:
 875                                             (and (> (interval-length span-extent) 0)
 876                                                  allow-span-bar
 877                                                  (set! span-bar
 878                                                        (ly:stencil-add
 879                                                          span-bar
 880                                                          (span-bar::compound-bar-line
 881                                                            model-bar
 882                                                            bar-glyph
 883                                                            span-extent))))))
 884                                       curr))
 885                          "" extents)
 886                  (set! span-bar (ly:stencil-translate-axis
 887                                   span-bar
 888                                   (- (ly:grob-relative-coordinate grob refp Y))
 889                                   Y))))
 890         span-bar))
 891
 892 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 893 ;; volta bracket functions
 894
 895 (define-public (allow-volta-hook bar-glyph)
 896   "Allow the volta bracket hook being drawn over bar line @var{bar-glyph}."
 897   (if (string? bar-glyph)
 898       (set! volta-bracket-allow-volta-hook-list
 899             (append volta-bracket-allow-volta-hook-list
 900                     (list bar-glyph)))
 901       (ly:warning (_ ("Volta hook bar line must be a string; ignoring '~a'.")
 902                   bar-glyph))))
 903
 904 (define-session volta-bracket-allow-volta-hook-list '())
 905
 906 (define-public (volta-bracket::calc-hook-visibility bar-glyph)
 907   "Determine the visibility of the volta bracket hook. It is called in
 908 @code{lily/volta-bracket.cc} and returns @code{#t} if @emph{no} hook
 909 should be drawn."
 910   (not (member bar-glyph volta-bracket-allow-volta-hook-list)))
 911
 912 (define-public (ly:volta-bracket::calc-shorten-pair grob)
 913   "Calculate the @code{shorten-pair} values for an ideal placement
 914 of the volta brackets relative to the bar lines."
 915   (let* ((line-thickness (layout-line-thickness grob))
 916          (volta-half-line-thickness (* (ly:grob-property grob 'thickness 1.6)
 917                                        line-thickness
 918                                        1/2))
 919          (bar-array (ly:grob-object grob 'bars))
 920          (bar-array-length (ly:grob-array-length bar-array))
 921          ;; the bar-array starts with the uppermost bar line grob that is
 922          ;; covered by the left edge of the volta bracket; more (span)
 923          ;; bar line grobs from other staves may follow
 924          (left-bar-line (if (> bar-array-length 0)
 925                             (ly:grob-array-ref bar-array 0)
 926                             '()))
 927          ;; we need the vertical-axis-group-index of the left-bar-line
 928          ;; to find the corresponding right-bar-line
 929          (vag-index (if (null? left-bar-line)
 930                         -1
 931                         (ly:grob-get-vertical-axis-group-index left-bar-line)))
 932          ;; the bar line corresponding to the right edge of the volta bracket
 933          ;; is the last entry with the same vag-index, so we transform the array to a list,
 934          ;; reverse it and search for suitable entries:
 935          (filtered-grobs (filter (lambda (e)
 936                                          (eq? (ly:grob-get-vertical-axis-group-index e)
 937                                               vag-index))
 938                                  (reverse (ly:grob-array->list bar-array))))
 939          ;; we need the first one (if any)
 940          (right-bar-line (if (pair? filtered-grobs)
 941                              (car filtered-grobs)
 942                              '()))
 943          ;; the left-bar-line may be a #'<Grob Item >,
 944          ;; so we add "" as a fallback return value
 945          (left-bar-glyph-name (if (null? left-bar-line)
 946                                   (string annotation-char)
 947                                   (ly:grob-property left-bar-line 'glyph-name "")))
 948          (right-bar-glyph-name (if (null? right-bar-line)
 949                                    (string annotation-char)
 950                                    (ly:grob-property right-bar-line 'glyph-name "")))
 951          (left-bar-broken (or (null? left-bar-line)
 952                               (not (zero? (ly:item-break-dir left-bar-line)))))
 953          (right-bar-broken (or (null? right-bar-line)
 954                                (not (zero? (ly:item-break-dir right-bar-line)))))
 955          (left-span-stencil-extent (ly:stencil-extent
 956                                      (span-bar::compound-bar-line
 957                                        left-bar-line
 958                                        left-bar-glyph-name
 959                                        dummy-extent)
 960                                      X))
 961          (right-span-stencil-extent (ly:stencil-extent
 962                                       (span-bar::compound-bar-line
 963                                         right-bar-line
 964                                         right-bar-glyph-name
 965                                         dummy-extent)
 966                                       X))
 967          (left-shorten 0.0)
 968          (right-shorten 0.0))
 969
 970         ;; since "empty" intervals may look like (1.0 . -1.0), we use the
 971         ;; min/max functions to make sure that the placement is not corrupted
 972         ;; in case of empty bar lines
 973         (set! left-shorten
 974               (if left-bar-broken
 975                   (- (max 0 (interval-end left-span-stencil-extent))
 976                      (max 0 (interval-end (ly:stencil-extent
 977                                             (bar-line::compound-bar-line
 978                                               left-bar-line
 979                                               left-bar-glyph-name
 980                                               dummy-extent)
 981                                             X)))
 982                      volta-half-line-thickness)
 983                   (- (max 0 (interval-end left-span-stencil-extent))
 984                      volta-half-line-thickness)))
 985
 986         (set! right-shorten
 987               (if right-bar-broken
 988                   (+ (- (max 0 (interval-end right-span-stencil-extent)))
 989                      volta-half-line-thickness)
 990                   (- (min 0 (interval-start right-span-stencil-extent))
 991                      volta-half-line-thickness)))
 992
 993   (cons left-shorten right-shorten)))
 994
 995 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 996 ;; predefined bar glyph print procedures
 997
 998 (add-bar-glyph-print-procedure "" make-empty-bar-line)
 999 (add-bar-glyph-print-procedure "|" make-simple-bar-line)
1000 (add-bar-glyph-print-procedure "." make-thick-bar-line)
1001 (add-bar-glyph-print-procedure "!" make-dashed-bar-line)
1002 (add-bar-glyph-print-procedure "'" make-tick-bar-line)
1003 (add-bar-glyph-print-procedure ":" make-colon-bar-line)
1004 (add-bar-glyph-print-procedure ";" make-dotted-bar-line)
1005 (add-bar-glyph-print-procedure "k" make-kievan-bar-line)
1006 (add-bar-glyph-print-procedure "S" (make-segno-bar-line #t))
1007 (add-bar-glyph-print-procedure "=" (make-segno-bar-line #f))
1008 (add-bar-glyph-print-procedure "[" (make-bracket-bar-line LEFT))
1009 (add-bar-glyph-print-procedure "]" (make-bracket-bar-line RIGHT))
1010
1011 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1012 ;; predefined bar lines
1013 ;;
1014 ;; definition of bar lines goes as follows:
1015 ;;
1016 ;; (define-bar-line "normal bar[-annotation]" "end of line" "start of line" "span bar")
1017 ;;
1018 ;; each entry has to be a string or #f.
1019 ;; The empty string "" is allowed and yields in an invisible bar line,
1020 ;; whereas #f reads 'no stencil'.
1021 ;;
1022 ;; Convention: if two bar lines would be identical in their
1023 ;; unbroken bar glyph, we use annotations to make them distinct;
1024 ;; as a general rule of thumb the main difference in their
1025 ;; behavior at the end of a line is used as annotation, cf.
1026 ;;
1027 ;; (define-bar-line ".|:" "|" ".|:" ".|")
1028 ;; (define-bar-line ".|:-||" "||" ".|:" ".|")
1029 ;;
1030 ;; or
1031 ;;
1032 ;; (define-bar-line "S-|" "|" "S" "=")
1033 ;; (define-bar-line "S-S" "S" "" "=")
1034
1035 ;; common bar lines
1036 (define-bar-line "" "" "" #f)
1037 (define-bar-line "-" #f #f #f)
1038 (define-bar-line "|" "|" #f "|")
1039 (define-bar-line "|-s" #f "|" "|")
1040 (define-bar-line "." "." #f ".")
1041 (define-bar-line ".|" "|" ".|" ".|")
1042 (define-bar-line "|." "|." #f "|.")
1043 (define-bar-line "||" "||" #f "||")
1044 (define-bar-line ".." ".." #f "..")
1045 (define-bar-line "|.|" "|.|" #f "|.|")
1046 (define-bar-line "!" "!" #f "!")
1047 (define-bar-line ";" ";" #f ";")
1048 (define-bar-line "'" "'" #f #f)
1049
1050 ;; repeats
1051 (define-bar-line ":|.:" ":|." ".|:"  " |.")
1052 (define-bar-line ":..:" ":|." ".|:" " ..")
1053 (define-bar-line ":|.|:" ":|." ".|:" " |.|")
1054 (define-bar-line ":.|.:" ":|." ".|:" " .|.")
1055 (define-bar-line ":|." ":|." #f " |.")
1056 (define-bar-line ".|:" "|" ".|:" ".|")
1057 (define-bar-line "[|:" "|" "[|:" " |")
1058 (define-bar-line ":|]" ":|]" #f " |")
1059 (define-bar-line ":|][|:" ":|]" "[|:" " |  |")
1060 (define-bar-line ".|:-||" "||" ".|:" ".|")
1061
1062 ;; segno bar lines
1063 (define-bar-line "S" "||" "S" "=")
1064 (define-bar-line "S-|" "|" "S" "=")
1065 (define-bar-line "S-S" "S" #f "=")
1066 (define-bar-line ":|.S" ":|." "S" " |.")
1067 (define-bar-line ":|.S-S" ":|.S" "" " |.")
1068 (define-bar-line "S.|:" "|" "S.|:" " .|")
1069 (define-bar-line "S.|:-S" "S" ".|:" " .|")
1070 (define-bar-line ":|.S.|:" ":|." "S.|:" " |. .|")
1071 (define-bar-line ":|.S.|:-S" ":|.S" ".|:" " |. .|")
1072
1073 ;; ancient bar lines
1074 (define-bar-line "k" "k" #f #f) ;; kievan style
1075
1076 ;; volta hook settings
1077 (allow-volta-hook ":|.")
1078 (allow-volta-hook ".|:")
1079 (allow-volta-hook "|.")
1080 (allow-volta-hook ":..:")
1081 (allow-volta-hook ":|.|:")
1082 (allow-volta-hook ":|.:")
1083 (allow-volta-hook ".|")
1084 (allow-volta-hook ":|.S")
1085 (allow-volta-hook ":|.S-S")
1086 (allow-volta-hook ":|.S.|:")
1087 (allow-volta-hook ":|.S.|:-S")
1088 (allow-volta-hook ":|]")
1089 (allow-volta-hook ":|][|:")