X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fbar-line.scm;h=02c80f64e535810ede4a6a7d7cc5df8f01ea1154;hb=47db9a3883d726ca53e2133a3b2298f78dd6a32e;hp=809a08ca4888d3d63878ebdf85a0b0cbb41b54a6;hpb=44dd3acc534e7a534f846810b481c3f603eaa92e;p=lilypond.git diff --git a/scm/bar-line.scm b/scm/bar-line.scm index 809a08ca48..02c80f64e5 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 @@ -88,10 +88,10 @@ Pad the string with @code{annotation-char}s to the length of the (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))) + (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))) @@ -135,14 +135,14 @@ mandatory to the procedures stored in @code{bar-glyph-print-procedures}." (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 ""))) +@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 @@ -179,41 +179,41 @@ annotation char from string @var{str}." (last-pos (1- (length sorted-elts))) (idx 0)) - (map (lambda (g) - (ly:grob-set-property! - g - 'has-span-bar - (cons (if (eq? idx last-pos) - #f - grob) - (if (zero? idx) - #f - grob))) - (set! idx (1+ idx))) - sorted-elts))) + (for-each (lambda (g) + (ly:grob-set-property! + g + 'has-span-bar + (cons (if (eq? idx last-pos) + #f + grob) + (if (zero? idx) + #f + grob))) + (set! idx (1+ idx))) + sorted-elts))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Line break decisions. (define-public (define-bar-line bar-glyph eol-glyph bol-glyph span-glyph) - "Define a bar glyph @var{bar-glyph} and its substitute at the end of a line -(@var{eol-glyph}), at the beginning of a new line (@var{bol-glyph}) + "Define a bar glyph @var{bar-glyph} and its substitute at the end of +a line (@var{eol-glyph}), at the beginning of a new line (@var{bol-glyph}) and as a span bar (@var{span-glyph}) respectively." ;; the last argument may not include annotations (check-for-annotation span-glyph) ;; only the last argument may call for replacements (for-each (lambda (s) - (check-for-replacement s)) + (check-for-replacement s)) (list bar-glyph eol-glyph bol-glyph)) ;; the bar-glyph-alist has entries like ;; (bar-glyph . ( eol-glyph . bol-glyph)) (set! bar-glyph-alist - (acons bar-glyph (cons eol-glyph bol-glyph) bar-glyph-alist)) + (acons bar-glyph (cons eol-glyph bol-glyph) bar-glyph-alist)) ;; the span-bar-glyph-alist has entries like ;; (bar-glyph . span-glyph) (set! span-bar-glyph-alist - (acons bar-glyph span-glyph span-bar-glyph-alist))) + (acons bar-glyph span-glyph span-bar-glyph-alist))) (define-session bar-glyph-alist '()) @@ -400,21 +400,21 @@ is not used within the routine." (half-thick (/ line-thickness 2.0)) (stencil empty-stencil)) - (map (lambda (i) - (let ((top-y (min (* (+ i dash-size) half-space) - (+ (* (1- line-count) half-space) - half-thick))) - (bot-y (max (* (- i dash-size) half-space) - (- 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))) + (for-each (lambda (i) + (let ((top-y (min (* (+ i dash-size) half-space) + (+ (* (1- line-count) half-space) + half-thick))) + (bot-y (max (* (- i dash-size) half-space) + (- 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)) @@ -440,14 +440,14 @@ is not used within the routine." 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)) - (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) + (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 - thinkern)) + segno-kern)) (segno (ly:font-get-glyph (ly:grob-default-font grob) "scripts.varsegno")) (stencil (ly:stencil-add @@ -459,7 +459,7 @@ draws the span bar variant, i.e. without the segno sign." (cons 0 0))) (ly:stencil-translate-axis double-line-stil - (* 1/2 thinkern) + (* 1/2 segno-kern) X)))) stencil)) @@ -801,7 +801,7 @@ no elements." ;; 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." @@ -823,26 +823,26 @@ no elements." ;; 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) + (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)) @@ -910,50 +910,51 @@ of the volta brackets relative to the bar lines." line-thickness 1/2)) (bar-array (ly:grob-object grob 'bars)) - (bar-array-length (ly:grob-array-length bar-array)) ;; 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 (if (> bar-array-length 0) - (ly:grob-array-ref bar-array 0) - '())) + (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 (if (null? left-bar-line) - -1 - (ly:grob-get-vertical-axis-group-index left-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 suitable entries: - (filtered-grobs (filter (lambda (e) - (eq? (ly:grob-get-vertical-axis-group-index e) - vag-index)) - (reverse (ly:grob-array->list bar-array)))) - ;; we need the first one (if any) - (right-bar-line (if (pair? filtered-grobs) - (car filtered-grobs) - '())) + ;; 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 (null? left-bar-line) - (string annotation-char) - (ly:grob-property left-bar-line 'glyph-name ""))) - (right-bar-glyph-name (if (null? right-bar-line) - (string annotation-char) - (ly:grob-property right-bar-line 'glyph-name ""))) - (left-bar-broken (or (null? left-bar-line) - (not (zero? (ly:item-break-dir left-bar-line))))) - (right-bar-broken (or (null? right-bar-line) - (not (zero? (ly:item-break-dir right-bar-line))))) + (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 - left-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 - right-bar-line + (or right-bar-line grob) right-bar-glyph-name dummy-extent) X)) @@ -968,7 +969,7 @@ of the volta brackets relative to the bar lines." (- (max 0 (interval-end left-span-stencil-extent)) (max 0 (interval-end (ly:stencil-extent (bar-line::compound-bar-line - left-bar-line + (or left-bar-line grob) left-bar-glyph-name dummy-extent) X))) @@ -1048,7 +1049,7 @@ of the volta brackets relative to the bar lines." (define-bar-line ":|." ":|." #f " |.") (define-bar-line ".|:" "|" ".|:" ".|") (define-bar-line "[|:" "|" "[|:" " |") -(define-bar-line ":|]" ":|]" #f " |") +(define-bar-line ":|]" ":|]" #f " | ") (define-bar-line ":|][|:" ":|]" "[|:" " | |") (define-bar-line ".|:-||" "||" ".|:" ".|")