X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbar-line.scm;h=3fad8f8912949bf96a9944b6a1019432be850cb3;hb=HEAD;hp=25cf20ea27f13cf8bb9934a3f0417678dc8f9bc7;hpb=2784264fda1124e0db8fb9b1385905e48e2650b9;p=lilypond.git diff --git a/scm/bar-line.scm b/scm/bar-line.scm index 25cf20ea27..3fad8f8912 100644 --- a/scm/bar-line.scm +++ b/scm/bar-line.scm @@ -1,6 +1,6 @@ ;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; Copyright (C) 2009--2012 Marc Hohl +;;;; Copyright (C) 2009--2015 Marc Hohl ;;;; ;;;; LilyPond is free software: you can redistribute it and/or modify ;;;; it under the terms of the GNU General Public License as published by @@ -15,157 +15,285 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . -;; helper functions + + +;; TODO: +;; (1) Dashed bar lines may stick out above and below the staff lines +;; +;; (2) Dashed and dotted lines look ugly in combination with span bars +;; +;; (This was the case in the c++-version of (span) bar stuff) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; helper functions for staff and layout properties + +(define (bar-line::calc-blot thickness extent grob) + "Calculate the blot diameter by taking @code{'rounded} +and the dimensions of the extent into account." + (let* ((rounded (ly:grob-property grob 'rounded #f)) + (blot (if rounded + (let ((blot-diameter (layout-blot-diameter grob)) + (height (interval-length extent))) + + (cond ((< thickness blot-diameter) thickness) + ((< height blot-diameter) height) + (else blot-diameter))) + 0))) + blot)) + +(define-public (bar-line::draw-filled-box x-ext y-ext thickness extent grob) + "Return a straight bar-line created by @code{ly:round-filled-box} looking at +@var{x-ext}, @var{y-ext}, @var{thickness}. The blot is calculated by +@code{bar-line::calc-blot}, which needs @var{extent} and @var{grob}. +@var{y-ext} is not necessarily of same value as @var{extent}." + (ly:round-filled-box + x-ext + y-ext + (bar-line::calc-blot thickness extent grob))) + +(define (get-span-glyph bar-glyph) + "Get the corresponding span glyph from the @code{span-glyph-bar-alist}. +Pad the string with @code{annotation-char}s to the length of the +@var{bar-glyph} string." + (let ((span-glyph (assoc-get bar-glyph span-bar-glyph-alist bar-glyph))) + + (if (string? span-glyph) + (set! span-glyph (string-pad-right + span-glyph + (string-length bar-glyph) + replacement-char))) + span-glyph)) (define (get-staff-symbol grob) + "Return the staff symbol corresponding to Grob @var{grob}." (if (grob::has-interface grob 'staff-symbol-interface) grob (ly:grob-object grob 'staff-symbol))) (define (layout-blot-diameter grob) + "Get the blot diameter of the @var{grob}'s corresponding layout." (let* ((layout (ly:grob-layout grob)) - (blot (ly:output-def-lookup layout 'blot-diameter))) - - blot)) + (blot-diameter (ly:output-def-lookup layout 'blot-diameter))) -(define (layout-line-thickness grob) - (let* ((layout (ly:grob-layout grob)) - (line-thickness (ly:output-def-lookup layout 'line-thickness))) + blot-diameter)) - line-thickness)) - -(define (staff-symbol-line-count grob) +(define (staff-symbol-line-count staff) + "Get or compute the number of lines of staff @var{staff}." (let ((line-count 0)) - (if (ly:grob? grob) - (let ((line-pos (ly:grob-property grob 'line-positions '()))) + (if (ly:grob? staff) + (let ((line-pos (ly:grob-property staff 'line-positions '()))) - (set! line-count (if (pair? line-pos) - (length line-pos) - (ly:grob-property grob 'line-count 0))))) + (set! line-count (if (pair? line-pos) + (length line-pos) + (ly:grob-property staff 'line-count 0))))) - line-count)) + line-count)) (define (staff-symbol-line-span grob) (let ((line-pos (ly:grob-property grob 'line-positions '())) (iv (cons 0.0 0.0))) - (if (pair? line-pos) - (begin - (set! iv (cons (car line-pos) (car line-pos))) - (map (lambda (x) - (set! iv (cons (min (car iv) x) - (max (cdr iv) x)))) - (cdr line-pos))) + (if (pair? line-pos) + (begin + (set! iv (cons (car line-pos) (car line-pos))) + (for-each (lambda (x) + (set! iv (cons (min (car iv) x) + (max (cdr iv) x)))) + (cdr line-pos))) - (let ((line-count (ly:grob-property grob 'line-count 0))) + (let ((line-count (ly:grob-property grob 'line-count 0))) - (set! iv (cons (- 1 line-count) - (- line-count 1))))) - iv)) + (set! iv (cons (- 1 line-count) + (- line-count 1))))) + iv)) (define (staff-symbol-line-positions grob) + "Get or compute the @code{'line-positions} list from @var{grob}." (let ((line-pos (ly:grob-property grob 'line-positions '()))) - (if (not (pair? line-pos)) - (let* ((line-count (ly:grob-property grob 'line-count 0)) - (height (- line-count 1.0))) - - (set! line-pos (map (lambda (x) - (- height (* x 2))) - (iota line-count))))) - line-pos)) - + (if (not (pair? line-pos)) + (let* ((line-count (ly:grob-property grob 'line-count 0)) + (height (- line-count 1.0))) + + (set! line-pos (map (lambda (x) + (- height (* x 2))) + (iota line-count))))) + line-pos)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; internal helper functions + +(define annotation-char #\-) +(define replacement-char #\ ) + +(define dummy-extent (cons -1 1)) + + +(define (glyph->stencil glyph grob extent) + "Return a stencil computed by the procedure associated with +glyph @var{glyph}. The arguments @var{grob} and @var{extent} are +mandatory to the procedures stored in @code{bar-glyph-print-procedures}." + (let ((proc (assoc-get glyph bar-glyph-print-procedures)) + (stencil empty-stencil)) + + (if (procedure? proc) + (set! stencil (proc grob extent)) + (ly:warning (_ "Bar glyph ~a not known. Ignoring.") glyph)) + stencil)) + +(define (string->string-list str) + "Convert a string into a list of strings with length 1. +@code{\"aBc\"} will be converted to @code{(\"a\" \"B\" \"c\")}. +An empty string will be converted to a list containing @code{\"\"}." + (if (and (string? str) + (not (zero? (string-length str)))) + (map (lambda (s) + (string s)) + (string->list str)) + (list ""))) + +(define (strip-string-annotation str) + "Strip annotations starting with and including the +annotation char from string @var{str}." + (let ((pos (string-index str annotation-char))) + + (if pos + (substring str 0 pos) + str))) + +(define (check-for-annotation str) + "Check whether the annotation char is present in string @var{str}." + (if (string? str) + (if (string-index str annotation-char) + (ly:warning + (_ "Annotation '~a' is allowed in the first argument of a bar line definition only.") + str)))) + +(define (check-for-replacement str) + "Check whether the replacement char is present in string @var{str}." + (if (string? str) + (if (string-index str replacement-char) + (ly:warning + (_ "Replacement '~a' is allowed in the last argument of a bar line definition only.") + str)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; functions used by external routines (define-public (span-bar::notify-grobs-of-my-existence grob) + "Set the @code{'has-span-bar} property for all elements of Grob @var{grob}." (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements))) (sorted-elts (sort elts ly:grob-vertical (string-length glyph) 1)) + (ly:warning + (_ "add-bar-glyph-print-procedure: glyph '~a' has to be a single ASCII character.") + glyph) + (set! bar-glyph-print-procedures + (acons glyph proc bar-glyph-print-procedures)))) + +(define-session bar-glyph-print-procedures `()) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; drawing functions for various bar line types +;; to include them and other user-defined functions, +;; all of them have the form +;; (make-...-bar-line grob extent) +;; even if the extent is not used. (define (make-empty-bar-line grob extent) + "Draw an empty bar line." (ly:make-stencil "" (cons 0 0) extent)) -(define (make-simple-bar-line grob width extent rounded) - (let ((blot (if rounded - (layout-blot-diameter grob) - 0))) - - (ly:round-filled-box (cons 0 width) - extent - blot))) - -(define (make-tick-bar-line grob height rounded) - (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) - (staff-line-thickness (ly:staff-symbol-line-thickness grob)) - (blot (if rounded - (layout-blot-diameter grob) - 0))) - - (ly:round-filled-box (cons 0 staff-line-thickness) - (cons (- height half-staff) (+ height half-staff)) - blot))) - -(define (make-colon-bar-line grob) +(define (make-simple-bar-line grob extent) + "Draw a simple bar line." + (let* ((line-thickness (layout-line-thickness grob)) + (thickness (* (ly:grob-property grob 'hair-thickness 1) + line-thickness)) + (extent (bar-line::widen-bar-extent-on-span grob extent))) + (bar-line::draw-filled-box + (cons 0 thickness) + extent + thickness + extent + grob))) + +(define (make-thick-bar-line grob extent) + "Draw a thick bar line." + (let* ((line-thickness (layout-line-thickness grob)) + (thickness (* (ly:grob-property grob 'thick-thickness 1) + line-thickness)) + (extent (bar-line::widen-bar-extent-on-span grob extent))) + (bar-line::draw-filled-box + (cons 0 thickness) + extent + thickness + extent + grob))) + +(define (make-tick-bar-line grob extent) + "Draw a tick bar line." + (let* ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) + (staff-line-thickness (ly:staff-symbol-line-thickness grob)) + (height (interval-end extent))) + (bar-line::draw-filled-box + (cons 0 staff-line-thickness) + (cons (- height half-staff) (+ height half-staff)) + staff-line-thickness + extent + grob))) + +(define (make-colon-bar-line grob extent) + "Draw repeat dots." (let* ((staff-space (ly:staff-symbol-staff-space grob)) (line-thickness (ly:staff-symbol-line-thickness grob)) (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) @@ -204,34 +332,28 @@ line-pos) <)) (gap-to-find (/ (+ dot-y-length line-thickness) (/ staff-space 2))) - (first (car folded-staff)) - (found #f)) + (first (car folded-staff))) ;; find the first space big enough ;; to hold a dot and a staff line ;; (a space in the folded staff may be ;; narrower but can't be wider than the ;; corresponding original spaces) - (reduce (lambda (x y) (if (and (> (- x y) gap-to-find) - (not found)) - (begin - (set! found #t) - (set! dist (+ x y)))) - x) - "" - folded-staff) - - (if (not found) - (set! dist (if (< gap-to-find first) - ;; there's a central space big - ;; enough to hold both dots - first - - ;; dots should go outside - (+ (* 2 (car - (reverse folded-staff))) - (/ (* 4 dot-y-length) - staff-space)))))))))))) + (set! dist + (or + (any (lambda (x y) + (and (> (- y x) gap-to-find) + (+ x y))) + folded-staff (cdr folded-staff)) + (if (< gap-to-find first) + ;; there's a central space big + ;; enough to hold both dots + first + + ;; dots should go outside + (+ (* 2 (last folded-staff)) + (/ (* 4 dot-y-length) + staff-space)))))))))))) (set! staff-space 1.0)) (let* ((stencil empty-stencil) @@ -244,7 +366,9 @@ (/ staff-space 2)) Y))) stencil))) + (define (make-dotted-bar-line grob extent) + "Draw a dotted bar line." (let* ((position (round (* (interval-end extent) 2))) (correction (if (even? position) 0.5 0.0)) (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) @@ -254,38 +378,41 @@ (- 0.5 correction)))) (counting (interval-length (cons i e))) (stil-list (map - (lambda (x) - (ly:stencil-translate-axis - dot (+ x correction) Y)) - (iota counting i 1)))) - - (define (add-stencils! stil l) - (if (null? l) - stil - (if (null? (cdr l)) - (ly:stencil-add stil (car l)) - (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) - - (add-stencils! empty-stencil stil-list))) - -(define (make-dashed-bar-line grob extent thickness) + (lambda (x) + (ly:stencil-translate-axis + dot (+ x correction) Y)) + (iota counting i 1)))) + + (define (add-stencils! stil l) + (if (null? l) + stil + (if (null? (cdr l)) + (ly:stencil-add stil (car l)) + (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) + + (add-stencils! empty-stencil stil-list))) + +(define (make-dashed-bar-line grob extent) + "Draw a dashed bar line." (let* ((height (interval-length extent)) (staff-symbol (get-staff-symbol grob)) (staff-space (ly:staff-symbol-staff-space grob)) (line-thickness (layout-line-thickness grob)) + (thickness (* (ly:grob-property grob 'hair-thickness 1) + line-thickness)) (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) (line-count (staff-symbol-line-count staff-symbol))) - (if (< (abs (+ line-thickness - (* (1- line-count) staff-space) - (- height))) - 0.1) - (let ((blot (layout-blot-diameter grob)) - (half-space (/ staff-space 2.0)) - (half-thick (/ line-thickness 2.0)) - (stencil empty-stencil)) + (if (< (abs (+ line-thickness + (* (1- line-count) staff-space) + (- height))) + 0.1) + (let ((blot (layout-blot-diameter grob)) + (half-space (/ staff-space 2.0)) + (half-thick (/ line-thickness 2.0)) + (stencil empty-stencil)) - (map (lambda (i) + (for-each (lambda (i) (let ((top-y (min (* (+ i dash-size) half-space) (+ (* (1- line-count) half-space) half-thick))) @@ -293,274 +420,283 @@ (- 0 (* (1- line-count) half-space) half-thick)))) - (set! stencil - (ly:stencil-add - stencil - (ly:round-filled-box (cons 0 thickness) - (cons bot-y top-y) - blot))))) - (iota line-count (1- line-count) (- 2))) - stencil) - (let* ((dashes (/ height staff-space)) - (total-dash-size (/ height dashes)) - (factor (/ (- dash-size thickness) staff-space))) - - (ly:stencil-translate-axis - (ly:make-stencil (list 'dashed-line - thickness - (* factor total-dash-size) - (* (- 1 factor) total-dash-size) - 0 - height - (* factor total-dash-size 0.5)) - (cons 0 thickness) - (cons 0 height)) - (interval-start extent) - Y))))) - -(define (make-segno-bar-line grob glyph extent rounded) + (set! stencil + (ly:stencil-add + stencil + (ly:round-filled-box (cons 0 thickness) + (cons bot-y top-y) + blot))))) + (iota line-count (1- line-count) (- 2))) + stencil) + (let* ((dashes (/ height staff-space)) + (total-dash-size (/ height dashes)) + (factor (/ (- dash-size thickness) staff-space)) + (stencil (ly:stencil-translate-axis + (ly:make-stencil (list 'dashed-line + thickness + (* factor total-dash-size) + (* (- 1 factor) total-dash-size) + 0 + height + (* factor total-dash-size 0.5)) + (cons (/ thickness -2) (/ thickness 2)) + (cons 0 height)) + (interval-start extent) + Y))) + + (ly:stencil-translate-axis stencil (/ thickness 2) X))))) + + +(define ((make-segno-bar-line show-segno) grob extent) + "Draw a segno bar line. If @var{show-segno} is set to @code{#t}, +the segno sign is drawn over the double bar line; otherwise, it +draws the span bar variant, i.e. without the segno sign." (let* ((line-thickness (layout-line-thickness grob)) - (kern (* (ly:grob-property grob 'kern 1) line-thickness)) - (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) - (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) - (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) - (thin-stil (make-simple-bar-line grob hair extent rounded)) - (thick-stil (make-simple-bar-line grob fatline extent rounded)) - (colon-stil (make-colon-bar-line grob)) - (segno-stil (ly:stencil-add - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - '() X LEFT thin-stil thinkern) - X RIGHT thin-stil thinkern) - (ly:font-get-glyph (ly:grob-default-font grob) "scripts.varsegno"))) - (glyph (cond - ((string=? glyph "|S") "S") - ((string=? glyph "S|") "S") - (else glyph))) - (stencil (cond - ((or (string=? glyph "S|:") - (string=? glyph ".S|:")) - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X RIGHT thin-stil kern) - X RIGHT colon-stil kern) - X LEFT segno-stil thinkern)) - ((or (string=? glyph ":|S") - (string=? glyph ":|S.")) - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X LEFT colon-stil kern) - X RIGHT segno-stil thinkern)) - ((or (string=? glyph ":|S|:") - (string=? glyph ":|S.|:")) - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X LEFT colon-stil kern) - X RIGHT segno-stil thinkern) - X RIGHT thick-stil thinkern) - X RIGHT thin-stil kern) - X RIGHT colon-stil kern)) - ((string=? glyph "|._.|") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X RIGHT thick-stil (+ (interval-length - (ly:stencil-extent segno-stil X)) - (* 2 thinkern))) - X RIGHT thin-stil kern)) - (else segno-stil)))) - - stencil)) - -(define (make-kievan-bar-line grob) + (segno-kern (* (ly:grob-property grob 'segno-kern 1) line-thickness)) + (thin-stil (make-simple-bar-line grob extent)) + (double-line-stil (ly:stencil-combine-at-edge + thin-stil + X + LEFT + thin-stil + segno-kern)) + (segno (ly:font-get-glyph (ly:grob-default-font grob) + "scripts.varsegno")) + (stencil (ly:stencil-add + (if show-segno + segno + (ly:make-stencil + "" + (ly:stencil-extent segno X) + (cons 0 0))) + (ly:stencil-translate-axis + double-line-stil + (* 1/2 segno-kern) + X)))) + + stencil)) + +(define (make-kievan-bar-line grob extent) + "Draw a kievan bar line." (let* ((font (ly:grob-default-font grob)) - (stencil (stencil-whiteout - (ly:font-get-glyph font "scripts.barline.kievan")))) - - ;; the kievan bar line has mo staff lines underneath, - ;; so we whiteout them and move ithe grob to a higher layer - (ly:grob-set-property! grob 'layer 1) - stencil)) - + (stencil (stencil-whiteout-box + (ly:font-get-glyph font "scripts.barline.kievan")))) + + ;; the kievan bar line has no staff lines underneath, + ;; so we whiteout-box them and move the grob to a higher layer + (ly:grob-set-property! grob 'layer 1) + stencil)) + +(define ((make-bracket-bar-line dir) grob extent) + "Draw a bracket-style bar line. If @var{dir} is set to @code{LEFT}, the +opening bracket will be drawn, for @code{RIGHT} we get the closing bracket." + (let* ((thick-stil (make-thick-bar-line grob extent)) + (brackettips-up (ly:font-get-glyph (ly:grob-default-font grob) + "brackettips.up")) + (brackettips-down (ly:font-get-glyph (ly:grob-default-font grob) + "brackettips.down")) + ;; the x-extent of the brackettips must not be taken into account + ;; for bar line constructs like "[|:", so we set new bounds: + (tip-up-stil (ly:make-stencil (ly:stencil-expr brackettips-up) + (cons 0 0) + (ly:stencil-extent brackettips-up Y))) + (tip-down-stil (ly:make-stencil (ly:stencil-expr brackettips-down) + (cons 0 0) + (ly:stencil-extent brackettips-down Y))) + (stencil (ly:stencil-add + thick-stil + (ly:stencil-translate-axis tip-up-stil + (interval-end extent) + Y) + (ly:stencil-translate-axis tip-down-stil + (interval-start extent) + Y)))) + + (if (eqv? dir LEFT) + stencil + (ly:stencil-scale stencil -1 1)))) + +(define ((make-spacer-bar-line glyph) grob extent) + "Draw an invisible bar line which has the same dimensions as the one +drawn by the procedure associated with glyph @var{glyph}." + (let* ((stil (glyph->stencil glyph grob extent)) + (stil-x-extent (ly:stencil-extent stil X))) + + (ly:make-stencil "" stil-x-extent extent))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; bar line callbacks (define-public (ly:bar-line::calc-bar-extent grob) (let ((staff-symbol (get-staff-symbol grob)) (staff-extent (cons 0 0))) - (if (ly:grob? staff-symbol) - (let* ((bar-line-color (ly:grob-property grob 'color)) - (staff-color (ly:grob-property staff-symbol 'color)) - (staff-line-thickness (ly:staff-symbol-line-thickness grob)) - (staff-space (ly:staff-symbol-staff-space grob))) - - (set! staff-extent (ly:staff-symbol::height staff-symbol)) - - (if (zero? staff-space) - (set! staff-space 1.0)) - - (if (< (interval-length staff-extent) staff-space) - ;; staff is too small (perhaps consists of a single line); - ;; extend the bar line to make it visible - (set! staff-extent - (interval-widen staff-extent staff-space)) - ;; Due to rounding problems, bar lines extending to the outermost edges - ;; of the staff lines appear wrongly in on-screen display - ;; (and, to a lesser extent, in print) - they stick out a pixel. - ;; The solution is to extend bar lines only to the middle - ;; of the staff line - unless they have different colors, - ;; when it would be undesirable. - ;; - ;; This reduction should not influence whether bar is to be - ;; expanded later, so length is not updated on purpose. - (if (eq? bar-line-color staff-color) - (set! staff-extent - (interval-widen staff-extent - (* -1/2 staff-line-thickness))))))) - staff-extent)) + (if (ly:grob? staff-symbol) + (let ((bar-line-color (ly:grob-property grob 'color)) + (staff-color (ly:grob-property staff-symbol 'color)) + (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2)) + (staff-space (ly:staff-symbol-staff-space grob))) + + (set! staff-extent (ly:staff-symbol::height staff-symbol)) + + (if (zero? staff-space) + (set! staff-space 1.0)) + + (if (< (interval-length staff-extent) staff-space) + ;; staff is too small (perhaps consists of a single line); + ;; extend the bar line to make it visible + (set! staff-extent + (interval-widen staff-extent staff-space)) + ;; Due to rounding problems, bar lines extending to the outermost edges + ;; of the staff lines appear wrongly in on-screen display + ;; (and, to a lesser extent, in print) - they stick out a pixel. + ;; The solution is to extend bar lines only to the middle + ;; of the staff line - unless they have different colors, + ;; when it would be undesirable. + ;; + ;; This reduction should not influence whether the bar is to be + ;; expanded later, so length is not updated on purpose. + (if (eq? bar-line-color staff-color) + (set! staff-extent + (interval-widen staff-extent + (- half-staff-line-thickness))))))) + staff-extent)) + +;; this function may come in handy when defining new bar line glyphs, so +;; we make it public. +;; This code should not be included in ly:bar-line::calc-bar-extent, because +;; this may confuse the drawing functions for dashed and dotted bar lines. +(define-public (bar-line::widen-bar-extent-on-span grob extent) + "Widens the bar line @var{extent} towards span bars adjacent to grob @var{grob}." + (let ((staff-symbol (get-staff-symbol grob)) + (has-span-bar (ly:grob-property grob 'has-span-bar #f))) + + (if (and (ly:grob? staff-symbol) + (pair? has-span-bar)) + (let ((bar-line-color (ly:grob-property grob 'color)) + (staff-color (ly:grob-property staff-symbol 'color)) + (half-staff-line-thickness (/ (ly:staff-symbol-line-thickness grob) 2))) + (if (eq? bar-line-color staff-color) + ;; if the colors are equal, ly:bar-line::calc-bar-extent has + ;; shortened the bar line extent by a half-staff-line-thickness + ;; this is reverted on the interval bounds where span bars appear: + (begin + (and (ly:grob? (car has-span-bar)) + (set! extent (cons (- (car extent) half-staff-line-thickness) + (cdr extent)))) + (and (ly:grob? (cdr has-span-bar)) + (set! extent (cons (car extent) + (+ (cdr extent) half-staff-line-thickness)))))))) + extent)) (define (bar-line::bar-y-extent grob refpoint) + "Compute the y-extent of the bar line relative to @var{refpoint}." (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) (rel-y (ly:grob-relative-coordinate grob refpoint Y)) (y-extent (coord-translate extent rel-y))) - y-extent)) + y-extent)) (define-public (ly:bar-line::print grob) - (let ((glyph (ly:grob-property grob 'glyph-name)) + "The print routine for bar lines." + (let ((glyph-name (ly:grob-property grob 'glyph-name)) (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) - (if (and (not (eq? glyph '())) - (> (interval-length extent) 0)) - (bar-line::compound-bar-line grob glyph extent #f) - #f))) + (if (and glyph-name + (> (interval-length extent) 0)) + (bar-line::compound-bar-line grob glyph-name extent) + #f))) -(define-public (bar-line::compound-bar-line grob glyph extent rounded) +(define-public (bar-line::compound-bar-line grob bar-glyph extent) + "Build the bar line stencil." (let* ((line-thickness (layout-line-thickness grob)) - (height (interval-length extent)) (kern (* (ly:grob-property grob 'kern 1) line-thickness)) - (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) - (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) - (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) - (thin-stil (make-simple-bar-line grob hair extent rounded)) - (thick-stil (make-simple-bar-line grob fatline extent rounded)) - (colon-stil (make-colon-bar-line grob)) - (glyph (cond - ((not glyph) "") - ((string=? glyph "||:") "|:") - ;; bar-line::compound-bar-line is called only if - ;; height > 0, but just in case ... - ((and (string=? glyph ":|") - (zero? height)) "|.") - ((and (string=? glyph "|:") - (zero? height)) ".|") - (else glyph))) - (stencil (cond - ((string=? glyph "|") thin-stil) - ((string=? glyph ".") thick-stil) - ((string=? glyph "||") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - '() X LEFT thin-stil thinkern) - X RIGHT thin-stil thinkern)) - ((string=? glyph "|.") - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern)) - ((string=? glyph ".|") - (ly:stencil-combine-at-edge - thick-stil X RIGHT thin-stil kern)) - ((string=? glyph "|:") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X RIGHT thin-stil kern) - X RIGHT colon-stil kern)) - ((string=? glyph ":|") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X LEFT colon-stil kern)) - ((string=? glyph ":|:") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - '() X LEFT thick-stil thinkern) - X LEFT colon-stil kern) - X RIGHT thick-stil kern) - X RIGHT colon-stil kern)) - ((string=? glyph ":|.|:") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X LEFT colon-stil kern) - X RIGHT thin-stil kern) - X RIGHT colon-stil kern)) - ((string=? glyph ":|.:") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X LEFT colon-stil kern) - X RIGHT colon-stil kern)) - ((string=? glyph ".|.") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - '() X LEFT thick-stil thinkern) - X RIGHT thick-stil kern)) - ((string=? glyph "|.|") - (ly:stencil-combine-at-edge - (ly:stencil-combine-at-edge - thick-stil X LEFT thin-stil kern) - X RIGHT thin-stil kern)) - ((string=? glyph ":") - (make-dotted-bar-line grob extent)) - ((or (string=? glyph "|._.|") - (string-contains glyph "S")) - (make-segno-bar-line grob glyph extent rounded)) - ((string=? glyph "'") - (make-tick-bar-line grob (interval-end extent) rounded)) - ((string=? glyph "dashed") - (make-dashed-bar-line grob extent hair)) - ((string=? glyph "kievan") - (make-kievan-bar-line grob)) - (else (make-empty-bar-line grob extent))))) - stencil)) + (bar-glyph-list (string->string-list + (strip-string-annotation bar-glyph))) + (span-glyph (get-span-glyph bar-glyph)) + (span-glyph-list (string->string-list span-glyph)) + (neg-stencil empty-stencil) + (stencil empty-stencil) + (is-first-neg-stencil #t) + (is-first-stencil #t)) + + ;; We build up two separate stencils first: + ;; (1) the neg-stencil is built from all glyphs that have + ;; a replacement-char in the span bar + ;; (2) the main stencil is built from all remaining glyphs + ;; + ;; Afterwards the neg-stencil is attached left to the + ;; stencil; this ensures that the main stencil starts + ;; at x = 0. + ;; + ;; For both routines holds: + ;; we stack the stencils obtained by the corresponding + ;; single glyphs with spacing 'kern' except for the + ;; first stencil + ;; (Thanks to Harm who came up with this idea!) + (for-each (lambda (bar span) + (if (and (string=? span (string replacement-char)) + is-first-stencil) + (begin + (set! neg-stencil + (ly:stencil-combine-at-edge + neg-stencil + X + RIGHT + (glyph->stencil bar grob extent) + (if is-first-neg-stencil 0 kern))) + (set! is-first-neg-stencil #f)) + (begin + (set! stencil + (ly:stencil-combine-at-edge + stencil + X + RIGHT + (glyph->stencil bar grob extent) + (if is-first-stencil 0 kern))) + (set! is-first-stencil #f)))) + bar-glyph-list span-glyph-list) + ;; if we have a non-empty neg-stencil, + ;; we attach it to the left side of the stencil + (and (not is-first-neg-stencil) + (set! stencil + (ly:stencil-combine-at-edge + stencil + X + LEFT + neg-stencil + kern))) + stencil)) (define-public (ly:bar-line::calc-anchor grob) - (let* ((line-thickness (layout-line-thickness grob)) - (kern (* (ly:grob-property grob 'kern 1) line-thickness)) - (glyph (ly:grob-property grob 'glyph-name "")) + "Calculate the anchor position of a bar line. The anchor is used for +the correct placement of bar numbers etc." + (let* ((bar-glyph (ly:grob-property grob 'glyph-name "")) + (bar-glyph-list (string->string-list (strip-string-annotation bar-glyph))) + (span-glyph (assoc-get bar-glyph span-bar-glyph-alist bar-glyph)) (x-extent (ly:grob-extent grob grob X)) - (dot-width (+ (interval-length - (ly:stencil-extent - (ly:font-get-glyph - (ly:grob-default-font grob) - "dots.dot") - X)) - kern)) (anchor 0.0)) - (if (> (interval-length x-extent) 0) - (begin - (set! anchor (interval-center x-extent)) - (cond ((string=? glyph "|:") - (set! anchor (+ anchor (/ dot-width -2.0)))) - ((string=? glyph ":|") - (set! anchor (+ anchor (/ dot-width 2.0))))))) - anchor)) + (and (> (interval-length x-extent) 0) + (if (or (= (length bar-glyph-list) 1) + (string=? bar-glyph span-glyph) + (string=? span-glyph "")) + ;; We use the x-extent of the stencil if either + ;; - we have a single bar-glyph + ;; - bar-glyph and span-glyph are identical + ;; - we have no span-glyph + (set! anchor (interval-center x-extent)) + ;; If the conditions above do not hold,the anchor is the + ;; center of the corresponding span bar stencil extent + (set! anchor (interval-center + (ly:stencil-extent + (span-bar::compound-bar-line grob bar-glyph dummy-extent) + X))))) + anchor)) (define-public (bar-line::calc-glyph-name grob) + "Determine the @code{glyph-name} of the bar line depending on the +line break status." (let* ((glyph (ly:grob-property grob 'glyph)) (dir (ly:item-break-dir grob)) (result (assoc-get glyph bar-glyph-alist)) @@ -568,11 +704,12 @@ glyph (if (and result (string? (index-cell result dir))) - (index-cell result dir) - #f)))) - glyph-name)) + (index-cell result dir) + #f)))) + glyph-name)) (define-public (bar-line::calc-break-visibility grob) + "Calculate the visibility of a bar line at line breaks." (let* ((glyph (ly:grob-property grob 'glyph)) (result (assoc-get glyph bar-glyph-alist))) @@ -580,69 +717,106 @@ (vector (string? (car result)) #t (string? (cdr result))) all-invisible))) -;; which span bar belongs to a bar line? - -(define-public span-bar-glyph-alist - '(("|:" . ".|") - ("||:" . ".|") - (":|" . "|.") - (":|.:" . "|.") - (":|:" . ".|.") - (":|.|:" . "|.|") - (":|.|" . "|.") - ("S" . "||" ) - ("S|" . "||") - ("|S" . "||") - ("S|:" . ".|") - (".S|:" . ".|") - (":|S" . "|.") - (":|S." . "|.") - (":|S|:" . "|._.|") - (":|S.|:" . "|._.|") - ("kievan" . "") - ("'" . ""))) - +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; span bar callbacks (define-public (ly:span-bar::calc-glyph-name grob) + "Return the @code{'glyph-name} of the corresponding BarLine grob. +The corresponding SpanBar glyph is computed within +@code{span-bar::compound-bar-line}." (let* ((elts (ly:grob-object grob 'elements)) (pos (1- (ly:grob-array-length elts))) - (glyph '())) - - (while (and (eq? glyph '()) - (> pos -1)) - (begin (set! glyph (ly:grob-property (ly:grob-array-ref elts pos) - 'glyph-name)) - (set! pos (1- pos)))) - (if (eq? glyph '()) - (begin (ly:grob-suicide! grob) - (set! glyph ""))) - (assoc-get glyph span-bar-glyph-alist glyph))) + (glyph-name '())) + + (while (and (eq? glyph-name '()) + (> pos -1)) + (begin (set! glyph-name + (ly:grob-property (ly:grob-array-ref elts pos) + 'glyph-name)) + (set! pos (1- pos)))) + (if (eq? glyph-name '()) + (begin (ly:grob-suicide! grob) + (set! glyph-name ""))) + glyph-name)) (define-public (ly:span-bar::width grob) + "Compute the width of the SpanBar stencil." (let ((width (cons 0 0))) - (if (grob::is-live? grob) - (let* ((glyph (ly:grob-property grob 'glyph-name)) - (stencil (bar-line::compound-bar-line grob glyph (cons -1 1) #f))) + (if (grob::is-live? grob) + (let* ((glyph-name (ly:grob-property grob 'glyph-name)) + (stencil (span-bar::compound-bar-line grob + glyph-name + dummy-extent))) - (set! width (ly:stencil-extent stencil X)))) - width)) + (set! width (ly:stencil-extent stencil X)))) + width)) (define-public (ly:span-bar::before-line-breaking grob) + "A dummy callback that kills the Grob @var{grob} if it contains +no elements." (let ((elts (ly:grob-object grob 'elements))) - (if (zero? (ly:grob-array-length elts)) - (ly:grob-suicide! grob)))) + (if (zero? (ly:grob-array-length elts)) + (ly:grob-suicide! grob)))) + +(define-public (span-bar::compound-bar-line grob bar-glyph extent) + "Build the stencil of the span bar." + (let* ((line-thickness (layout-line-thickness grob)) + (kern (* (ly:grob-property grob 'kern 1) line-thickness)) + (bar-glyph-list (string->string-list + (strip-string-annotation bar-glyph))) + (span-glyph (assoc-get bar-glyph span-bar-glyph-alist 'undefined)) + (stencil empty-stencil)) + + (if (string? span-glyph) + (let ((span-glyph-list (string->string-list span-glyph)) + (is-first-stencil #t)) + + (for-each (lambda (bar span) + ;; the stencil stack routine is similar to the one + ;; used in bar-line::compound-bar-line, but here, + ;; leading replacement-chars are discarded. + (if (not (and (string=? span (string replacement-char)) + is-first-stencil)) + (begin + (set! stencil + (ly:stencil-combine-at-edge + stencil + X + RIGHT + ;; if the current glyph is the replacement-char, + ;; we take the corresponding glyph from the + ;; bar-glyph-list and insert an empty stencil + ;; with the appropriate width. + ;; (this method would fail if the bar-glyph-list + ;; were shorter than the span-glyph-list, + ;; but this makes hardly any sense from a + ;; typographical point of view + (if (string=? span (string replacement-char)) + ((make-spacer-bar-line bar) grob extent) + (glyph->stencil span grob extent)) + (if is-first-stencil 0 kern))) + (set! is-first-stencil #f)))) + bar-glyph-list span-glyph-list)) + ;; if span-glyph is not a string, it may be #f or 'undefined; + ;; the latter signals that the span bar for the current bar-glyph + ;; is undefined, so we raise a warning. + (if (eq? span-glyph 'undefined) + (ly:warning + (_ "No span bar glyph defined for bar glyph '~a'; ignoring.") + bar-glyph))) + stencil)) ;; The method used in the following routine depends on bar_engraver ;; not being removed from staff context. If bar_engraver is removed, ;; the size of the staff lines is evaluated as 0, which results in a ;; solid span bar line with faulty y coordinate. ;; -;; This routine was originally by Juergen Reuter, but it was a on the +;; This routine was originally by Juergen Reuter, but it was on the ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl. (define-public (ly:span-bar::print grob) + "The print routine for span bars." (let* ((elts-array (ly:grob-object grob 'elements)) (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) (elts (reverse (sort (ly:grob-array->list elts-array) @@ -650,69 +824,272 @@ ;; Elements must be ordered according to their y coordinates ;; relative to their common axis group parent. ;; Otherwise, the computation goes mad. - (glyph (ly:grob-property grob 'glyph-name)) + (bar-glyph (ly:grob-property grob 'glyph-name)) (span-bar empty-stencil)) - (if (string? glyph) - (let* ((extents '()) - (make-span-bars '()) - (model-bar #f)) - - ;; we compute the extents of each system and store them - ;; in a list; dito for the 'allow-span-bar property. - ;; model-bar takes the bar grob, if given. - (map (lambda (bar) - (let* ((ext (bar-line::bar-y-extent bar refp)) - (staff-symbol (ly:grob-object bar 'staff-symbol))) - - (if (ly:grob? staff-symbol) - (let ((refp-extent (ly:grob-extent staff-symbol refp Y))) - - (set! ext (interval-union ext refp-extent)) - - (if (> (interval-length ext) 0) - (begin - (set! extents (append extents (list ext))) - (set! model-bar bar) - (set! make-span-bars - (append make-span-bars - (list (ly:grob-property bar 'allow-span-bar #t)))))))))) - elts) - ;; if there is no bar grob, we use the callback argument - (if (not model-bar) - (set! model-bar grob)) - ;; we discard the first entry in make-span-bars, because its corresponding - ;; bar line is the uppermost and therefore not connected to another bar line - (if (pair? make-span-bars) - (set! make-span-bars (cdr make-span-bars))) - ;; the span bar reaches from the lower end of the upper staff - ;; to the upper end of the lower staff - when allow-span-bar is #t - (reduce (lambda (curr prev) - (let ((l (cons 0 0)) - (allow-span-bar (car make-span-bars))) - - (set! make-span-bars (cdr make-span-bars)) - (if (> (interval-length prev) 0) - (begin - (set! l (cons (cdr prev) (car curr))) - (if (or (zero? (interval-length l)) - (not allow-span-bar)) - (begin - ;; there is overlap between the bar lines - ;; or 'allow-span-bar = #f. - ;; Do nothing. - ) - (set! span-bar - (ly:stencil-add span-bar - (bar-line::compound-bar-line - model-bar - glyph - l - #f)))))) - curr)) - "" extents) - (set! span-bar (ly:stencil-translate-axis - span-bar - (- (ly:grob-relative-coordinate grob refp Y)) - Y)))) - span-bar)) + (if (string? bar-glyph) + (let ((extents '()) + (make-span-bars '()) + (model-bar #f)) + + ;; we compute the extents of each system and store them + ;; in a list; dito for the 'allow-span-bar property. + ;; model-bar takes the bar grob, if given. + (for-each (lambda (bar) + (let ((ext (bar-line::bar-y-extent bar refp)) + (staff-symbol (ly:grob-object bar 'staff-symbol))) + + (if (ly:grob? staff-symbol) + (let ((refp-extent (ly:grob-extent staff-symbol refp Y))) + + (set! ext (interval-union ext refp-extent)) + + (if (> (interval-length ext) 0) + (begin + (set! extents (append extents (list ext))) + (set! model-bar bar) + (set! make-span-bars + (append make-span-bars + (list (ly:grob-property + bar + 'allow-span-bar + #t)))))))))) + elts) + ;; if there is no bar grob, we use the callback argument + (if (not model-bar) + (set! model-bar grob)) + ;; we discard the first entry in make-span-bars, + ;; because its corresponding bar line is the + ;; uppermost and therefore not connected to + ;; another bar line + (if (pair? make-span-bars) + (set! make-span-bars (cdr make-span-bars))) + ;; the span bar reaches from the lower end of the upper staff + ;; to the upper end of the lower staff - when allow-span-bar is #t + (reduce (lambda (curr prev) + (let ((span-extent (cons 0 0)) + (allow-span-bar (car make-span-bars))) + + (set! make-span-bars (cdr make-span-bars)) + (if (> (interval-length prev) 0) + (begin + (set! span-extent (cons (cdr prev) + (car curr))) + ;; draw the span bar only when the staff lines + ;; don't overlap and allow-span-bar is #t: + (and (> (interval-length span-extent) 0) + allow-span-bar + (set! span-bar + (ly:stencil-add + span-bar + (span-bar::compound-bar-line + model-bar + bar-glyph + span-extent)))))) + curr)) + "" extents) + (set! span-bar (ly:stencil-translate-axis + span-bar + (- (ly:grob-relative-coordinate grob refp Y)) + Y)))) + span-bar)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; volta bracket functions + +(define-public (allow-volta-hook bar-glyph) + "Allow the volta bracket hook being drawn over bar line @var{bar-glyph}." + (if (string? bar-glyph) + (set! volta-bracket-allow-volta-hook-list + (append volta-bracket-allow-volta-hook-list + (list bar-glyph))) + (ly:warning (_ ("Volta hook bar line must be a string; ignoring '~a'.") + bar-glyph)))) + +(define-session volta-bracket-allow-volta-hook-list '()) + +(define-public (volta-bracket::calc-hook-visibility bar-glyph) + "Determine the visibility of the volta bracket hook. It is called in +@code{lily/volta-bracket.cc} and returns @code{#t} if @emph{no} hook +should be drawn." + (not (member bar-glyph volta-bracket-allow-volta-hook-list))) + +(define-public (ly:volta-bracket::calc-shorten-pair grob) + "Calculate the @code{shorten-pair} values for an ideal placement +of the volta brackets relative to the bar lines." + (let* ((line-thickness (layout-line-thickness grob)) + (volta-half-line-thickness (* (ly:grob-property grob 'thickness 1.6) + line-thickness + 1/2)) + (bar-array (ly:grob-object grob 'bars)) + ;; the bar-array starts with the uppermost bar line grob that is + ;; covered by the left edge of the volta bracket; more (span) + ;; bar line grobs from other staves may follow + (left-bar-line (and (ly:grob-array? bar-array) + (positive? (ly:grob-array-length bar-array)) + (ly:grob-array-ref bar-array 0))) + ;; we need the vertical-axis-group-index of the left-bar-line + ;; to find the corresponding right-bar-line + (vag-index (and left-bar-line + (ly:grob-get-vertical-axis-group-index left-bar-line))) + ;; the bar line corresponding to the right edge of the volta bracket + ;; is the last entry with the same vag-index, so we transform the array to a list, + ;; reverse it and search for the first suitable entry from + ;; the back + (right-bar-line (and left-bar-line + (find (lambda (e) + (eqv? (ly:grob-get-vertical-axis-group-index e) + vag-index)) + (reverse (ly:grob-array->list bar-array))))) + ;; the left-bar-line may be a #', + ;; so we add "" as a fallback return value + (left-bar-glyph-name (if left-bar-line + (ly:grob-property left-bar-line 'glyph-name "") + (string annotation-char))) + (right-bar-glyph-name (if right-bar-line + (ly:grob-property right-bar-line 'glyph-name "") + (string annotation-char))) + ;; This is the original logic. It flags left-bar-broken if + ;; there is no left-bar-line. That seems strange. + (left-bar-broken (not (and left-bar-line + (zero? (ly:item-break-dir left-bar-line))))) + (right-bar-broken (not (and right-bar-line + (zero? (ly:item-break-dir + right-bar-line))))) + ;; Revert to current grob for getting layout info if no + ;; left-bar-line available + (left-span-stencil-extent (ly:stencil-extent + (span-bar::compound-bar-line + (or left-bar-line grob) + left-bar-glyph-name + dummy-extent) + X)) + (right-span-stencil-extent (ly:stencil-extent + (span-bar::compound-bar-line + (or right-bar-line grob) + right-bar-glyph-name + dummy-extent) + X)) + (left-shorten 0.0) + (right-shorten 0.0)) + + ;; since "empty" intervals may look like (1.0 . -1.0), we use the + ;; min/max functions to make sure that the placement is not corrupted + ;; in case of empty bar lines + (set! left-shorten + (if left-bar-broken + (- (max 0 (interval-end left-span-stencil-extent)) + (max 0 (interval-end (ly:stencil-extent + (bar-line::compound-bar-line + (or left-bar-line grob) + left-bar-glyph-name + dummy-extent) + X))) + volta-half-line-thickness) + (- (max 0 (interval-end left-span-stencil-extent)) + volta-half-line-thickness))) + + (set! right-shorten + (if right-bar-broken + (+ (- (max 0 (interval-end right-span-stencil-extent))) + volta-half-line-thickness) + (- (min 0 (interval-start right-span-stencil-extent)) + volta-half-line-thickness))) + + (cons left-shorten right-shorten))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; predefined bar glyph print procedures + +(add-bar-glyph-print-procedure "" make-empty-bar-line) +(add-bar-glyph-print-procedure "|" make-simple-bar-line) +(add-bar-glyph-print-procedure "." make-thick-bar-line) +(add-bar-glyph-print-procedure "!" make-dashed-bar-line) +(add-bar-glyph-print-procedure "'" make-tick-bar-line) +(add-bar-glyph-print-procedure ":" make-colon-bar-line) +(add-bar-glyph-print-procedure ";" make-dotted-bar-line) +(add-bar-glyph-print-procedure "k" make-kievan-bar-line) +(add-bar-glyph-print-procedure "S" (make-segno-bar-line #t)) +(add-bar-glyph-print-procedure "=" (make-segno-bar-line #f)) +(add-bar-glyph-print-procedure "[" (make-bracket-bar-line LEFT)) +(add-bar-glyph-print-procedure "]" (make-bracket-bar-line RIGHT)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; predefined bar lines +;; +;; definition of bar lines goes as follows: +;; +;; (define-bar-line "normal bar[-annotation]" "end of line" "start of line" "span bar") +;; +;; each entry has to be a string or #f. +;; The empty string "" is allowed and yields in an invisible bar line, +;; whereas #f reads 'no stencil'. +;; +;; Convention: if two bar lines would be identical in their +;; unbroken bar glyph, we use annotations to make them distinct; +;; as a general rule of thumb the main difference in their +;; behavior at the end of a line is used as annotation, cf. +;; +;; (define-bar-line ".|:" "|" ".|:" ".|") +;; (define-bar-line ".|:-||" "||" ".|:" ".|") +;; +;; or +;; +;; (define-bar-line "S-|" "|" "S" "=") +;; (define-bar-line "S-S" "S" "" "=") + +;; common bar lines +(define-bar-line "" "" "" #f) +(define-bar-line "-" #f #f #f) +(define-bar-line "|" "|" #f "|") +(define-bar-line "|-s" #f "|" "|") +(define-bar-line "." "." #f ".") +(define-bar-line ".|" "|" ".|" ".|") +(define-bar-line "|." "|." #f "|.") +(define-bar-line "||" "||" #f "||") +(define-bar-line ".." ".." #f "..") +(define-bar-line "|.|" "|.|" #f "|.|") +(define-bar-line "!" "!" #f "!") +(define-bar-line ";" ";" #f ";") +(define-bar-line "'" "'" #f #f) + +;; repeats +(define-bar-line ":|.:" ":|." ".|:" " |.") +(define-bar-line ":..:" ":|." ".|:" " ..") +(define-bar-line ":|.|:" ":|." ".|:" " |.|") +(define-bar-line ":.|.:" ":|." ".|:" " .|.") +(define-bar-line ":|." ":|." #f " |.") +(define-bar-line ".|:" "|" ".|:" ".|") +(define-bar-line "[|:" "|" "[|:" " |") +(define-bar-line ":|]" ":|]" #f " | ") +(define-bar-line ":|][|:" ":|]" "[|:" " | |") +(define-bar-line ".|:-||" "||" ".|:" ".|") + +;; segno bar lines +(define-bar-line "S" "||" "S" "=") +(define-bar-line "S-|" "|" "S" "=") +(define-bar-line "S-S" "S" #f "=") +(define-bar-line ":|.S" ":|." "S" " |.") +(define-bar-line ":|.S-S" ":|.S" "" " |.") +(define-bar-line "S.|:" "|" "S.|:" " .|") +(define-bar-line "S.|:-S" "S" ".|:" " .|") +(define-bar-line ":|.S.|:" ":|." "S.|:" " |. .|") +(define-bar-line ":|.S.|:-S" ":|.S" ".|:" " |. .|") + +;; ancient bar lines +(define-bar-line "k" "k" #f #f) ;; kievan style + +;; volta hook settings +(allow-volta-hook ":|.") +(allow-volta-hook ".|:") +(allow-volta-hook "|.") +(allow-volta-hook ":..:") +(allow-volta-hook ":|.|:") +(allow-volta-hook ":|.:") +(allow-volta-hook ".|") +(allow-volta-hook ":|.S") +(allow-volta-hook ":|.S-S") +(allow-volta-hook ":|.S.|:") +(allow-volta-hook ":|.S.|:-S") +(allow-volta-hook ":|]") +(allow-volta-hook ":|][|:")