scm/bar-line.scm

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