LEFT | RIGHT |
1 ;;;; This file is part of LilyPond, the GNU music typesetter. | 1 ;;;; This file is part of LilyPond, the GNU music typesetter. |
2 ;;;; | 2 ;;;; |
3 ;;;; Copyright (C) 2009--2012 Marc Hohl <marc@hohlart.de> | 3 ;;;; Copyright (C) 2009--2012 Marc Hohl <marc@hohlart.de> |
4 ;;;; | 4 ;;;; |
5 ;;;; LilyPond is free software: you can redistribute it and/or modify | 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 | 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 | 7 ;;;; the Free Software Foundation, either version 3 of the License, or |
8 ;;;; (at your option) any later version. | 8 ;;;; (at your option) any later version. |
9 ;;;; | 9 ;;;; |
10 ;;;; LilyPond is distributed in the hope that it will be useful, | 10 ;;;; LilyPond is distributed in the hope that it will be useful, |
11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | 11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
13 ;;;; GNU General Public License for more details. | 13 ;;;; GNU General Public License for more details. |
14 ;;;; | 14 ;;;; |
15 ;;;; You should have received a copy of the GNU General Public License | 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/>. | 16 ;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>. |
17 | 17 |
18 ;; helper functions | 18 ;; helper functions |
19 | 19 |
20 (define (get-staff-symbol grob) | 20 (define (get-staff-symbol grob) |
21 (if (grob::has-interface grob 'staff-symbol-interface) | 21 (if (grob::has-interface grob 'staff-symbol-interface) |
22 grob | 22 grob |
23 (ly:grob-object grob 'staff-symbol))) | 23 (ly:grob-object grob 'staff-symbol))) |
24 | 24 |
| 25 (define (layout-blot-diameter grob) |
| 26 (let* ((layout (ly:grob-layout grob)) |
| 27 (blot (ly:output-def-lookup layout 'blot-diameter))) |
| 28 |
| 29 blot)) |
| 30 |
| 31 (define (layout-line-thickness grob) |
| 32 (let* ((layout (ly:grob-layout grob)) |
| 33 (line-thickness (ly:output-def-lookup layout 'line-thickness))) |
| 34 |
| 35 line-thickness)) |
| 36 |
25 (define (staff-symbol-line-count grob) | 37 (define (staff-symbol-line-count grob) |
26 (let ((line-count 0)) | 38 (let ((line-count 0)) |
27 | 39 |
28 (if (ly:grob? grob) | 40 (if (ly:grob? grob) |
29 (let ((line-pos (ly:grob-property grob 'line-positions '()))) | 41 (let ((line-pos (ly:grob-property grob 'line-positions '()))) |
30 | 42 |
31 (set! line-count (if (pair? line-pos) | 43 (set! line-count (if (pair? line-pos) |
32 (length line-pos) | 44 (length line-pos) |
33 (ly:grob-property grob 'line-count 0))))) | 45 (ly:grob-property grob 'line-count 0))))) |
34 | 46 |
35 line-count)) | 47 line-count)) |
36 | |
37 | 48 |
38 (define (staff-symbol-line-span grob) | 49 (define (staff-symbol-line-span grob) |
39 (let ((line-pos (ly:grob-property grob 'line-positions '())) | 50 (let ((line-pos (ly:grob-property grob 'line-positions '())) |
40 (iv (cons 0.0 0.0))) | 51 (iv (cons 0.0 0.0))) |
41 | 52 |
42 (if (pair? line-pos) | 53 (if (pair? line-pos) |
43 (map (lambda (x) | 54 (map (lambda (x) |
44 (set! iv (cons (min (car iv) x) | 55 (set! iv (cons (min (car iv) x) |
45 (max (cdr iv) x)))) | 56 (max (cdr iv) x)))) |
46 line-pos) | 57 line-pos) |
47 (let ((line-count (ly:grob-property grob 'line-count 0))) | 58 (let ((line-count (ly:grob-property grob 'line-count 0))) |
48 | 59 |
49 (set! iv (cons (- 1 line-count) | 60 (set! iv (cons (- 1 line-count) |
50 (- line-count 1))))) | 61 (- line-count 1))))) |
51 iv)) | 62 iv)) |
52 | 63 |
53 (define (staff-symbol-line-positions grob) | 64 (define (staff-symbol-line-positions grob) |
54 (let ((line-pos (ly:grob-property grob 'line-positions '()))) | 65 (let ((line-pos (ly:grob-property grob 'line-positions '()))) |
55 | 66 |
56 (if (not (pair? line-pos)) | 67 (if (not (pair? line-pos)) |
57 (let* ((line-count (ly:grob-property grob 'line-count 0)) | 68 (let* ((line-count (ly:grob-property grob 'line-count 0)) |
58 (height (- line-count 1.0))) | 69 (height (- line-count 1.0))) |
59 | 70 |
60 (set! line-pos (map (lambda (x) | 71 (set! line-pos (map (lambda (x) |
61 (- height (* x 2))) | 72 (- height (* x 2))) |
62 (iota line-count))))) | 73 (iota line-count))))) |
63 line-pos)) | 74 line-pos)) |
64 | 75 |
65 | 76 ;; functions used by external routines |
66 ;; How should a bar line behave at a break? | 77 |
| 78 (define-public (span-bar::notify-grobs-of-my-existence grob) |
| 79 (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements))) |
| 80 (sorted-elts (sort elts ly:grob-vertical<?)) |
| 81 (last-pos (1- (length sorted-elts))) |
| 82 (idx 0)) |
| 83 |
| 84 (map (lambda (g) |
| 85 (ly:grob-set-property! |
| 86 g |
| 87 'has-span-bar |
| 88 (cons (if (eq? idx last-pos) |
| 89 #f |
| 90 grob) |
| 91 (if (zero? idx) |
| 92 #f |
| 93 grob))) |
| 94 (set! idx (1+ idx))) |
| 95 sorted-elts))) |
| 96 |
| 97 ;; How should a bar line behave at a break? |
67 ;; the following alist has the form | 98 ;; the following alist has the form |
68 ;; ( unbroken-bar-glyph . ( bar-glyph-at-end-of-line . bar-glyph-at-begin-of-lin
e )) | 99 ;; ( unbroken-bar-glyph . ( bar-glyph-at-end-of-line . bar-glyph-at-begin-of-lin
e )) |
69 | 100 |
70 (define bar-glyph-alist | 101 (define bar-glyph-alist |
71 '((":|:" . (":|" . "|:")) | 102 '((":|:" . (":|" . "|:")) |
72 (":|.|:" . (":|" . "|:")) | 103 (":|.|:" . (":|" . "|:")) |
73 (":|.:" . (":|" . "|:")) | 104 (":|.:" . (":|" . "|:")) |
74 ("||:" . ("||" . "|:")) | 105 ("||:" . ("||" . "|:")) |
75 ("dashed" . ("dashed" . '())) | 106 ("dashed" . ("dashed" . '())) |
76 ("|" . ("|" . ())) | 107 ("|" . ("|" . ())) |
(...skipping 25 matching lines...) Expand all Loading... |
102 (".S|:" . ("|" . "S|:")) | 133 (".S|:" . ("|" . "S|:")) |
103 (":|S|:" . (":|" . "S|:")) | 134 (":|S|:" . (":|" . "S|:")) |
104 (":|S.|:" . (":|S" . "|:")) | 135 (":|S.|:" . (":|S" . "|:")) |
105 | 136 |
106 ;; ancient bar lines | 137 ;; ancient bar lines |
107 ("kievan" . ("kievan" . "")))) | 138 ("kievan" . ("kievan" . "")))) |
108 | 139 |
109 ;; drawing functions for various bar line types | 140 ;; drawing functions for various bar line types |
110 | 141 |
111 (define (make-empty-bar-line grob extent) | 142 (define (make-empty-bar-line grob extent) |
112 (ly:make-stencil "" extent (cons 0 0))) | 143 (ly:make-stencil "" (cons 0 0) extent)) |
113 | 144 |
114 (define (make-simple-bar-line grob width extent rounded) | 145 (define (make-simple-bar-line grob width extent rounded) |
115 (let ((blot (if rounded | 146 (let ((blot (if rounded |
116 (ly:output-def-lookup layout 'blot-diameter) | 147 (layout-blot-diameter grob) |
117 0))) | 148 0))) |
118 | 149 |
119 (ly:round-filled-box (cons 0 width) | 150 (ly:round-filled-box (cons 0 width) |
120 extent | 151 extent |
121 blot))) | 152 blot))) |
122 | 153 |
123 (define (make-tick-bar-line grob height rounded) | 154 (define (make-tick-bar-line grob height rounded) |
124 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) | 155 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) |
125 (stafflinethick (ly:staff-symbol-line-thickness grob)) | 156 (staff-line-thickness (ly:staff-symbol-line-thickness grob)) |
126 (blot (if rounded | 157 (blot (if rounded |
127 (ly:output-def-lookup layout 'blot-diameter) | 158 (layout-blot-diameter grob) |
128 0))) | 159 0))) |
129 | 160 |
130 (ly:round-filled-box (cons 0 stafflinethick) | 161 (ly:round-filled-box (cons 0 staff-line-thickness) |
131 (cons (- height half-staff) (+ height half-staff)) | 162 (cons (- height half-staff) (+ height half-staff)) |
132 blot))) | 163 blot))) |
133 | 164 |
134 (define (make-colon-bar-line grob) | 165 (define (make-colon-bar-line grob) |
135 (let* ((staff-space (ly:staff-symbol-staff-space grob)) | 166 (let* ((staff-space (ly:staff-symbol-staff-space grob)) |
136 (line-thickness (ly:staff-symbol-line-thickness grob)) | |
137 (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) | 167 (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) |
| 168 (staff-symbol (get-staff-symbol grob)) |
| 169 (lines (staff-symbol-line-count staff-symbol)) |
138 (stencil empty-stencil) | 170 (stencil empty-stencil) |
139 (center (if (> staff-space 0) | 171 (dist (* (if (or (odd? lines) |
140 (let ((staff-symbol (get-staff-symbol grob))) | 172 (zero? lines)) |
141 | 173 1 |
142 (if (ly:grob? staff-symbol) | 174 (if (< staff-space 2) |
143 (let ((line-pos (staff-symbol-line-positions staff
-symbol))) | 175 2 |
144 | 176 0.5)) |
145 (if (pair? line-pos) | 177 staff-space))) |
146 (interval-center (staff-symbol-line-span
staff-symbol)) | |
147 0.0)) | |
148 0.0)) | |
149 0.0)) | |
150 (dist (if (> staff-space 0) | |
151 (let ((staff-symbol (get-staff-symbol grob))) | |
152 | |
153 (if (ly:grob? staff-symbol) | |
154 (let ((line-pos (staff-symbol-line-positions staff-s
ymbol))) | |
155 | |
156 (if (pair? line-pos) | |
157 ;; fold the staff into two at center and find
the | |
158 ;; first gap big enough to hold a dot and some
space | |
159 ;; below and above | |
160 (let* ((half-staff | |
161 (sort (append (map (lambda (lp) | |
162 (abs (- lp
center))) | |
163 line-pos) | |
164 '(0.0)) <)) | |
165 ;; gap is measured like line-positions; | |
166 ;; 1.0 for dot diameter, twice the staff
line width | |
167 ;; for the gap above and below and one m
ore for the | |
168 ;; two half staff lines | |
169 (gap-to-find (/ (+ 1.0 (* 3 line-thickne
ss)) | |
170 staff-space)) | |
171 (dist (+ (* 2 (car (reverse half-staff))
) | |
172 gap-to-find)) | |
173 (found #f)) | |
174 | |
175 (reduce (lambda (x y) (if (and (> (- x y)
gap-to-find) | |
176 (not found
)) | |
177 (begin | |
178 (set! found #
t) | |
179 (set! dist (+
x y)))) | |
180 x) | |
181 "" | |
182 half-staff) | |
183 dist) | |
184 ;; if line-pos is empty, return dist = 1.0 | |
185 1.0)) | |
186 ;; if there is no staff-symbol grob, return dist = 1
.0 | |
187 1.0)) | |
188 ;; if staff-space = 0, we assume that staff-space = 1.0 | |
189 ;; and calculate dist according to gap mentioned above | |
190 (+ 1.0 (* 3 line-thickness))))) | |
191 | 178 |
192 (if (zero? staff-space) | 179 (if (zero? staff-space) |
193 (set! staff-space 1.0)) | 180 (set! staff-space 1.0)) |
194 | 181 |
195 (let* ((stencil empty-stencil) | 182 (let* ((stencil (ly:stencil-add stencil dot)) |
| 183 (stencil (ly:stencil-translate-axis |
| 184 stencil dist Y)) |
196 (stencil (ly:stencil-add stencil dot)) | 185 (stencil (ly:stencil-add stencil dot)) |
197 (stencil (ly:stencil-translate-axis | 186 (stencil (ly:stencil-translate-axis |
198 stencil (* dist (/ staff-space 2)) Y)) | 187 stencil (/ dist -2) Y))) |
199 (stencil (ly:stencil-add stencil dot)) | |
200 (stencil (ly:stencil-translate-axis | |
201 stencil (* (- center (/ dist 2)) | |
202 (/ staff-space 2)) Y))) | |
203 stencil))) | 188 stencil))) |
204 | 189 |
205 (define (make-dotted-bar-line grob extent) | 190 (define (make-dotted-bar-line grob extent) |
206 (let* ((position (round (* (interval-end extent) 2))) | 191 (let* ((position (round (* (interval-end extent) 2))) |
207 (correction (if (even? position) 0.5 0.0)) | 192 (correction (if (even? position) 0.5 0.0)) |
208 (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) | 193 (dot (ly:font-get-glyph (ly:grob-default-font grob) "dots.dot")) |
209 (init (round (+ (interval-start extent) | 194 (i (round (+ (interval-start extent) |
210 (- 0.5 correction)))) | 195 (- 0.5 correction)))) |
211 (e (round (+ (interval-end extent) | 196 (e (round (+ (interval-end extent) |
212 (- 0.5 correction)))) | 197 (- 0.5 correction)))) |
213 (counting (interval-length (cons init e))) | 198 (counting (interval-length (cons i e))) |
214 (stil-list (map | 199 (stil-list (map |
215 (lambda (x) | 200 (lambda (x) |
216 (ly:stencil-translate-axis | 201 (ly:stencil-translate-axis |
217 dot (+ x correction) Y)) | 202 dot (+ x correction) Y)) |
218 (iota counting init 1)))) | 203 (iota counting i 1)))) |
219 | 204 |
220 (define (add-stencils! stil l) | 205 (define (add-stencils! stil l) |
221 (if (null? l) | 206 (if (null? l) |
222 stil | 207 stil |
223 (if (null? (cdr l)) | 208 (if (null? (cdr l)) |
224 (ly:stencil-add stil (car l)) | 209 (ly:stencil-add stil (car l)) |
225 (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) | 210 (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) |
226 | 211 |
227 (add-stencils! empty-stencil stil-list))) | 212 (add-stencils! empty-stencil stil-list))) |
228 | 213 |
229 (define (make-dashed-bar-line grob extent thickness) | 214 (define (make-dashed-bar-line grob extent thickness) |
230 (let* ((height (interval-length extent)) | 215 (let* ((height (interval-length extent)) |
231 (staff-symbol (ly:grob-object grob 'staff-symbol)) | 216 (staff-symbol (get-staff-symbol grob)) |
232 (staff-space (ly:staff-symbol-staff-space grob)) | 217 (staff-space (ly:staff-symbol-staff-space grob)) |
233 (line-thickness (ly:staff-symbol-line-thickness grob)) | 218 (line-thickness (layout-line-thickness grob)) |
234 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) | 219 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) |
235 (line-count (if (ly:grob? staff-symbol) | 220 (line-count (staff-symbol-line-count staff-symbol))) |
236 (ly:grob-property staff-symbol 'line-count) | |
237 0))) | |
238 | 221 |
239 (if (< (abs (+ line-thickness | 222 (if (< (abs (+ line-thickness |
240 (* (1- line-count) staff-space) | 223 (* (1- line-count) staff-space) |
241 (- height))) | 224 (- height))) |
242 0.1) | 225 0.1) |
243 (let ((blot (ly:output-def-lookup | 226 (let ((blot (layout-blot-diameter grob)) |
244 (ly:grob-layout grob) 'blot-diameter)) | |
245 (half-space (/ staff-space 2.0)) | 227 (half-space (/ staff-space 2.0)) |
246 (half-thick (/ line-thickness 2.0)) | 228 (half-thick (/ line-thickness 2.0)) |
247 (stencil empty-stencil)) | 229 (stencil empty-stencil)) |
248 | 230 |
249 (map (lambda (i) | 231 (map (lambda (i) |
250 (let ((top-y (min (* (+ i dash-size) half-space) | 232 (let ((top-y (min (* (+ i dash-size) half-space) |
251 (+ (* (1- line-count) half-space) | 233 (+ (* (1- line-count) half-space) |
252 half-thick))) | 234 half-thick))) |
253 (bot-y (max (* (- i dash-size) half-space) | 235 (bot-y (max (* (- i dash-size) half-space) |
254 (- 0 (* (1- line-count) half-space) | 236 (- 0 (* (1- line-count) half-space) |
255 half-thick)))) | 237 half-thick)))) |
256 | 238 |
257 (set! stencil | 239 (set! stencil |
258 (ly:stencil-add | 240 (ly:stencil-add |
259 stencil | 241 stencil |
260 (ly:round-filled-box (cons (/ thickness -2) | 242 (ly:round-filled-box (cons 0 thickness) |
261 (/ thickness 2)) | |
262 (cons bot-y top-y) | 243 (cons bot-y top-y) |
263 blot))))) | 244 blot))))) |
264 (iota line-count (1- line-count) (- 2))) | 245 (iota line-count (1- line-count) (- 2))) |
265 stencil) | 246 stencil) |
266 (let* ((dashes (/ height staff-space)) | 247 (let* ((dashes (/ height staff-space)) |
267 (total-dash-size (/ height dashes)) | 248 (total-dash-size (/ height dashes)) |
268 (factor (/ (- dash-size thickness) staff-space))) | 249 (factor (/ (- dash-size thickness) staff-space))) |
269 | 250 |
270 (ly:stencil-translate-axis | 251 (ly:stencil-translate-axis |
271 (ly:make-stencil (list 'dashed-line | 252 (ly:make-stencil (list 'dashed-line |
272 thickness | 253 thickness |
273 (* factor total-dash-size) | 254 (* factor total-dash-size) |
274 (* (- 1 factor) total-dash-size) | 255 (* (- 1 factor) total-dash-size) |
275 0 | 256 0 |
276 height | 257 height |
277 (* factor total-dash-size 0.5)) | 258 (* factor total-dash-size 0.5)) |
278 (cons 0 0) | 259 (cons 0 thickness) |
279 (cons (/ thickness -2) | 260 (cons 0 height)) |
280 (/ thickness 2))) | |
281 (interval-start extent) | 261 (interval-start extent) |
282 Y))))) | 262 Y))))) |
283 | 263 |
284 (define (make-segno-bar-line grob glyph extent rounded) | 264 (define (make-segno-bar-line grob glyph extent rounded) |
285 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 265 (let* ((line-thickness (layout-line-thickness grob)) |
286 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 266 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
287 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) | 267 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
288 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) | 268 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
289 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) | 269 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
290 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 270 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
291 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 271 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
292 (colon-stil (make-colon-bar-line grob)) | 272 (colon-stil (make-colon-bar-line grob)) |
293 (segno-stil (ly:stencil-add | 273 (segno-stil (ly:stencil-add |
294 (ly:stencil-combine-at-edge | 274 (ly:stencil-combine-at-edge |
295 (ly:stencil-combine-at-edge | 275 (ly:stencil-combine-at-edge |
(...skipping 53 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
349 (stencil (stencil-whiteout | 329 (stencil (stencil-whiteout |
350 (ly:font-get-glyph font "scripts.barline.kievan")))) | 330 (ly:font-get-glyph font "scripts.barline.kievan")))) |
351 | 331 |
352 ;; the kievan bar line has mo staff lines underneath, | 332 ;; the kievan bar line has mo staff lines underneath, |
353 ;; so we whiteout them and move ithe grob to a higher layer | 333 ;; so we whiteout them and move ithe grob to a higher layer |
354 (ly:grob-set-property! grob 'layer 1) | 334 (ly:grob-set-property! grob 'layer 1) |
355 stencil)) | 335 stencil)) |
356 | 336 |
357 ;; bar line callbacks | 337 ;; bar line callbacks |
358 | 338 |
359 (define (bar-line::calc-bar-extent grob) | 339 (define-public (ly:bar-line::calc-bar-extent grob) |
360 (let ((staff-symbol (get-staff-symbol grob)) | 340 (let ((staff-symbol (get-staff-symbol grob)) |
361 (staff-extent (cons 0 0))) | 341 (staff-extent (cons 0 0))) |
362 | 342 |
363 (if (ly:grob? staff-symbol) | 343 (if (ly:grob? staff-symbol) |
364 (let* ((bar-line-color (ly:grob-property grob 'color)) | 344 (let* ((bar-line-color (ly:grob-property grob 'color)) |
365 (staff-color (ly:grob-property staff-symbol 'color)) | 345 (staff-color (ly:grob-property staff-symbol 'color)) |
366 (radius (ly:staff-symbol-staff-radius grob)) | 346 (radius (ly:staff-symbol-staff-radius grob)) |
367 (line-thickness (ly:staff-symbol-line-thickness grob))) | 347 (staff-line-thickness (ly:staff-symbol-line-thickness grob))) |
368 | 348 |
369 ;; Due to rounding problems, bar lines extending to the outermo
st edges | 349 ;; Due to rounding problems, bar lines extending to the outermo
st edges |
370 ;; of the staff lines appear wrongly in on-screen display | 350 ;; of the staff lines appear wrongly in on-screen display |
371 ;; (and, to a lesser extent, in print) - they stick out a pixel
. | 351 ;; (and, to a lesser extent, in print) - they stick out a pixel
. |
372 ;; The solution is to extend bar lines only to the middle | 352 ;; The solution is to extend bar lines only to the middle |
373 ;; of the staff line - unless they have different colors, | 353 ;; of the staff line - unless they have different colors, |
374 ;;when it would be undesirable. | 354 ;;when it would be undesirable. |
375 (set! staff-extent (ly:staff-symbol::height staff-symbol)) | 355 (set! staff-extent (ly:staff-symbol::height staff-symbol)) |
376 (if (and (eq? bar-line-color staff-color) | 356 (if (and (eq? bar-line-color staff-color) |
377 radius) | 357 radius) |
378 (interval-widen staff-extent | 358 (set! staff-extent |
379 (- 1 (* 1/2 (/ line-thickness radius))))))) | 359 (interval-scale staff-extent |
| 360 (- 1 (* 1/2 (/ staff-line-thickness radiu
s)))))))) |
380 staff-extent)) | 361 staff-extent)) |
381 | 362 |
382 (define (bar-line::bar-y-extent grob refpoint) | 363 (define (bar-line::bar-y-extent grob refpoint) |
383 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) | 364 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) |
384 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) | 365 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) |
385 (y-extent (coord-translate extent rel-y))) | 366 (y-extent (coord-translate extent rel-y))) |
386 | 367 |
387 y-extent)) | 368 y-extent)) |
388 | 369 |
389 (define-public (bar-line::print grob) | 370 (define-public (ly:bar-line::print grob) |
390 (let ((glyph (ly:grob-property grob 'glyph-name)) | 371 (let ((glyph (ly:grob-property grob 'glyph-name)) |
391 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) | 372 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) |
392 | 373 |
393 (if (and (not (eq? glyph '())) | 374 (if (and (not (eq? glyph '())) |
394 (> (interval-length extent) 0)) | 375 (> (interval-length extent) 0)) |
395 (bar-line::compound-bar-line grob glyph extent #f) | 376 (bar-line::compound-bar-line grob glyph extent #f) |
396 #f))) | 377 #f))) |
397 | 378 |
398 (define-public (bar-line::compound-bar-line grob glyph extent rounded) | 379 (define-public (bar-line::compound-bar-line grob glyph extent rounded) |
399 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 380 (let* ((line-thickness (layout-line-thickness grob)) |
400 (height (interval-length extent)) | 381 (height (interval-length extent)) |
401 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 382 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
402 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) | 383 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
403 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) | 384 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
404 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) | 385 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
405 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 386 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
406 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 387 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
407 (colon-stil (make-colon-bar-line grob)) | 388 (colon-stil (make-colon-bar-line grob)) |
408 (glyph (cond | 389 (glyph (cond |
| 390 ((not glyph) "") |
409 ((string=? glyph "||:") "|:") | 391 ((string=? glyph "||:") "|:") |
410 ;; bar-line::compound-bar-line is called only if | 392 ;; bar-line::compound-bar-line is called only if |
411 ;; height > 0, but just in case ... | 393 ;; height > 0, but just in case ... |
412 ((and (string=? glyph ":|") | 394 ((and (string=? glyph ":|") |
413 (zero? height)) "|.") | 395 (zero? height)) "|.") |
414 ((and (string=? glyph "|:") | 396 ((and (string=? glyph "|:") |
415 (zero? height)) ".|") | 397 (zero? height)) ".|") |
416 (else glyph))) | 398 (else glyph))) |
417 (stencil (cond | 399 (stencil (cond |
418 ((string=? glyph "|") thin-stil) | 400 ((string=? glyph "|") thin-stil) |
(...skipping 61 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
480 (make-segno-bar-line grob glyph extent rounded)) | 462 (make-segno-bar-line grob glyph extent rounded)) |
481 ((string=? glyph "'") | 463 ((string=? glyph "'") |
482 (make-tick-bar-line grob (interval-end extent) rounded)) | 464 (make-tick-bar-line grob (interval-end extent) rounded)) |
483 ((string=? glyph "dashed") | 465 ((string=? glyph "dashed") |
484 (make-dashed-bar-line grob extent hair)) | 466 (make-dashed-bar-line grob extent hair)) |
485 ((string=? glyph "kievan") | 467 ((string=? glyph "kievan") |
486 (make-kievan-bar-line grob)) | 468 (make-kievan-bar-line grob)) |
487 (else (make-empty-bar-line grob extent))))) | 469 (else (make-empty-bar-line grob extent))))) |
488 stencil)) | 470 stencil)) |
489 | 471 |
490 (define-public (bar-line::calc-anchor grob) | 472 (define-public (ly:bar-line::calc-anchor grob) |
491 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 473 (let* ((line-thickness (layout-line-thickness grob)) |
492 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 474 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
493 (glyph (ly:grob-property grob 'glyph-name "")) | 475 (glyph (ly:grob-property grob 'glyph-name "")) |
494 (x-extent (ly:grob-extent grob grob X)) | 476 (x-extent (ly:grob-extent grob grob X)) |
495 (dot-width (* (+ (interval-length | 477 (dot-width (+ (interval-length |
496 (ly:stencil-extent | 478 (ly:stencil-extent |
497 (ly:font-get-glyph | 479 (ly:font-get-glyph |
498 (ly:grob-default-font grob) | 480 (ly:grob-default-font grob) |
499 "dots.dot") | 481 "dots.dot") |
500 X)) | 482 X)) |
501 kern) | 483 kern)) |
502 line-thickness)) | |
503 (anchor 0.0)) | 484 (anchor 0.0)) |
504 | 485 |
505 (if (> (interval-length x-extent) 0) | 486 (if (> (interval-length x-extent) 0) |
506 (begin | 487 (begin |
507 (set! anchor (interval-center x-extent)) | 488 (set! anchor (interval-center x-extent)) |
508 (cond ((string=? glyph "|:") | 489 (cond ((string=? glyph "|:") |
509 (set! anchor (+ anchor (/ dot-width -2.0)))) | 490 (set! anchor (+ anchor (/ dot-width -2.0)))) |
510 ((string=? glyph ":|") | 491 ((string=? glyph ":|") |
511 (set! anchor (+ anchor (/ dot-width 2.0))))))) | 492 (set! anchor (+ anchor (/ dot-width 2.0))))))) |
512 anchor)) | 493 anchor)) |
(...skipping 35 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
548 (".S|:" . ".|") | 529 (".S|:" . ".|") |
549 (":|S" . "|.") | 530 (":|S" . "|.") |
550 (":|S." . "|.") | 531 (":|S." . "|.") |
551 (":|S|:" . "|._.|") | 532 (":|S|:" . "|._.|") |
552 (":|S.|:" . "|._.|") | 533 (":|S.|:" . "|._.|") |
553 ("kievan" . "") | 534 ("kievan" . "") |
554 ("'" . ""))) | 535 ("'" . ""))) |
555 | 536 |
556 ;; span bar callbacks | 537 ;; span bar callbacks |
557 | 538 |
558 (define-public (span-bar::calc-glyph-name grob) | 539 (define-public (ly:span-bar::calc-glyph-name grob) |
559 (let* ((elts (ly:grob-object grob 'elements)) | 540 (let* ((elts (ly:grob-object grob 'elements)) |
560 (pos (1- (ly:grob-array-length elts))) | 541 (pos (1- (ly:grob-array-length elts))) |
561 (glyph '())) | 542 (glyph '())) |
562 | 543 |
563 (while (and (eq? glyph '()) | 544 (while (and (eq? glyph '()) |
564 (> pos -1)) | 545 (> pos -1)) |
565 (begin (set! glyph (ly:grob-property (ly:grob-array-ref elts pos) | 546 (begin (set! glyph (ly:grob-property (ly:grob-array-ref elts pos) |
566 'glyph-name)) | 547 'glyph-name)) |
567 (set! pos (1- pos)))) | 548 (set! pos (1- pos)))) |
568 (if (eq? glyph '()) | 549 (if (eq? glyph '()) |
569 (begin (ly:grob-suicide! grob) | 550 (begin (ly:grob-suicide! grob) |
570 (set! glyph ""))) | 551 (set! glyph ""))) |
571 (assoc-get glyph span-bar-glyph-alist glyph))) | 552 (assoc-get glyph span-bar-glyph-alist glyph))) |
572 | 553 |
573 (define-public (span-bar::width grob) | 554 (define-public (ly:span-bar::width grob) |
574 (let ((width (cons 0 0))) | 555 (let ((width (cons 0 0))) |
575 | 556 |
576 (if (grob::is-live? grob) | 557 (if (grob::is-live? grob) |
577 (let* ((glyph (ly:grob-property grob 'glyph-name)) | 558 (let* ((glyph (ly:grob-property grob 'glyph-name)) |
578 (stencil (bar-line::compound-bar-line grob glyph (cons -1 1) #
f))) | 559 (stencil (bar-line::compound-bar-line grob glyph (cons -1 1) #
f))) |
579 | 560 |
580 (set! width (ly:stencil-extent stencil X)))) | 561 (set! width (ly:stencil-extent stencil X)))) |
581 width)) | 562 width)) |
582 | 563 |
583 (define-public (span-bar::before-line-breaking grob) | 564 (define-public (ly:span-bar::before-line-breaking grob) |
584 (let ((elts (ly:grob-object grob 'elements))) | 565 (let ((elts (ly:grob-object grob 'elements))) |
585 | 566 |
586 (if (zero? (ly:grob-array-length elts)) | 567 (if (zero? (ly:grob-array-length elts)) |
587 (ly:grob-suicide! grob)))) | 568 (ly:grob-suicide! grob)))) |
588 | 569 |
589 ;; defined in scm/music-functions.scm | 570 ;; The method used in the following routine depends on bar_engraver |
590 (define (vector-extend v x) | 571 ;; not being removed from staff context. If bar_engraver is removed, |
591 "Make a new vector consisting of V, with X added to the end." | 572 ;; the size of the staff lines is evaluated as 0, which results in a |
592 (let* ((n (vector-length v)) | 573 ;; solid span bar line with faulty y coordinate. |
593 (nv (make-vector (+ n 1) '()))) | 574 ;; |
594 (vector-move-left! v 0 n nv 0) | 575 ;; This routine was originally by Juergen Reuter, but it was a on the |
595 (vector-set! nv n x) | 576 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl. |
596 nv)) | 577 (define-public (ly:span-bar::print grob) |
597 | 578 (let* ((elts-array (ly:grob-object grob 'elements)) |
598 (define-public (span-bar::print grob) | 579 (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) |
599 (let* ((elts (ly:grob-object grob 'elements)) | 580 (elts (reverse (sort (ly:grob-array->list elts-array) |
600 (refp (ly:grob-common-refpoint-of-array grob elts Y)) | 581 ly:grob-vertical<?))) |
| 582 ;; Elements must be ordered according to their y coordinates |
| 583 ;; relative to their common axis group parent. |
| 584 ;; Otherwise, the computation goes mad. |
601 (glyph (ly:grob-property grob 'glyph-name)) | 585 (glyph (ly:grob-property grob 'glyph-name)) |
602 (span-bar empty-stencil)) | 586 (span-bar empty-stencil)) |
603 | 587 |
604 ;;Limitations/Bugs: | |
605 ;; | |
606 ;; (1) Elements from 'me->get_object ("elements")' must be | |
607 ;; ordered according to their y coordinates relative to their common | |
608 ;; axis group parent. Otherwise, the computation goes mad. | |
609 ;; | |
610 ;; (2) This method depends on bar_engraver not being removed from | |
611 ;; staff context. If bar_engraver is removed, the size of the staff | |
612 ;; lines is evaluated as 0, which results in a solid span bar line | |
613 ;; with faulty y coordinate. | |
614 ;; | |
615 ;; This routine was originally by Juergen Reuter, but it was a on the | |
616 ;; bulky side. Rewritten by Han-Wen. | |
617 ;; Ported from c++ to Scheme by Marc Hohl. | |
618 (if (string? glyph) | 588 (if (string? glyph) |
619 (let* ((extents (make-vector 0 '())) | 589 (let* ((extents '()) |
620 (make-span-bar (make-vector 0 '())) | 590 (make-span-bars '()) |
621 (model-bar #f) | 591 (model-bar #f)) |
622 (elts-size (ly:grob-array-length elts))) | 592 |
623 | 593 ;; we compute the extents of each system and store them |
624 (map (lambda (i) | 594 ;; in a list; dito for the 'allow-span-bar property. |
625 (let* ((bar (ly:grob-array-ref elts i)) | 595 ;; model-bar takes the bar grob, if given. |
626 (ext (bar-line::bar-y-extent bar refp)) | 596 (map (lambda (bar) |
| 597 (let* ((ext (bar-line::bar-y-extent bar refp)) |
627 (staff-symbol (ly:grob-object bar 'staff-symbol))) | 598 (staff-symbol (ly:grob-object bar 'staff-symbol))) |
628 | 599 |
629 (if (ly:grob? staff-symbol) | 600 (if (ly:grob? staff-symbol) |
630 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) | 601 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) |
631 | 602 |
632 (set! ext (cons (min (car ext) (car refp-e
xtent)) | 603 (set! ext (interval-union ext refp-extent)
) |
633 (max (cdr ext) (cdr refp-e
xtent)))) | |
634 | 604 |
635 (if (> (interval-length ext) 0) | 605 (if (> (interval-length ext) 0) |
636 (begin | 606 (begin |
637 (set! extents (vector-extend extents
ext)) | 607 (set! extents (append extents (list
ext))) |
638 (set! make-span-bar (vector-extend m
ake-span-bar | 608 (set! model-bar bar) |
639 (ly:grob-property bar
'allow-span-bar))) | 609 (set! make-span-bars |
640 (set! model-bar bar))))))) | 610 (append make-span-bars |
641 (iota elts-size (1- elts-size) (- 1))) | 611 (list (ly:grob-property ba
r 'allow-span-bar #t)))))))))) |
642 | 612 elts) |
| 613 ;; if there is no bar grob, we use the callback argument |
643 (if (not model-bar) | 614 (if (not model-bar) |
644 (set! model-bar grob)) | 615 (set! model-bar grob)) |
645 | 616 ;; we discard the first entry in make-span-bars, because its c
orresponding |
646 (map (lambda (i) | 617 ;; bar line is the uppermost and therefore not connected to an
other bar line |
647 (let ((prev-extent (vector-ref extents (1- i))) | 618 (if (pair? make-span-bars) |
648 (curr-extent (vector-ref extents i)) | 619 (set! make-span-bars (cdr make-span-bars))) |
649 (l (cons 0 0))) | 620 ;; the span bar reaches from the lower end of the upper staff |
650 | 621 ;; to the upper end of the lower staff - when allow-span-bar i
s #t |
651 (if (> (interval-length prev-extent) 0) | 622 (reduce (lambda (curr prev) |
652 (begin | 623 (let ((l (cons 0 0)) |
653 (set! l (cons (cdr prev-extent) | 624 (allow-span-bar (car make-span-bars))) |
654 (car curr-extent))) | 625 |
655 (if (or (zero? (interval-length l)) | 626 (set! make-span-bars (cdr make-span-bars)
) |
656 (not (vector-ref make-span-bar i))) | 627 (if (> (interval-length prev) 0) |
657 (begin | 628 (begin |
658 ;; There is overlap between the bar line
s. Do nothing. | 629 (set! l (cons (cdr prev) (car curr)
)) |
659 ) | 630 (if (or (zero? (interval-length l)) |
660 (set! span-bar | 631 (not allow-span-bar)) |
661 (ly:stencil-add | 632 (begin |
662 span-bar | 633 ;; there is overlap between t
he bar lines |
663 (bar-line::compound-bar-line model-bar
glyph l #f)))))))) | 634 ;; or 'allow-span-bar = #f. |
664 (iota (1- (vector-length extents)) 1)) | 635 ;; Do nothing. |
665 | 636 ) |
| 637 (set! span-bar |
| 638 (ly:stencil-add span-bar |
| 639 (bar-line
::compound-bar-line |
| 640 model-b
ar |
| 641 glyph |
| 642 l |
| 643 #f)))))
) |
| 644 curr)) |
| 645 "" extents) |
666 (set! span-bar (ly:stencil-translate-axis | 646 (set! span-bar (ly:stencil-translate-axis |
667 span-bar | 647 span-bar |
668 (- (ly:grob-relative-coordinate grob refp Y)) | 648 (- (ly:grob-relative-coordinate grob refp Y)) |
669 Y)))) | 649 Y)))) |
670 span-bar)) | 650 span-bar)) |
LEFT | RIGHT |