1 ;;;; This file is part of LilyPond, the GNU music typesetter.
3 ;;;; Copyright (C) 2009--2015 Marc Hohl <marc@hohlart.de>
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.
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.
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/>.
21 ;; (1) Dashed bar lines may stick out above and below the staff lines
23 ;; (2) Dashed and dotted lines look ugly in combination with span bars
25 ;; (This was the case in the c++-version of (span) bar stuff)
27 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; helper functions for staff and layout properties
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))
35 (let ((blot-diameter (layout-blot-diameter grob))
36 (height (interval-length extent)))
38 (cond ((< thickness blot-diameter) thickness)
39 ((< height blot-diameter) height)
40 (else blot-diameter)))
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}."
52 (bar-line::calc-blot thickness extent grob)))
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)))
60 (if (string? span-glyph)
61 (set! span-glyph (string-pad-right
63 (string-length bar-glyph)
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)
71 (ly:grob-object grob 'staff-symbol)))
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)))
80 (define (staff-symbol-line-count staff)
81 "Get or compute the number of lines of staff @var{staff}."
85 (let ((line-pos (ly:grob-property staff 'line-positions '())))
87 (set! line-count (if (pair? line-pos)
89 (ly:grob-property staff 'line-count 0)))))
93 (define (staff-symbol-line-span grob)
94 (let ((line-pos (ly:grob-property grob 'line-positions '()))
99 (set! iv (cons (car line-pos) (car line-pos)))
100 (for-each (lambda (x)
101 (set! iv (cons (min (car iv) x)
105 (let ((line-count (ly:grob-property grob 'line-count 0)))
107 (set! iv (cons (- 1 line-count)
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 '())))
115 (if (not (pair? line-pos))
116 (let* ((line-count (ly:grob-property grob 'line-count 0))
117 (height (- line-count 1.0)))
119 (set! line-pos (map (lambda (x)
121 (iota line-count)))))
124 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
125 ;; internal helper functions
127 (define annotation-char #\-)
128 (define replacement-char #\ )
130 (define dummy-extent (cons -1 1))
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))
140 (if (procedure? proc)
141 (set! stencil (proc grob extent))
142 (ly:warning (_ "Bar glyph ~a not known. Ignoring.") glyph))
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))))
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)))
162 (substring str 0 pos)
165 (define (check-for-annotation str)
166 "Check whether the annotation char is present in string @var{str}."
168 (if (string-index str annotation-char)
170 (_ "Annotation '~a' is allowed in the first argument of a bar line definition only.")
173 (define (check-for-replacement str)
174 "Check whether the replacement char is present in string @var{str}."
176 (if (string-index str replacement-char)
178 (_ "Replacement '~a' is allowed in the last argument of a bar line definition only.")
181 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
182 ;; functions used by external routines
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)))
191 (for-each (lambda (g)
192 (ly:grob-set-property!
195 (cons (if (eq? idx last-pos)
204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
205 ;; Line break decisions.
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))
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)))
227 (define-session bar-glyph-alist '())
229 (define-session span-bar-glyph-alist '())
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))
239 (_ "add-bar-glyph-print-procedure: glyph '~a' has to be a single ASCII character.")
241 (set! bar-glyph-print-procedures
242 (acons glyph proc bar-glyph-print-procedures))))
244 (define-session bar-glyph-print-procedures `())
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.
253 (define (make-empty-bar-line grob extent)
254 "Draw an empty bar line."
255 (ly:make-stencil "" (cons 0 0) extent))
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)
262 (extent (bar-line::widen-bar-extent-on-span grob extent)))
263 (bar-line::draw-filled-box
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)
275 (extent (bar-line::widen-bar-extent-on-span grob extent)))
276 (bar-line::draw-filled-box
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))
295 (define (make-colon-bar-line grob extent)
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
305 ;; the required space is measured in line positions,
306 ;; i.e. in half staff spaces.
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)
312 ;; choose defaults working without any staff
314 (dist (* 4 dot-y-length)))
316 (if (> staff-space 0)
318 (set! dist (/ dist staff-space))
319 (let ((staff-symbol (get-staff-symbol grob)))
321 (if (ly:grob? staff-symbol)
322 (let ((line-pos (staff-symbol-line-positions staff-symbol)))
327 (interval-center (staff-symbol-line-span
329 ;; fold the staff into two at center
331 (sort (map (lambda (lp) (abs (- lp center)))
333 (gap-to-find (/ (+ dot-y-length line-thickness)
335 (first (car folded-staff)))
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)
345 (and (> (- y x) gap-to-find)
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
353 ;; dots should go outside
354 (+ (* 2 (last folded-staff))
355 (/ (* 4 dot-y-length)
356 staff-space))))))))))))
357 (set! staff-space 1.0))
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)))
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)))
382 (ly:stencil-translate-axis
383 dot (+ x correction) Y))
384 (iota counting i 1))))
386 (define (add-stencils! stil l)
390 (ly:stencil-add stil (car l))
391 (add-stencils! (ly:stencil-add stil (car l)) (cdr l)))))
393 (add-stencils! empty-stencil stil-list)))
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)
403 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3)))
404 (line-count (staff-symbol-line-count staff-symbol)))
406 (if (< (abs (+ line-thickness
407 (* (1- line-count) staff-space)
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))
415 (for-each (lambda (i)
416 (let ((top-y (min (* (+ i dash-size) half-space)
417 (+ (* (1- line-count) half-space)
419 (bot-y (max (* (- i dash-size) half-space)
420 (- 0 (* (1- line-count) half-space)
426 (ly:round-filled-box (cons 0 thickness)
429 (iota line-count (1- line-count) (- 2)))
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
437 (* factor total-dash-size)
438 (* (- 1 factor) total-dash-size)
441 (* factor total-dash-size 0.5))
442 (cons (/ thickness -2) (/ thickness 2))
444 (interval-start extent)
447 (ly:stencil-translate-axis stencil (/ thickness 2) X)))))
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
463 (segno (ly:font-get-glyph (ly:grob-default-font grob)
465 (stencil (ly:stencil-add
470 (ly:stencil-extent segno X)
472 (ly:stencil-translate-axis
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"))))
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)
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)
496 (brackettips-down (ly:font-get-glyph (ly:grob-default-font grob)
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)
502 (ly:stencil-extent brackettips-up Y)))
503 (tip-down-stil (ly:make-stencil (ly:stencil-expr brackettips-down)
505 (ly:stencil-extent brackettips-down Y)))
506 (stencil (ly:stencil-add
508 (ly:stencil-translate-axis tip-up-stil
509 (interval-end extent)
511 (ly:stencil-translate-axis tip-down-stil
512 (interval-start extent)
517 (ly:stencil-scale stencil -1 1))))
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)))
525 (ly:make-stencil "" stil-x-extent extent)))
527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
528 ;; bar line callbacks
530 (define-public (ly:bar-line::calc-bar-extent grob)
531 (let ((staff-symbol (get-staff-symbol grob))
532 (staff-extent (cons 0 0)))
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)))
540 (set! staff-extent (ly:staff-symbol::height staff-symbol))
542 (if (zero? staff-space)
543 (set! staff-space 1.0))
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
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.
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)
561 (interval-widen staff-extent
562 (- half-staff-line-thickness)))))))
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)))
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:
584 (and (ly:grob? (car has-span-bar))
585 (set! extent (cons (- (car extent) half-staff-line-thickness)
587 (and (ly:grob? (cdr has-span-bar))
588 (set! extent (cons (car extent)
589 (+ (cdr extent) half-staff-line-thickness))))))))
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)))
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))))
606 (> (interval-length extent) 0))
607 (bar-line::compound-bar-line grob glyph-name extent)
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))
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
628 ;; Afterwards the neg-stencil is attached left to the
629 ;; stencil; this ensures that the main stencil starts
632 ;; For both routines holds:
633 ;; we stack the stencils obtained by the corresponding
634 ;; single glyphs with spacing 'kern' except for the
636 ;; (Thanks to Harm who came up with this idea!)
637 (for-each (lambda (bar span)
638 (if (and (string=? span (string replacement-char))
642 (ly:stencil-combine-at-edge
646 (glyph->stencil bar grob extent)
647 (if is-first-neg-stencil 0 kern)))
648 (set! is-first-neg-stencil #f))
651 (ly:stencil-combine-at-edge
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)
663 (ly:stencil-combine-at-edge
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))
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
693 (span-bar::compound-bar-line grob bar-glyph dummy-extent)
697 (define-public (bar-line::calc-glyph-name grob)
698 "Determine the @code{glyph-name} of the bar line depending on the
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)
706 (string? (index-cell result dir)))
707 (index-cell result dir)
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)))
717 (vector (string? (car result)) #t (string? (cdr result)))
720 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
721 ;; span bar callbacks
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)))
731 (while (and (eq? glyph-name '())
733 (begin (set! glyph-name
734 (ly:grob-property (ly:grob-array-ref elts pos)
736 (set! pos (1- pos))))
737 (if (eq? glyph-name '())
738 (begin (ly:grob-suicide! grob)
739 (set! glyph-name "")))
742 (define-public (ly:span-bar::width grob)
743 "Compute the width of the SpanBar stencil."
744 (let ((width (cons 0 0)))
746 (if (grob::is-live? grob)
747 (let* ((glyph-name (ly:grob-property grob 'glyph-name))
748 (stencil (span-bar::compound-bar-line grob
752 (set! width (ly:stencil-extent stencil X))))
755 (define-public (ly:span-bar::before-line-breaking grob)
756 "A dummy callback that kills the Grob @var{grob} if it contains
758 (let ((elts (ly:grob-object grob 'elements)))
760 (if (zero? (ly:grob-array-length elts))
761 (ly:grob-suicide! grob))))
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))
772 (if (string? span-glyph)
773 (let ((span-glyph-list (string->string-list span-glyph))
774 (is-first-stencil #t))
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))
784 (ly:stencil-combine-at-edge
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)
807 (_ "No span bar glyph defined for bar glyph '~a'; ignoring.")
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.
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))
830 (if (string? bar-glyph)
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)))
842 (if (ly:grob? staff-symbol)
843 (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
845 (set! ext (interval-union ext refp-extent))
847 (if (> (interval-length ext) 0)
849 (set! extents (append extents (list ext)))
852 (append make-span-bars
853 (list (ly:grob-property
858 ;; if there is no bar grob, we use the callback argument
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
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)))
873 (set! make-span-bars (cdr make-span-bars))
874 (if (> (interval-length prev) 0)
876 (set! span-extent (cons (cdr prev)
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)
885 (span-bar::compound-bar-line
891 (set! span-bar (ly:stencil-translate-axis
893 (- (ly:grob-relative-coordinate grob refp Y))
897 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
898 ;; volta bracket functions
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
906 (ly:warning (_ ("Volta hook bar line must be a string; ignoring '~a'.")
909 (define-session volta-bracket-allow-volta-hook-list '())
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
915 (not (member bar-glyph volta-bracket-allow-volta-hook-list)))
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)
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
939 (right-bar-line (and left-bar-line
941 (eqv? (ly:grob-get-vertical-axis-group-index e)
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
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)
967 (right-span-stencil-extent (ly:stencil-extent
968 (span-bar::compound-bar-line
969 (or right-bar-line grob)
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
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)
988 volta-half-line-thickness)
989 (- (max 0 (interval-end left-span-stencil-extent))
990 volta-half-line-thickness)))
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)))
999 (cons left-shorten right-shorten)))
1001 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1002 ;; predefined bar glyph print procedures
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))
1017 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1018 ;; predefined bar lines
1020 ;; definition of bar lines goes as follows:
1022 ;; (define-bar-line "normal bar[-annotation]" "end of line" "start of line" "span bar")
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'.
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.
1033 ;; (define-bar-line ".|:" "|" ".|:" ".|")
1034 ;; (define-bar-line ".|:-||" "||" ".|:" ".|")
1038 ;; (define-bar-line "S-|" "|" "S" "=")
1039 ;; (define-bar-line "S-S" "S" "" "=")
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)
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 ".|:-||" "||" ".|:" ".|")
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" ".|:" " |. .|")
1079 ;; ancient bar lines
1080 (define-bar-line "k" "k" #f #f) ;; kievan style
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 ":|][|:")