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 ;; How should a bar line behave at a break? | 18 ;; helper functions |
| 19 |
| 20 (define (get-staff-symbol grob) |
| 21 (if (grob::has-interface grob 'staff-symbol-interface) |
| 22 grob |
| 23 (ly:grob-object grob 'staff-symbol))) |
| 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 |
| 37 (define (staff-symbol-line-count grob) |
| 38 (let ((line-count 0)) |
| 39 |
| 40 (if (ly:grob? grob) |
| 41 (let ((line-pos (ly:grob-property grob 'line-positions '()))) |
| 42 |
| 43 (set! line-count (if (pair? line-pos) |
| 44 (length line-pos) |
| 45 (ly:grob-property grob 'line-count 0))))) |
| 46 |
| 47 line-count)) |
| 48 |
| 49 (define (staff-symbol-line-span grob) |
| 50 (let ((line-pos (ly:grob-property grob 'line-positions '())) |
| 51 (iv (cons 0.0 0.0))) |
| 52 |
| 53 (if (pair? line-pos) |
| 54 (map (lambda (x) |
| 55 (set! iv (cons (min (car iv) x) |
| 56 (max (cdr iv) x)))) |
| 57 line-pos) |
| 58 (let ((line-count (ly:grob-property grob 'line-count 0))) |
| 59 |
| 60 (set! iv (cons (- 1 line-count) |
| 61 (- line-count 1))))) |
| 62 iv)) |
| 63 |
| 64 (define (staff-symbol-line-positions grob) |
| 65 (let ((line-pos (ly:grob-property grob 'line-positions '()))) |
| 66 |
| 67 (if (not (pair? line-pos)) |
| 68 (let* ((line-count (ly:grob-property grob 'line-count 0)) |
| 69 (height (- line-count 1.0))) |
| 70 |
| 71 (set! line-pos (map (lambda (x) |
| 72 (- height (* x 2))) |
| 73 (iota line-count))))) |
| 74 line-pos)) |
| 75 |
| 76 ;; functions used by external routines |
| 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? |
19 ;; the following alist has the form | 98 ;; the following alist has the form |
20 ;; ( 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 )) |
21 | 100 |
22 (define bar-glyph-alist | 101 (define bar-glyph-alist |
23 '((":|:" . (":|" . "|:")) | 102 '((":|:" . (":|" . "|:")) |
24 (":|.|:" . (":|" . "|:")) | 103 (":|.|:" . (":|" . "|:")) |
25 (":|.:" . (":|" . "|:")) | 104 (":|.:" . (":|" . "|:")) |
26 ("||:" . ("||" . "|:")) | 105 ("||:" . ("||" . "|:")) |
27 ("dashed" . ("dashed" . '())) | 106 ("dashed" . ("dashed" . '())) |
28 ("|" . ("|" . ())) | 107 ("|" . ("|" . ())) |
(...skipping 24 matching lines...) Expand all Loading... |
53 ("S|:" . ("S" . "|:")) | 132 ("S|:" . ("S" . "|:")) |
54 (".S|:" . ("|" . "S|:")) | 133 (".S|:" . ("|" . "S|:")) |
55 (":|S|:" . (":|" . "S|:")) | 134 (":|S|:" . (":|" . "S|:")) |
56 (":|S.|:" . (":|S" . "|:")) | 135 (":|S.|:" . (":|S" . "|:")) |
57 | 136 |
58 ;; ancient bar lines | 137 ;; ancient bar lines |
59 ("kievan" . ("kievan" . "")))) | 138 ("kievan" . ("kievan" . "")))) |
60 | 139 |
61 ;; drawing functions for various bar line types | 140 ;; drawing functions for various bar line types |
62 | 141 |
| 142 (define (make-empty-bar-line grob extent) |
| 143 (ly:make-stencil "" (cons 0 0) extent)) |
| 144 |
63 (define (make-simple-bar-line grob width extent rounded) | 145 (define (make-simple-bar-line grob width extent rounded) |
64 (let ((blot (if rounded | 146 (let ((blot (if rounded |
65 (ly:output-def-lookup layout 'blot-diameter) | 147 (layout-blot-diameter grob) |
66 0))) | 148 0))) |
67 | 149 |
68 (ly:round-filled-box (cons 0 width) | 150 (ly:round-filled-box (cons 0 width) |
69 extent | 151 extent |
70 blot))) | 152 blot))) |
71 | 153 |
72 (define (make-tick-bar-line grob height rounded) | 154 (define (make-tick-bar-line grob height rounded) |
73 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) | 155 (let ((half-staff (* 1/2 (ly:staff-symbol-staff-space grob))) |
74 (stafflinethick (ly:staff-symbol-line-thickness grob)) | 156 (staff-line-thickness (ly:staff-symbol-line-thickness grob)) |
75 (blot (if rounded | 157 (blot (if rounded |
76 (ly:output-def-lookup layout 'blot-diameter) | 158 (layout-blot-diameter grob) |
77 0))) | 159 0))) |
78 | 160 |
79 (ly:round-filled-box (cons 0 stafflinethick) | 161 (ly:round-filled-box (cons 0 staff-line-thickness) |
80 (cons (- height half-staff) (+ height half-staff)) | 162 (cons (- height half-staff) (+ height half-staff)) |
81 blot))) | 163 blot))) |
82 | 164 |
83 (define (make-colon-bar-line grob) | 165 (define (make-colon-bar-line grob) |
84 (let* ((staff-symbol (ly:grob-object grob 'staff-symbol)) | 166 (let* ((staff-space (ly:staff-symbol-staff-space grob)) |
85 (line-count (if (ly:grob? staff-symbol) | |
86 (ly:grob-property staff-symbol 'line-count) | |
87 0)) | |
88 (staff-space (ly:staff-symbol-staff-space grob)) | |
89 (dist (cond ((odd? line-count) staff-space) | |
90 ((zero? line-count) staff-space) | |
91 ((< staff-space 2) (* 2 staff-space)) | |
92 (else (* 0.5 staff-space)))) | |
93 (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)) |
94 (stencil empty-stencil) | 170 (stencil empty-stencil) |
95 (stencil (ly:stencil-add stencil dot)) | 171 (dist (* (if (or (odd? lines) |
96 (stencil (ly:stencil-translate-axis stencil dist Y)) | 172 (zero? lines)) |
97 (stencil (ly:stencil-add stencil dot)) | 173 1 |
98 (stencil (ly:stencil-translate-axis stencil (/ dist -2) Y))) | 174 (if (< staff-space 2) |
99 | 175 2 |
100 stencil)) | 176 0.5)) |
| 177 staff-space))) |
| 178 |
| 179 (if (zero? staff-space) |
| 180 (set! staff-space 1.0)) |
| 181 |
| 182 (let* ((stencil (ly:stencil-add stencil dot)) |
| 183 (stencil (ly:stencil-translate-axis |
| 184 stencil dist Y)) |
| 185 (stencil (ly:stencil-add stencil dot)) |
| 186 (stencil (ly:stencil-translate-axis |
| 187 stencil (/ dist -2) Y))) |
| 188 stencil))) |
101 | 189 |
102 (define (make-dotted-bar-line grob extent) | 190 (define (make-dotted-bar-line grob extent) |
103 (let* ((position (round (* (interval-end extent) 2))) | 191 (let* ((position (round (* (interval-end extent) 2))) |
104 (correction (if (even? position) 0.5 0.0)) | 192 (correction (if (even? position) 0.5 0.0)) |
105 (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")) |
106 (stencil empty-stencil) | 194 (i (round (+ (interval-start extent) |
| 195 (- 0.5 correction)))) |
107 (e (round (+ (interval-end extent) | 196 (e (round (+ (interval-end extent) |
108 (- 0.5 correction))))) | 197 (- 0.5 correction)))) |
109 | 198 (counting (interval-length (cons i e))) |
110 (do ((i (round (+ (interval-start extent) | 199 (stil-list (map |
111 (- 0.5 correction))) | 200 (lambda (x) |
112 (1+ i))) | 201 (ly:stencil-translate-axis |
113 ((>= i e)) | 202 dot (+ x correction) Y)) |
114 (set! stencil | 203 (iota counting i 1)))) |
115 (ly:stencil-add stencil | 204 |
116 (ly:stencil-translate-axis dot (+ i correction
) Y)))) | 205 (define (add-stencils! stil l) |
117 stencil)) | 206 (if (null? l) |
| 207 stil |
| 208 (if (null? (cdr l)) |
| 209 (ly:stencil-add stil (car l)) |
| 210 (add-stencils! (ly:stencil-add stil (car l)) (cdr l))))) |
| 211 |
| 212 (add-stencils! empty-stencil stil-list))) |
118 | 213 |
119 (define (make-dashed-bar-line grob extent thickness) | 214 (define (make-dashed-bar-line grob extent thickness) |
120 (let* ((height (interval-length extent)) | 215 (let* ((height (interval-length extent)) |
121 (staff-symbol (ly:grob-object grob 'staff-symbol)) | 216 (staff-symbol (get-staff-symbol grob)) |
122 (staff-space (ly:staff-symbol-staff-space grob)) | 217 (staff-space (ly:staff-symbol-staff-space grob)) |
123 (line-thickness (ly:staff-symbol-line-thickness grob)) | 218 (line-thickness (layout-line-thickness grob)) |
124 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) | 219 (dash-size (- 1.0 (ly:grob-property grob 'gap 0.3))) |
125 (line-count (if (ly:grob? staff-symbol) | 220 (line-count (staff-symbol-line-count staff-symbol))) |
126 (ly:grob-property staff-symbol 'line-count) | |
127 0))) | |
128 | 221 |
129 (if (< (abs (+ line-thickness | 222 (if (< (abs (+ line-thickness |
130 (* (1- line-count) staff-space) | 223 (* (1- line-count) staff-space) |
131 (- height))) | 224 (- height))) |
132 0.1) | 225 0.1) |
133 (let ((blot (ly:output-def-lookup (ly:grob-layout grob) 'blot-diamet
er)) | 226 (let ((blot (layout-blot-diameter grob)) |
134 (half-space (/ staff-space 2.0)) | 227 (half-space (/ staff-space 2.0)) |
135 (half-thick (/ line-thickness 2.0)) | 228 (half-thick (/ line-thickness 2.0)) |
136 (stencil empty-stencil)) | 229 (stencil empty-stencil)) |
137 | 230 |
138 (do ((i (1- line-count) (- i 2))) | 231 (map (lambda (i) |
139 ((< i (- 1 line-count))) | 232 (let ((top-y (min (* (+ i dash-size) half-space) |
140 (let ((top-y (min (* (+ i dash-size) half-space) | 233 (+ (* (1- line-count) half-space) |
141 (+ (* (1- line-count) half-space) half-th
ick))) | 234 half-thick))) |
142 (bot-y (max (* (- i dash-size) half-space) | 235 (bot-y (max (* (- i dash-size) half-space) |
143 (- 0 (* (1- line-count) half-space) half-
thick)))) | 236 (- 0 (* (1- line-count) half-space) |
144 | 237 half-thick)))) |
145 (set! stencil | 238 |
146 (ly:stencil-add stencil | 239 (set! stencil |
147 (ly:round-filled-box (cons 0 thi
ckness) | 240 (ly:stencil-add |
148 (cons bot-y
top-y) | 241 stencil |
149 blot))))) | 242 (ly:round-filled-box (cons 0 thickness) |
| 243 (cons bot-y top-y) |
| 244 blot))))) |
| 245 (iota line-count (1- line-count) (- 2))) |
150 stencil) | 246 stencil) |
151 (let* ((dashes (/ height staff-space)) | 247 (let* ((dashes (/ height staff-space)) |
152 (total-dash-size (/ height dashes)) | 248 (total-dash-size (/ height dashes)) |
153 (factor (/ (- dash-size thickness) staff-space))) | 249 (factor (/ (- dash-size thickness) staff-space))) |
154 | 250 |
155 (ly:make-stencil (list 'dashed-line | 251 (ly:stencil-translate-axis |
156 thickness | 252 (ly:make-stencil (list 'dashed-line |
157 (* factor total-dash-size) | 253 thickness |
158 (* (- 1 factor) total-dash-size) | 254 (* factor total-dash-size) |
159 0 | 255 (* (- 1 factor) total-dash-size) |
160 height | 256 0 |
161 (* factor total-dash-size 0.5)) | 257 height |
162 (cons 0 0) | 258 (* factor total-dash-size 0.5)) |
163 (cons (/ thickness -2) (/ thickness 2))))))) | 259 (cons 0 thickness) |
| 260 (cons 0 height)) |
| 261 (interval-start extent) |
| 262 Y))))) |
164 | 263 |
165 (define (make-segno-bar-line grob glyph extent rounded) | 264 (define (make-segno-bar-line grob glyph extent rounded) |
166 (let* ((staff-line-thickness (ly:staff-symbol-line-thickness grob)) | 265 (let* ((line-thickness (layout-line-thickness grob)) |
167 (kern (* (ly:grob-property grob 'kern 1) staff-line-thickness)) | 266 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
168 (thinkern (* (ly:grob-property grob 'thin-kern 1) staff-line-thickness)
) | 267 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
169 (hair (* (ly:grob-property grob 'hair-thickness 1) staff-line-thickness
)) | 268 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
170 (fatline (* (ly:grob-property grob 'thick-thickness 1) staff-line-thick
ness)) | 269 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
171 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 270 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
172 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 271 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
173 (colon-stil (make-colon-bar-line grob)) | 272 (colon-stil (make-colon-bar-line grob)) |
174 (segno-stil (ly:stencil-add | 273 (segno-stil (ly:stencil-add |
175 (ly:stencil-combine-at-edge | 274 (ly:stencil-combine-at-edge |
176 (ly:stencil-combine-at-edge | 275 (ly:stencil-combine-at-edge |
177 '() X LEFT thin-stil thinkern) | 276 '() X LEFT thin-stil thinkern) |
178 X RIGHT thin-stil thinkern) | 277 X RIGHT thin-stil thinkern) |
179 (ly:font-get-glyph (ly:grob-default-font grob) "scripts.v
arsegno"))) | 278 (ly:font-get-glyph (ly:grob-default-font grob) "scripts.v
arsegno"))) |
180 (glyph (cond | 279 (glyph (cond |
(...skipping 49 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
230 (stencil (stencil-whiteout | 329 (stencil (stencil-whiteout |
231 (ly:font-get-glyph font "scripts.barline.kievan")))) | 330 (ly:font-get-glyph font "scripts.barline.kievan")))) |
232 | 331 |
233 ;; the kievan bar line has mo staff lines underneath, | 332 ;; the kievan bar line has mo staff lines underneath, |
234 ;; 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 |
235 (ly:grob-set-property! grob 'layer 1) | 334 (ly:grob-set-property! grob 'layer 1) |
236 stencil)) | 335 stencil)) |
237 | 336 |
238 ;; bar line callbacks | 337 ;; bar line callbacks |
239 | 338 |
240 (define (bar-line::calc-bar-extent grob) | 339 (define-public (ly:bar-line::calc-bar-extent grob) |
241 (let ((staff-symbol (ly:grob-object grob 'staff-symbol)) | 340 (let ((staff-symbol (get-staff-symbol grob)) |
242 (staff-extent (cons 0 0))) | 341 (staff-extent (cons 0 0))) |
243 | 342 |
244 (if (ly:grob? staff-symbol) | 343 (if (ly:grob? staff-symbol) |
245 (let* ((bar-line-color (ly:grob-property grob 'color)) | 344 (let* ((bar-line-color (ly:grob-property grob 'color)) |
246 (staff-color (ly:grob-property staff-symbol 'color)) | 345 (staff-color (ly:grob-property staff-symbol 'color)) |
247 (radius (ly:staff-symbol-staff-radius grob)) | 346 (radius (ly:staff-symbol-staff-radius grob)) |
248 (line-thickness (ly:staff-symbol-line-thickness grob))) | 347 (staff-line-thickness (ly:staff-symbol-line-thickness grob))) |
249 | 348 |
250 ;; 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 |
251 ;; of the staff lines appear wrongly in on-screen display | 350 ;; of the staff lines appear wrongly in on-screen display |
252 ;; (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
. |
253 ;; The solution is to extend bar lines only to the middle | 352 ;; The solution is to extend bar lines only to the middle |
254 ;; of the staff line - unless they have different colors, | 353 ;; of the staff line - unless they have different colors, |
255 ;;when it would be undesirable. | 354 ;;when it would be undesirable. |
256 (set! staff-extent (ly:staff-symbol::height staff-symbol)) | 355 (set! staff-extent (ly:staff-symbol::height staff-symbol)) |
257 (if (and (eq? bar-line-color staff-color) | 356 (if (and (eq? bar-line-color staff-color) |
258 radius) | 357 radius) |
259 (interval-widen staff-extent | 358 (set! staff-extent |
260 (- 1 (* 1/2 (/ line-thickness radius))))))) | 359 (interval-scale staff-extent |
| 360 (- 1 (* 1/2 (/ staff-line-thickness radiu
s)))))))) |
261 staff-extent)) | 361 staff-extent)) |
262 | 362 |
263 (define (bar-line::bar-y-extent grob refpoint) | 363 (define (bar-line::bar-y-extent grob refpoint) |
264 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) | 364 (let* ((extent (ly:grob-property grob 'bar-extent '(0 . 0))) |
265 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) | 365 (rel-y (ly:grob-relative-coordinate grob refpoint Y)) |
266 (y-extent (coord-translate extent rel-y))) | 366 (y-extent (coord-translate extent rel-y))) |
267 | 367 |
268 y-extent)) | 368 y-extent)) |
269 | 369 |
270 (define-public (bar-line::print grob) | 370 (define-public (ly:bar-line::print grob) |
271 (let ((glyph (ly:grob-property grob 'glyph-name)) | 371 (let ((glyph (ly:grob-property grob 'glyph-name)) |
272 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) | 372 (extent (ly:grob-property grob 'bar-extent '(0 . 0)))) |
273 | 373 |
274 (if (and (not (eq? glyph '())) | 374 (if (and (not (eq? glyph '())) |
275 (> (interval-length extent) 0)) | 375 (> (interval-length extent) 0)) |
276 (bar-line::compound-bar-line grob glyph extent #f) | 376 (bar-line::compound-bar-line grob glyph extent #f) |
277 #f))) | 377 #f))) |
278 | 378 |
279 (define-public (bar-line::compound-bar-line grob glyph extent rounded) | 379 (define-public (bar-line::compound-bar-line grob glyph extent rounded) |
280 (let* ((staff-line-thickness (ly:staff-symbol-line-thickness grob)) | 380 (let* ((line-thickness (layout-line-thickness grob)) |
281 (height (interval-length extent)) | 381 (height (interval-length extent)) |
282 (kern (* (ly:grob-property grob 'kern 1) staff-line-thickness)) | 382 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
283 (thinkern (* (ly:grob-property grob 'thin-kern 1) staff-line-thickness)
) | 383 (thinkern (* (ly:grob-property grob 'thin-kern 1) line-thickness)) |
284 (hair (* (ly:grob-property grob 'hair-thickness 1) staff-line-thickness
)) | 384 (hair (* (ly:grob-property grob 'hair-thickness 1) line-thickness)) |
285 (fatline (* (ly:grob-property grob 'thick-thickness 1) staff-line-thick
ness)) | 385 (fatline (* (ly:grob-property grob 'thick-thickness 1) line-thickness)) |
286 (thin-stil (make-simple-bar-line grob hair extent rounded)) | 386 (thin-stil (make-simple-bar-line grob hair extent rounded)) |
287 (thick-stil (make-simple-bar-line grob fatline extent rounded)) | 387 (thick-stil (make-simple-bar-line grob fatline extent rounded)) |
288 (colon-stil (make-colon-bar-line grob)) | 388 (colon-stil (make-colon-bar-line grob)) |
289 (glyph (cond | 389 (glyph (cond |
| 390 ((not glyph) "") |
290 ((string=? glyph "||:") "|:") | 391 ((string=? glyph "||:") "|:") |
291 ;; bar-line::compound-bar-line is called only if | 392 ;; bar-line::compound-bar-line is called only if |
292 ;; height > 0, but just in case ... | 393 ;; height > 0, but just in case ... |
293 ((and (string=? glyph ":|") | 394 ((and (string=? glyph ":|") |
294 (zero? height)) "|.") | 395 (zero? height)) "|.") |
295 ((and (string=? glyph "|:") | 396 ((and (string=? glyph "|:") |
296 (zero? height)) ".|") | 397 (zero? height)) ".|") |
297 (else glyph))) | 398 (else glyph))) |
298 (stencil (cond | 399 (stencil (cond |
299 ((string=? glyph "|") thin-stil) | 400 ((string=? glyph "|") thin-stil) |
(...skipping 58 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
358 (make-dotted-bar-line grob extent)) | 459 (make-dotted-bar-line grob extent)) |
359 ((or (string=? glyph "|._.|") | 460 ((or (string=? glyph "|._.|") |
360 (string-contains glyph "S")) | 461 (string-contains glyph "S")) |
361 (make-segno-bar-line grob glyph extent rounded)) | 462 (make-segno-bar-line grob glyph extent rounded)) |
362 ((string=? glyph "'") | 463 ((string=? glyph "'") |
363 (make-tick-bar-line grob (interval-end extent) rounded)) | 464 (make-tick-bar-line grob (interval-end extent) rounded)) |
364 ((string=? glyph "dashed") | 465 ((string=? glyph "dashed") |
365 (make-dashed-bar-line grob extent hair)) | 466 (make-dashed-bar-line grob extent hair)) |
366 ((string=? glyph "kievan") | 467 ((string=? glyph "kievan") |
367 (make-kievan-bar-line grob)) | 468 (make-kievan-bar-line grob)) |
368 (else (make-filled-box-stencil (cons 0 0) (cons 0 height))))
)) | 469 (else (make-empty-bar-line grob extent))))) |
369 stencil)) | 470 stencil)) |
370 | 471 |
371 (define-public (bar-line::calc-anchor grob) | 472 (define-public (ly:bar-line::calc-anchor grob) |
372 (let* ((staff-line-thickness (ly:staff-symbol-line-thickness grob)) | 473 (let* ((line-thickness (layout-line-thickness grob)) |
373 (kern (* (ly:grob-property grob 'kern 1) staff-line-thickness)) | 474 (kern (* (ly:grob-property grob 'kern 1) line-thickness)) |
374 (glyph (ly:grob-property grob 'glyph-name "")) | 475 (glyph (ly:grob-property grob 'glyph-name "")) |
375 (x-extent (ly:stencil-extent grob X)) | 476 (x-extent (ly:grob-extent grob grob X)) |
376 (dot-width (+ (ly:stencil-extent | 477 (dot-width (+ (interval-length |
377 (ly:font-get-glyph | 478 (ly:stencil-extent |
378 (ly:grob-default-font grob) | 479 (ly:font-get-glyph |
379 "dots.dot") | 480 (ly:grob-default-font grob) |
380 X) | 481 "dots.dot") |
| 482 X)) |
381 kern)) | 483 kern)) |
382 (anchor 0.0)) | 484 (anchor 0.0)) |
383 | 485 |
384 (if (> (interval-length x-extent) 0) | 486 (if (> (interval-length x-extent) 0) |
385 (begin | 487 (begin |
386 (set! anchor (interval-center x-extent)) | 488 (set! anchor (interval-center x-extent)) |
387 (cond ((string=? glyph "|:") | 489 (cond ((string=? glyph "|:") |
388 (set! anchor (+ anchor (/ dot-width -2.0)))) | 490 (set! anchor (+ anchor (/ dot-width -2.0)))) |
389 ((string=? glyph ":|") | 491 ((string=? glyph ":|") |
390 (set! anchor (+ anchor (/ dot-width 2.0))))))) | 492 (set! anchor (+ anchor (/ dot-width 2.0))))))) |
(...skipping 36 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
427 (".S|:" . ".|") | 529 (".S|:" . ".|") |
428 (":|S" . "|.") | 530 (":|S" . "|.") |
429 (":|S." . "|.") | 531 (":|S." . "|.") |
430 (":|S|:" . "|._.|") | 532 (":|S|:" . "|._.|") |
431 (":|S.|:" . "|._.|") | 533 (":|S.|:" . "|._.|") |
432 ("kievan" . "") | 534 ("kievan" . "") |
433 ("'" . ""))) | 535 ("'" . ""))) |
434 | 536 |
435 ;; span bar callbacks | 537 ;; span bar callbacks |
436 | 538 |
437 (define-public (span-bar::calc-glyph-name grob) | 539 (define-public (ly:span-bar::calc-glyph-name grob) |
438 (let* ((elts (ly:grob-object grob 'elements)) | 540 (let* ((elts (ly:grob-object grob 'elements)) |
439 (pos (1- (ly:grob-array-length elts))) | 541 (pos (1- (ly:grob-array-length elts))) |
440 (glyph '())) | 542 (glyph '())) |
441 | 543 |
442 (while (and (eq? glyph '()) | 544 (while (and (eq? glyph '()) |
443 (> pos -1)) | 545 (> pos -1)) |
444 (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) |
445 'glyph-name)) | 547 'glyph-name)) |
446 (set! pos (1- pos)))) | 548 (set! pos (1- pos)))) |
447 (if (eq? glyph '()) | 549 (if (eq? glyph '()) |
448 (begin (ly:grob-suicide! grob) | 550 (begin (ly:grob-suicide! grob) |
449 (set! glyph ""))) | 551 (set! glyph ""))) |
450 (assoc-get glyph span-bar-glyph-alist glyph))) | 552 (assoc-get glyph span-bar-glyph-alist glyph))) |
451 | 553 |
452 (define-public (span-bar::width grob) | 554 (define-public (ly:span-bar::width grob) |
453 (let ((width (cons 0 0))) | 555 (let ((width (cons 0 0))) |
454 | 556 |
455 (if (grob::is-live? grob) | 557 (if (grob::is-live? grob) |
456 (let* ((glyph (ly:grob-property grob 'glyph-name)) | 558 (let* ((glyph (ly:grob-property grob 'glyph-name)) |
457 (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))) |
458 | 560 |
459 (set! width (ly:stencil-extent stencil X)))) | 561 (set! width (ly:stencil-extent stencil X)))) |
460 width)) | 562 width)) |
461 | 563 |
462 (define-public (span-bar::before-line-breaking grob) | 564 (define-public (ly:span-bar::before-line-breaking grob) |
463 (let ((elts (ly:grob-object grob 'elements))) | 565 (let ((elts (ly:grob-object grob 'elements))) |
464 | 566 |
465 (if (zero? (ly:grob-array-length elts)) | 567 (if (zero? (ly:grob-array-length elts)) |
466 (ly:grob-suicide! grob)))) | 568 (ly:grob-suicide! grob)))) |
467 | 569 |
468 ;; defined in scm/music-functions.scm | 570 ;; The method used in the following routine depends on bar_engraver |
469 (define (vector-extend v x) | 571 ;; not being removed from staff context. If bar_engraver is removed, |
470 "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 |
471 (let* ((n (vector-length v)) | 573 ;; solid span bar line with faulty y coordinate. |
472 (nv (make-vector (+ n 1) '()))) | 574 ;; |
473 (vector-move-left! v 0 n nv 0) | 575 ;; This routine was originally by Juergen Reuter, but it was a on the |
474 (vector-set! nv n x) | 576 ;; bulky side. Rewritten by Han-Wen. Ported from c++ to Scheme by Marc Hohl. |
475 nv)) | 577 (define-public (ly:span-bar::print grob) |
476 | 578 (let* ((elts-array (ly:grob-object grob 'elements)) |
477 (define-public (span-bar::print grob) | 579 (refp (ly:grob-common-refpoint-of-array grob elts-array Y)) |
478 (let* ((elts (ly:grob-object grob 'elements)) | 580 (elts (reverse (sort (ly:grob-array->list elts-array) |
479 (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. |
480 (glyph (ly:grob-property grob 'glyph-name)) | 585 (glyph (ly:grob-property grob 'glyph-name)) |
481 (span-bar empty-stencil)) | 586 (span-bar empty-stencil)) |
482 | 587 |
483 ;;Limitations/Bugs: | |
484 ;; | |
485 ;; (1) Elements from 'me->get_object ("elements")' must be | |
486 ;; ordered according to their y coordinates relative to their common | |
487 ;; axis group parent. Otherwise, the computation goes mad. | |
488 ;; | |
489 ;; (2) This method depends on bar_engraver not being removed from | |
490 ;; staff context. If bar_engraver is removed, the size of the staff | |
491 ;; lines is evaluated as 0, which results in a solid span bar line | |
492 ;; with faulty y coordinate. | |
493 ;; | |
494 ;; This routine was originally by Juergen Reuter, but it was a on the | |
495 ;; bulky side. Rewritten by Han-Wen. | |
496 ;; Ported from c++ to Scheme by Marc Hohl. | |
497 (if (string? glyph) | 588 (if (string? glyph) |
498 (let* ((extents (make-vector 0 '())) | 589 (let* ((extents '()) |
499 (make-span-bar (make-vector 0 '())) | 590 (make-span-bars '()) |
500 (model-bar #f) | 591 (model-bar #f)) |
501 (elts-size (ly:grob-array-length elts))) | 592 |
502 | 593 ;; we compute the extents of each system and store them |
503 (do ((i (1- elts-size) (1- i))) | 594 ;; in a list; dito for the 'allow-span-bar property. |
504 ((< i 0)) | 595 ;; model-bar takes the bar grob, if given. |
505 (let* ((bar (ly:grob-array-ref elts i)) | 596 (map (lambda (bar) |
506 (ext (bar-line::bar-y-extent bar refp)) | 597 (let* ((ext (bar-line::bar-y-extent bar refp)) |
507 (staff-symbol (ly:grob-object bar 'staff-symbol))) | 598 (staff-symbol (ly:grob-object bar 'staff-symbol))) |
508 | 599 |
509 (if (ly:grob? staff-symbol) | 600 (if (ly:grob? staff-symbol) |
510 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) | 601 (let ((refp-extent (ly:grob-extent staff-symbol
refp Y))) |
511 | 602 |
512 (set! ext (cons (min (car ext) (car refp-ex
tent)) | 603 (set! ext (interval-union ext refp-extent)
) |
513 (max (cdr ext) (cdr refp-ex
tent)))) | 604 |
514 | 605 (if (> (interval-length ext) 0) |
515 (if (> (interval-length ext) 0) | 606 (begin |
516 (begin | 607 (set! extents (append extents (list
ext))) |
517 (set! extents (vector-extend extents
ext)) | 608 (set! model-bar bar) |
518 (set! make-span-bar (vector-extend ma
ke-span-bar | 609 (set! make-span-bars |
519 (ly:grob-property bar
'allow-span-bar))) | 610 (append make-span-bars |
520 (set! model-bar bar))))))) | 611 (list (ly:grob-property ba
r 'allow-span-bar #t)))))))))) |
521 | 612 elts) |
| 613 ;; if there is no bar grob, we use the callback argument |
522 (if (not model-bar) | 614 (if (not model-bar) |
523 (set! model-bar grob)) | 615 (set! model-bar grob)) |
524 | 616 ;; we discard the first entry in make-span-bars, because its c
orresponding |
525 (do ((i 1 (1+ i))) | 617 ;; bar line is the uppermost and therefore not connected to an
other bar line |
526 ((> i (1- (vector-length extents)))) | 618 (if (pair? make-span-bars) |
527 (let ((prev-extent (vector-ref extents (1- i))) | 619 (set! make-span-bars (cdr make-span-bars))) |
528 (curr-extent (vector-ref extents i)) | 620 ;; the span bar reaches from the lower end of the upper staff |
529 (l (cons 0 0))) | 621 ;; to the upper end of the lower staff - when allow-span-bar i
s #t |
530 | 622 (reduce (lambda (curr prev) |
531 (if (> (interval-length prev-extent) 0) | 623 (let ((l (cons 0 0)) |
532 (begin | 624 (allow-span-bar (car make-span-bars))) |
533 (set! l (cons (cdr prev-extent) | 625 |
534 (car curr-extent))) | 626 (set! make-span-bars (cdr make-span-bars)
) |
535 (if (or (zero? (interval-length l)) | 627 (if (> (interval-length prev) 0) |
536 (not (vector-ref make-span-bar i))) | 628 (begin |
537 (begin | 629 (set! l (cons (cdr prev) (car curr)
)) |
538 ;; There is overlap between the bar lines
. Do nothing. | 630 (if (or (zero? (interval-length l)) |
539 ) | 631 (not allow-span-bar)) |
540 (set! span-bar | 632 (begin |
541 (ly:stencil-add | 633 ;; there is overlap between t
he bar lines |
542 span-bar | 634 ;; or 'allow-span-bar = #f. |
543 (bar-line::compound-bar-line model-bar
glyph l #f)))))))) | 635 ;; Do nothing. |
| 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) |
544 (set! span-bar (ly:stencil-translate-axis | 646 (set! span-bar (ly:stencil-translate-axis |
545 span-bar | 647 span-bar |
546 (- (ly:grob-relative-coordinate grob refp Y)) | 648 (- (ly:grob-relative-coordinate grob refp Y)) |
547 Y)))) | 649 Y)))) |
548 span-bar)) | 650 span-bar)) |
LEFT | RIGHT |