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 ;; functions used by external routines | 76 ;; functions used by external routines |
66 | |
67 (define-public (bar-line::non-empty-barline grob) | |
68 (and (grob::has-interface grob 'bar-line) | |
69 (pair? (ly:grob-extent grob grob X)))) | |
70 | 77 |
71 (define-public (span-bar::notify-grobs-of-my-existence grob) | 78 (define-public (span-bar::notify-grobs-of-my-existence grob) |
72 (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements))) | 79 (let* ((elts (ly:grob-array->list (ly:grob-object grob 'elements))) |
73 (sorted-elts (sort elts ly:grob-vertical<?)) | 80 (sorted-elts (sort elts ly:grob-vertical<?)) |
74 (last-pos (1- (length sorted-elts))) | 81 (last-pos (1- (length sorted-elts))) |
75 (idx 0)) | 82 (idx 0)) |
76 | 83 |
77 (map (lambda (g) | 84 (map (lambda (g) |
78 (ly:grob-set-property! | 85 (ly:grob-set-property! |
79 g | 86 g |
(...skipping 46 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
126 (".S|:" . ("|" . "S|:")) | 133 (".S|:" . ("|" . "S|:")) |
127 (":|S|:" . (":|" . "S|:")) | 134 (":|S|:" . (":|" . "S|:")) |
128 (":|S.|:" . (":|S" . "|:")) | 135 (":|S.|:" . (":|S" . "|:")) |
129 | 136 |
130 ;; ancient bar lines | 137 ;; ancient bar lines |
131 ("kievan" . ("kievan" . "")))) | 138 ("kievan" . ("kievan" . "")))) |
132 | 139 |
133 ;; drawing functions for various bar line types | 140 ;; drawing functions for various bar line types |
134 | 141 |
135 (define (make-empty-bar-line grob extent) | 142 (define (make-empty-bar-line grob extent) |
136 (ly:make-stencil "" extent (cons 0 0))) | 143 (ly:make-stencil "" (cons 0 0) extent)) |
137 | 144 |
138 (define (make-simple-bar-line grob width extent rounded) | 145 (define (make-simple-bar-line grob width extent rounded) |
139 (let ((blot (if rounded | 146 (let ((blot (if rounded |
140 (ly:output-def-lookup layout 'blot-diameter) | 147 (layout-blot-diameter grob) |
141 0))) | 148 0))) |
142 | 149 |
143 (ly:round-filled-box (cons 0 width) | 150 (ly:round-filled-box (cons 0 width) |
144 extent | 151 extent |
145 blot))) | 152 blot))) |
146 | 153 |
147 (define (make-tick-bar-line grob height rounded) | 154 (define (make-tick-bar-line grob height rounded) |
148 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) | 155 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) |
149 (stafflinethick (ly:staff-symbol-line-thickness grob)) | 156 (staff-line-thickness (ly:staff-symbol-line-thickness grob)) |
150 (blot (if rounded | 157 (blot (if rounded |
151 (ly:output-def-lookup layout 'blot-diameter) | 158 (layout-blot-diameter grob) |
152 0))) | 159 0))) |
153 | 160 |
154 (ly:round-filled-box (cons 0 stafflinethick) | 161 (ly:round-filled-box (cons 0 staff-line-thickness) |
155 (cons (- height half-staff) (+ height half-staff)) | 162 (cons (- height half-staff) (+ height half-staff)) |
156 blot))) | 163 blot))) |
157 | 164 |
158 (define (make-colon-bar-line grob) | 165 (define (make-colon-bar-line grob) |
159 (let* ((staff-space (ly:staff-symbol-staff-space grob)) | 166 (let* ((staff-space (ly:staff-symbol-staff-space grob)) |
160 (line-thickness (ly:staff-symbol-line-thickness grob)) | |
161 (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")) |
162 (staff-symbol (get-staff-symbol grob)) | 168 (staff-symbol (get-staff-symbol grob)) |
163 (lines (staff-symbol-line-count staff-symbol)) | 169 (lines (staff-symbol-line-count staff-symbol)) |
164 (stencil empty-stencil) | 170 (stencil empty-stencil) |
165 (dist (* (if (or (odd? lines) | 171 (dist (* (if (or (odd? lines) |
166 (zero? lines)) | 172 (zero? lines)) |
167 1 | 173 1 |
168 (if (< staff-space 2) | 174 (if (< staff-space 2) |
169 2 | 175 2 |
170 0.5)) | 176 0.5)) |
171 staff-space))) | 177 staff-space))) |
172 | 178 |
173 (if (zero? staff-space) | 179 (if (zero? staff-space) |
174 (set! staff-space 1.0)) | 180 (set! staff-space 1.0)) |
175 | 181 |
176 (let* ((stencil (ly:stencil-add stencil dot)) | 182 (let* ((stencil (ly:stencil-add stencil dot)) |
177 (stencil (ly:stencil-translate-axis | 183 (stencil (ly:stencil-translate-axis |
178 stencil dist Y)) | 184 stencil dist Y)) |
179 (stencil (ly:stencil-add stencil dot)) | 185 (stencil (ly:stencil-add stencil dot)) |
180 (stencil (ly:stencil-translate-axis | 186 (stencil (ly:stencil-translate-axis |
181 stencil (/ dist -2) Y))) | 187 stencil (/ dist -2) Y))) |
182 stencil))) | 188 stencil))) |
183 | 189 |
184 (define (make-dotted-bar-line grob extent) | 190 (define (make-dotted-bar-line grob extent) |
185 (let* ((position (round (* (interval-end extent) 2))) | 191 (let* ((position (round (* (interval-end extent) 2))) |
186 (correction (if (even? position) 0.5 0.0)) | 192 (correction (if (even? position) 0.5 0.0)) |
187 (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")) |
188 (init (round (+ (interval-start extent) | 194 (i (round (+ (interval-start extent) |
189 (- 0.5 correction)))) | 195 (- 0.5 correction)))) |
190 (e (round (+ (interval-end extent) | 196 (e (round (+ (interval-end extent) |
191 (- 0.5 correction)))) | 197 (- 0.5 correction)))) |
192 (counting (interval-length (cons init e))) | 198 (counting (interval-length (cons i e))) |
193 (stil-list (map | 199 (stil-list (map |
194 (lambda (x) | 200 (lambda (x) |
195 (ly:stencil-translate-axis | 201 (ly:stencil-translate-axis |
196 dot (+ x correction) Y)) | 202 dot (+ x correction) Y)) |
197 (iota counting init 1)))) | 203 (iota counting i 1)))) |
198 | 204 |
199 (define (add-stencils! stil l) | 205 (define (add-stencils! stil l) |
200 (if (null? l) | 206 (if (null? l) |
201 stil | 207 stil |
202 (if (null? (cdr l)) | 208 (if (null? (cdr l)) |
203 (ly:stencil-add stil (car l)) | 209 (ly:stencil-add stil (car l)) |
204 (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) | 210 (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) |
205 | 211 |
206 (add-stencils! empty-stencil stil-list))) | 212 (add-stencils! empty-stencil stil-list))) |
207 | 213 |
208 (define (make-dashed-bar-line grob extent thickness) | 214 (define (make-dashed-bar-line grob extent thickness) |
209 (let* ((height (interval-length extent)) | 215 (let* ((height (interval-length extent)) |
210 (staff-symbol (ly:grob-object grob 'staff-symbol)) | 216 (staff-symbol (get-staff-symbol grob)) |
211 (staff-space (ly:staff-symbol-staff-space grob)) | 217 (staff-space (ly:staff-symbol-staff-space grob)) |
212 (line-thickness (ly:staff-symbol-line-thickness grob)) | 218 (line-thickness (layout-line-thickness grob)) |
213 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) | 219 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) |
214 (line-count (if (ly:grob? staff-symbol) | 220 (line-count (staff-symbol-line-count staff-symbol))) |
215 (ly:grob-property staff-symbol 'line-count) | |
216 0))) | |
217 | 221 |
218 (if (< (abs (+ line-thickness | 222 (if (< (abs (+ line-thickness |
219 (* (1- line-count) staff-space) | 223 (* (1- line-count) staff-space) |
220 (- height))) | 224 (- height))) |
221 0.1) | 225 0.1) |
222 (let ((blot (ly:output-def-lookup | 226 (let ((blot (layout-blot-diameter grob)) |
223 (ly:grob-layout grob) 'blot-diameter)) | |
224 (half-space (/ staff-space 2.0)) | 227 (half-space (/ staff-space 2.0)) |
225 (half-thick (/ line-thickness 2.0)) | 228 (half-thick (/ line-thickness 2.0)) |
226 (stencil empty-stencil)) | 229 (stencil empty-stencil)) |
227 | 230 |
228 (map (lambda (i) | 231 (map (lambda (i) |
229 (let ((top-y (min (* (+ i dash-size) half-space) | 232 (let ((top-y (min (* (+ i dash-size) half-space) |
230 (+ (* (1- line-count) half-space) | 233 (+ (* (1- line-count) half-space) |
231 half-thick))) | 234 half-thick))) |
232 (bot-y (max (* (- i dash-size) half-space) | 235 (bot-y (max (* (- i dash-size) half-space) |
233 (- 0 (* (1- line-count) half-space) | 236 (- 0 (* (1- line-count) half-space) |
234 half-thick)))) | 237 half-thick)))) |
235 | 238 |
236 (set! stencil | 239 (set! stencil |
237 (ly:stencil-add | 240 (ly:stencil-add |
238 stencil | 241 stencil |
239 (ly:round-filled-box (cons (/ thickness -2) | 242 (ly:round-filled-box (cons 0 thickness) |
240 (/ thickness 2)) | |
241 (cons bot-y top-y) | 243 (cons bot-y top-y) |
242 blot))))) | 244 blot))))) |
243 (iota line-count (1- line-count) (- 2))) | 245 (iota line-count (1- line-count) (- 2))) |
244 stencil) | 246 stencil) |
245 (let* ((dashes (/ height staff-space)) | 247 (let* ((dashes (/ height staff-space)) |
246 (total-dash-size (/ height dashes)) | 248 (total-dash-size (/ height dashes)) |
247 (factor (/ (- dash-size thickness) staff-space))) | 249 (factor (/ (- dash-size thickness) staff-space))) |
248 | 250 |
249 (ly:stencil-translate-axis | 251 (ly:stencil-translate-axis |
250 (ly:make-stencil (list 'dashed-line | 252 (ly:make-stencil (list 'dashed-line |
251 thickness | 253 thickness |
252 (* factor total-dash-size) | 254 (* factor total-dash-size) |
253 (* (- 1 factor) total-dash-size) | 255 (* (- 1 factor) total-dash-size) |
254 0 | 256 0 |
255 height | 257 height |
256 (* factor total-dash-size 0.5)) | 258 (* factor total-dash-size 0.5)) |
257 (cons 0 0) | 259 (cons 0 thickness) |
258 (cons (/ thickness -2) | 260 (cons 0 height)) |
259 (/ thickness 2))) | |
260 (interval-start extent) | 261 (interval-start extent) |
261 Y))))) | 262 Y))))) |
262 | 263 |
263 (define (make-segno-bar-line grob glyph extent rounded) | 264 (define (make-segno-bar-line grob glyph extent rounded) |
264 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 265 (let* ((line-thickness (layout-line-thickness grob)) |
265 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 266 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
266 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) | 267 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
267 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) | 268 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
268 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) | 269 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
269 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 270 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
270 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 271 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
271 (colon-stil (make-colon-bar-line grob)) | 272 (colon-stil (make-colon-bar-line grob)) |
272 (segno-stil (ly:stencil-add | 273 (segno-stil (ly:stencil-add |
273 (ly:stencil-combine-at-edge | 274 (ly:stencil-combine-at-edge |
274 (ly:stencil-combine-at-edge | 275 (ly:stencil-combine-at-edge |
(...skipping 53 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
328 (stencil (stencil-whiteout | 329 (stencil (stencil-whiteout |
329 (ly:font-get-glyph font "scripts.barline.kievan")))) | 330 (ly:font-get-glyph font "scripts.barline.kievan")))) |
330 | 331 |
331 ;; the kievan bar line has mo staff lines underneath, | 332 ;; the kievan bar line has mo staff lines underneath, |
332 ;; 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 |
333 (ly:grob-set-property! grob 'layer 1) | 334 (ly:grob-set-property! grob 'layer 1) |
334 stencil)) | 335 stencil)) |
335 | 336 |
336 ;; bar line callbacks | 337 ;; bar line callbacks |
337 | 338 |
338 (define (bar-line::calc-bar-extent grob) | 339 (define-public (ly:bar-line::calc-bar-extent grob) |
339 (let ((staff-symbol (get-staff-symbol grob)) | 340 (let ((staff-symbol (get-staff-symbol grob)) |
340 (staff-extent (cons 0 0))) | 341 (staff-extent (cons 0 0))) |
341 | 342 |
342 (if (ly:grob? staff-symbol) | 343 (if (ly:grob? staff-symbol) |
343 (let* ((bar-line-color (ly:grob-property grob 'color)) | 344 (let* ((bar-line-color (ly:grob-property grob 'color)) |
344 (staff-color (ly:grob-property staff-symbol 'color)) | 345 (staff-color (ly:grob-property staff-symbol 'color)) |
345 (radius (ly:staff-symbol-staff-radius grob)) | 346 (radius (ly:staff-symbol-staff-radius grob)) |
346 (line-thickness (ly:staff-symbol-line-thickness grob))) | 347 (staff-line-thickness (ly:staff-symbol-line-thickness grob))) |
347 | 348 |
348 ;; 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 |
349 ;; of the staff lines appear wrongly in on-screen display | 350 ;; of the staff lines appear wrongly in on-screen display |
350 ;; (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
. |
351 ;; The solution is to extend bar lines only to the middle | 352 ;; The solution is to extend bar lines only to the middle |
352 ;; of the staff line - unless they have different colors, | 353 ;; of the staff line - unless they have different colors, |
353 ;;when it would be undesirable. | 354 ;;when it would be undesirable. |
354 (set! staff-extent (ly:staff-symbol::height staff-symbol)) | 355 (set! staff-extent (ly:staff-symbol::height staff-symbol)) |
355 (if (and (eq? bar-line-color staff-color) | 356 (if (and (eq? bar-line-color staff-color) |
356 radius) | 357 radius) |
357 (interval-widen staff-extent | 358 (set! staff-extent |
358 (- 1 (* 1/2 (/ line-thickness radius))))))) | 359 (interval-scale staff-extent |
| 360 (- 1 (* 1/2 (/ staff-line-thickness radiu
s)))))))) |
359 staff-extent)) | 361 staff-extent)) |
360 | 362 |
361 (define (bar-line::bar-y-extent grob refpoint) | 363 (define (bar-line::bar-y-extent grob refpoint) |
362 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) | 364 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) |
363 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) | 365 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) |
364 (y-extent (coord-translate extent rel-y))) | 366 (y-extent (coord-translate extent rel-y))) |
365 | 367 |
366 y-extent)) | 368 y-extent)) |
367 | 369 |
368 (define-public (bar-line::print grob) | 370 (define-public (ly:bar-line::print grob) |
369 (let ((glyph (ly:grob-property grob 'glyph-name)) | 371 (let ((glyph (ly:grob-property grob 'glyph-name)) |
370 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) | 372 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) |
371 | 373 |
372 (if (and (not (eq? glyph '())) | 374 (if (and (not (eq? glyph '())) |
373 (> (interval-length extent) 0)) | 375 (> (interval-length extent) 0)) |
374 (bar-line::compound-bar-line grob glyph extent #f) | 376 (bar-line::compound-bar-line grob glyph extent #f) |
375 #f))) | 377 #f))) |
376 | 378 |
377 (define-public (bar-line::compound-bar-line grob glyph extent rounded) | 379 (define-public (bar-line::compound-bar-line grob glyph extent rounded) |
378 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 380 (let* ((line-thickness (layout-line-thickness grob)) |
379 (height (interval-length extent)) | 381 (height (interval-length extent)) |
380 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 382 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
381 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) | 383 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
382 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) | 384 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
383 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) | 385 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
384 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 386 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
385 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 387 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
386 (colon-stil (make-colon-bar-line grob)) | 388 (colon-stil (make-colon-bar-line grob)) |
387 (glyph (cond | 389 (glyph (cond |
| 390 ((not glyph) "") |
388 ((string=? glyph "||:") "|:") | 391 ((string=? glyph "||:") "|:") |
389 ;; bar-line::compound-bar-line is called only if | 392 ;; bar-line::compound-bar-line is called only if |
390 ;; height > 0, but just in case ... | 393 ;; height > 0, but just in case ... |
391 ((and (string=? glyph ":|") | 394 ((and (string=? glyph ":|") |
392 (zero? height)) "|.") | 395 (zero? height)) "|.") |
393 ((and (string=? glyph "|:") | 396 ((and (string=? glyph "|:") |
394 (zero? height)) ".|") | 397 (zero? height)) ".|") |
395 (else glyph))) | 398 (else glyph))) |
396 (stencil (cond | 399 (stencil (cond |
397 ((string=? glyph "|") thin-stil) | 400 ((string=? glyph "|") thin-stil) |
(...skipping 61 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
459 (make-segno-bar-line grob glyph extent rounded)) | 462 (make-segno-bar-line grob glyph extent rounded)) |
460 ((string=? glyph "'") | 463 ((string=? glyph "'") |
461 (make-tick-bar-line grob (interval-end extent) rounded)) | 464 (make-tick-bar-line grob (interval-end extent) rounded)) |
462 ((string=? glyph "dashed") | 465 ((string=? glyph "dashed") |
463 (make-dashed-bar-line grob extent hair)) | 466 (make-dashed-bar-line grob extent hair)) |
464 ((string=? glyph "kievan") | 467 ((string=? glyph "kievan") |
465 (make-kievan-bar-line grob)) | 468 (make-kievan-bar-line grob)) |
466 (else (make-empty-bar-line grob extent))))) | 469 (else (make-empty-bar-line grob extent))))) |
467 stencil)) | 470 stencil)) |
468 | 471 |
469 (define-public (bar-line::calc-anchor grob) | 472 (define-public (ly:bar-line::calc-anchor grob) |
470 (let* ((line-thickness (ly:staff-symbol-line-thickness grob)) | 473 (let* ((line-thickness (layout-line-thickness grob)) |
471 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) | 474 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
472 (glyph (ly:grob-property grob 'glyph-name "")) | 475 (glyph (ly:grob-property grob 'glyph-name "")) |
473 (x-extent (ly:grob-extent grob grob X)) | 476 (x-extent (ly:grob-extent grob grob X)) |
474 (dot-width (* (+ (interval-length | 477 (dot-width (+ (interval-length |
475 (ly:stencil-extent | 478 (ly:stencil-extent |
476 (ly:font-get-glyph | 479 (ly:font-get-glyph |
477 (ly:grob-default-font grob) | 480 (ly:grob-default-font grob) |
478 "dots.dot") | 481 "dots.dot") |
479 X)) | 482 X)) |
480 kern) | 483 kern)) |
481 line-thickness)) | |
482 (anchor 0.0)) | 484 (anchor 0.0)) |
483 | 485 |
484 (if (> (interval-length x-extent) 0) | 486 (if (> (interval-length x-extent) 0) |
485 (begin | 487 (begin |
486 (set! anchor (interval-center x-extent)) | 488 (set! anchor (interval-center x-extent)) |
487 (cond ((string=? glyph "|:") | 489 (cond ((string=? glyph "|:") |
488 (set! anchor (+ anchor (/ dot-width -2.0)))) | 490 (set! anchor (+ anchor (/ dot-width -2.0)))) |
489 ((string=? glyph ":|") | 491 ((string=? glyph ":|") |
490 (set! anchor (+ anchor (/ dot-width 2.0))))))) | 492 (set! anchor (+ anchor (/ dot-width 2.0))))))) |
491 anchor)) | 493 anchor)) |
(...skipping 35 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
527 (".S|:" . ".|") | 529 (".S|:" . ".|") |
528 (":|S" . "|.") | 530 (":|S" . "|.") |
529 (":|S." . "|.") | 531 (":|S." . "|.") |
530 (":|S|:" . "|._.|") | 532 (":|S|:" . "|._.|") |
531 (":|S.|:" . "|._.|") | 533 (":|S.|:" . "|._.|") |
532 ("kievan" . "") | 534 ("kievan" . "") |
533 ("'" . ""))) | 535 ("'" . ""))) |
534 | 536 |
535 ;; span bar callbacks | 537 ;; span bar callbacks |
536 | 538 |
537 (define-public (span-bar::calc-glyph-name grob) | 539 (define-public (ly:span-bar::calc-glyph-name grob) |
538 (let* ((elts (ly:grob-object grob 'elements)) | 540 (let* ((elts (ly:grob-object grob 'elements)) |
539 (pos (1- (ly:grob-array-length elts))) | 541 (pos (1- (ly:grob-array-length elts))) |
540 (glyph '())) | 542 (glyph '())) |
541 | 543 |
542 (while (and (eq? glyph '()) | 544 (while (and (eq? glyph '()) |
543 (> pos -1)) | 545 (> pos -1)) |
544 (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) |
545 'glyph-name)) | 547 'glyph-name)) |
546 (set! pos (1- pos)))) | 548 (set! pos (1- pos)))) |
547 (if (eq? glyph '()) | 549 (if (eq? glyph '()) |
548 (begin (ly:grob-suicide! grob) | 550 (begin (ly:grob-suicide! grob) |
549 (set! glyph ""))) | 551 (set! glyph ""))) |
550 (assoc-get glyph span-bar-glyph-alist glyph))) | 552 (assoc-get glyph span-bar-glyph-alist glyph))) |
551 | 553 |
552 (define-public (span-bar::width grob) | 554 (define-public (ly:span-bar::width grob) |
553 (let ((width (cons 0 0))) | 555 (let ((width (cons 0 0))) |
554 | 556 |
555 (if (grob::is-live? grob) | 557 (if (grob::is-live? grob) |
556 (let* ((glyph (ly:grob-property grob 'glyph-name)) | 558 (let* ((glyph (ly:grob-property grob 'glyph-name)) |
557 (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))) |
558 | 560 |
559 (set! width (ly:stencil-extent stencil X)))) | 561 (set! width (ly:stencil-extent stencil X)))) |
560 width)) | 562 width)) |
561 | 563 |
562 (define-public (span-bar::before-line-breaking grob) | 564 (define-public (ly:span-bar::before-line-breaking grob) |
563 (let ((elts (ly:grob-object grob 'elements))) | 565 (let ((elts (ly:grob-object grob 'elements))) |
564 | 566 |
565 (if (zero? (ly:grob-array-length elts)) | 567 (if (zero? (ly:grob-array-length elts)) |
566 (ly:grob-suicide! grob)))) | 568 (ly:grob-suicide! grob)))) |
567 | 569 |
568 ;; The method used in the following routine depends on bar_engraver | 570 ;; The method used in the following routine depends on bar_engraver |
569 ;; not being removed from staff context. If bar_engraver is removed, | 571 ;; not being removed from staff context. If bar_engraver is removed, |
570 ;; the size of the staff lines is evaluated as 0, which results in a | 572 ;; the size of the staff lines is evaluated as 0, which results in a |
571 ;; solid span bar line with faulty y coordinate. | 573 ;; solid span bar line with faulty y coordinate. |
572 ;; | 574 ;; |
573 ;; This routine was originally by Juergen Reuter, but it was a on the | 575 ;; This routine was originally by Juergen Reuter, but it was a on the |
574 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl. | 576 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl. |
575 (define-public (span-bar::print grob) | 577 (define-public (ly:span-bar::print grob) |
576 (let* ((elts-array (ly:grob-object grob 'elements)) | 578 (let* ((elts-array (ly:grob-object grob 'elements)) |
577 (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) | 579 (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) |
578 (elts (reverse (sort (ly:grob-array->list elts-array) | 580 (elts (reverse (sort (ly:grob-array->list elts-array) |
579 ly:grob-vertical<?))) | 581 ly:grob-vertical<?))) |
580 ;; Elements must be ordered according to their y coordinates | 582 ;; Elements must be ordered according to their y coordinates |
581 ;; relative to their common axis group parent. | 583 ;; relative to their common axis group parent. |
582 ;; Otherwise, the computation goes mad. | 584 ;; Otherwise, the computation goes mad. |
583 (glyph (ly:grob-property grob 'glyph-name)) | 585 (glyph (ly:grob-property grob 'glyph-name)) |
584 (span-bar empty-stencil)) | 586 (span-bar empty-stencil)) |
585 | 587 |
586 (if (string? glyph) | 588 (if (string? glyph) |
587 (let* ((extents '()) | 589 (let* ((extents '()) |
588 (make-span-bar '()) | 590 (make-span-bars '()) |
589 (model-bar #f)) | 591 (model-bar #f)) |
590 | 592 |
| 593 ;; we compute the extents of each system and store them |
| 594 ;; in a list; dito for the 'allow-span-bar property. |
| 595 ;; model-bar takes the bar grob, if given. |
591 (map (lambda (bar) | 596 (map (lambda (bar) |
592 (let* ((ext (bar-line::bar-y-extent bar refp)) | 597 (let* ((ext (bar-line::bar-y-extent bar refp)) |
593 (staff-symbol (ly:grob-object bar 'staff-symbol))) | 598 (staff-symbol (ly:grob-object bar 'staff-symbol))) |
594 | 599 |
595 (if (ly:grob? staff-symbol) | 600 (if (ly:grob? staff-symbol) |
596 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) | 601 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) |
597 | 602 |
598 (set! ext (interval-union ext refp-extent)
) | 603 (set! ext (interval-union ext refp-extent)
) |
599 | 604 |
600 (if (> (interval-length ext) 0) | 605 (if (> (interval-length ext) 0) |
601 (begin | 606 (begin |
602 (set! extents (append extents (list
ext))) | 607 (set! extents (append extents (list
ext))) |
603 (set! model-bar bar) | 608 (set! model-bar bar) |
604 (set! make-span-bar | 609 (set! make-span-bars |
605 (append make-span-bar | 610 (append make-span-bars |
606 (list (ly:grob-property ba
r 'allow-span-bar)))))))))) | 611 (list (ly:grob-property ba
r 'allow-span-bar #t)))))))))) |
607 elts) | 612 elts) |
608 | 613 ;; if there is no bar grob, we use the callback argument |
609 (if (not model-bar) | 614 (if (not model-bar) |
610 (set! model-bar grob)) | 615 (set! model-bar grob)) |
611 | 616 ;; we discard the first entry in make-span-bars, because its c
orresponding |
| 617 ;; bar line is the uppermost and therefore not connected to an
other bar line |
| 618 (if (pair? make-span-bars) |
| 619 (set! make-span-bars (cdr make-span-bars))) |
| 620 ;; the span bar reaches from the lower end of the upper staff |
| 621 ;; to the upper end of the lower staff - when allow-span-bar i
s #t |
612 (reduce (lambda (curr prev) | 622 (reduce (lambda (curr prev) |
613 (let ((l (cons 0 0)) | 623 (let ((l (cons 0 0)) |
614 (allow-span-bar (car make-span-bar))) | 624 (allow-span-bar (car make-span-bars))) |
615 | 625 |
616 (set! make-span-bar (cdr make-span-bar)) | 626 (set! make-span-bars (cdr make-span-bars)
) |
617 (if (> (interval-length prev) 0) | 627 (if (> (interval-length prev) 0) |
618 (begin | 628 (begin |
619 (set! l (cons (cdr prev) (car curr)
)) | 629 (set! l (cons (cdr prev) (car curr)
)) |
620 (if (or (zero? (interval-length l)) | 630 (if (or (zero? (interval-length l)) |
621 (not allow-span-bar)) | 631 (not allow-span-bar)) |
622 (begin | 632 (begin |
623 ;; there is overlap between t
he bar lines | 633 ;; there is overlap between t
he bar lines |
624 ;; or 'allow-span-bar = #f. | 634 ;; or 'allow-span-bar = #f. |
625 ;; Do nothing. | 635 ;; Do nothing. |
626 ) | 636 ) |
627 (set! span-bar | 637 (set! span-bar |
628 (ly:stencil-add span-bar | 638 (ly:stencil-add span-bar |
629 (bar-line
::compound-bar-line | 639 (bar-line
::compound-bar-line |
630 model-b
ar | 640 model-b
ar |
631 glyph | 641 glyph |
632 l | 642 l |
633 #f)))))
) | 643 #f)))))
) |
634 curr)) | 644 curr)) |
635 "" extents) | 645 "" extents) |
636 (set! span-bar (ly:stencil-translate-axis | 646 (set! span-bar (ly:stencil-translate-axis |
637 span-bar | 647 span-bar |
638 (- (ly:grob-relative-coordinate grob refp Y)) | 648 (- (ly:grob-relative-coordinate grob refp Y)) |
639 Y)))) | 649 Y)))) |
640 span-bar)) | 650 span-bar)) |
641 | |
LEFT | RIGHT |