OLD | NEW |
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 Carl Sorensen <c_sorensen@byu.edu> | 3 ;;;; Copyright (C) 2009--2012 Carl Sorensen <c_sorensen@byu.edu> |
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, |
(...skipping 53 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
64 ;;; NOTE: numerator is kept in beam-type because of | 64 ;;; NOTE: numerator is kept in beam-type because of |
65 ;;; tuplets, e.g. (2 . 24) = (2 . 3) * (1 . 8) | 65 ;;; tuplets, e.g. (2 . 24) = (2 . 3) * (1 . 8) |
66 ;;; for eighth-note triplets. | 66 ;;; for eighth-note triplets. |
67 ;;; | 67 ;;; |
68 | 68 |
69 (define-public default-time-signature-settings | 69 (define-public default-time-signature-settings |
70 '( | 70 '( |
71 ;; in 2/2 time: | 71 ;; in 2/2 time: |
72 ;; use defaults, but end beams with 32nd notes each 1 4 beat | 72 ;; use defaults, but end beams with 32nd notes each 1 4 beat |
73 ((2 . 2) . | 73 ((2 . 2) . |
74 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8)))))))) | 74 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8)))))))) |
75 | 75 |
76 ;; in 2/4, 2/8 and 2/16 time: | 76 ;; in 2/4, 2/8 and 2/16 time: |
77 ;; use defaults, so no entries are necessary | 77 ;; use defaults, so no entries are necessary |
78 | 78 |
79 ;; in 3 2 time: | 79 ;; in 3 2 time: |
80 ;; use defaults, but end beams with 32nd notes and higher each 1 4 beat | 80 ;; use defaults, but end beams with 32nd notes and higher each 1 4 beat |
81 | 81 |
82 ((3 . 2) . | 82 ((3 . 2) . |
83 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8)))))))) | 83 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8)))))))) |
84 | 84 |
85 ;; in 3 4 time: | 85 ;; in 3 4 time: |
86 ;; use defaults, but combine all beats into a unit if possible | 86 ;; use defaults, but combine all beats into a unit if possible |
87 ;; | 87 ;; |
88 ;; set all beams to end on beats, but 1 8 to beam entire measure | 88 ;; set all beams to end on beats, but 1 8 to beam entire measure |
89 ;; in order to avoid beaming every beam type for the entire measure, we se
t | 89 ;; in order to avoid beaming every beam type for the entire measure, we se
t |
90 ;; triplets back to every beat. | 90 ;; triplets back to every beat. |
91 ((3 . 4) . | 91 ((3 . 4) . |
92 ((beamExceptions . ((end . (((1 . 8) . (6)) ;1/8 note wh
ole measure | 92 ((beamExceptions . ((end . (((1 . 8) . (6)) ;1/8 note whole meas
ure |
93 ((1 . 12) . (3 3 3)))))))) ;Anything sh
orter by beat | 93 ((1 . 12) . (3 3 3)))))))) ;Anything shorter by
beat |
94 | 94 |
95 ;; in 3 8 time: | 95 ;; in 3 8 time: |
96 ;; beam entire measure together | 96 ;; beam entire measure together |
97 ((3 . 8) . ((beamExceptions . ((end . (((1 . 8) . (3)))))))) | 97 ((3 . 8) . ((beamExceptions . ((end . (((1 . 8) . (3)))))))) |
98 | 98 |
99 ;; in 3 16 time: | 99 ;; in 3 16 time: |
100 ;; use defaults -- no entries necessary | 100 ;; use defaults -- no entries necessary |
101 | 101 |
102 ;; in 4 2 time: | 102 ;; in 4 2 time: |
103 ;; use defaults, but end beams with 16th notes or finer each 1 4 beat | 103 ;; use defaults, but end beams with 16th notes or finer each 1 4 beat |
104 ((4 . 2) . | 104 ((4 . 2) . |
105 ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4 4 4)))))))) | 105 ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4 4 4)))))))) |
106 | 106 |
107 ;; in 4 4 (common) time: | 107 ;; in 4 4 (common) time: |
108 ;; use defaults, but combine beats 1,2 and 3,4 if only 8th notes | 108 ;; use defaults, but combine beats 1,2 and 3,4 if only 8th notes |
109 ;; NOTE: Any changes here need to be duplicated in | 109 ;; NOTE: Any changes here need to be duplicated in |
110 ;; ly/engraver-init.ly where the default time signature is set | 110 ;; ly/engraver-init.ly where the default time signature is set |
111 ;; are set | 111 ;; are set |
112 ((4 . 4) . | 112 ((4 . 4) . |
113 ((beamExceptions . ((end . (((1 . 8) . (4 4)) ; 1/8 notes half mea
sure | 113 ((beamExceptions . ((end . (((1 . 8) . (4 4)) ; 1/8 notes half measure |
114 ((1 . 12) . (3 3 3 3)))))))) ;Anything
shorter by beat | 114 ((1 . 12) . (3 3 3 3)))))))) ;Anything shorter
by beat |
115 | 115 |
116 ;; in 4/8 time: | 116 ;; in 4/8 time: |
117 ;; combine beats 1 and 2, so beam in 2 | 117 ;; combine beats 1 and 2, so beam in 2 |
118 ((4 . 8) . ((beatStructure . (2 2)))) | 118 ((4 . 8) . ((beatStructure . (2 2)))) |
119 | 119 |
120 ;; in 4/16 time: | 120 ;; in 4/16 time: |
121 ;; use defaults, so no entries necessary | 121 ;; use defaults, so no entries necessary |
122 | 122 |
123 ;; in 6 4 time: | 123 ;; in 6 4 time: |
124 ;; use defaults, but end beams with 32nd or finer each 1/4 beat | 124 ;; use defaults, but end beams with 32nd or finer each 1/4 beat |
125 ((6 . 4) . | 125 ((6 . 4) . |
126 ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4)))))))) | 126 ((beamExceptions . ((end . (((1 . 16) . (4 4 4 4 4 4)))))))) |
127 | 127 |
128 ;; in 6 8 time: | 128 ;; in 6 8 time: |
129 ;; use defaults, so no entries necessary | 129 ;; use defaults, so no entries necessary |
130 | 130 |
131 ;; in 6 16 time: | 131 ;; in 6 16 time: |
132 ;; use defaults, so no entries necessary | 132 ;; use defaults, so no entries necessary |
133 | 133 |
134 ;; in 9 4 time: | 134 ;; in 9 4 time: |
135 ;; use defaults, but end beams with 32nd or finer each 1 4 beat | 135 ;; use defaults, but end beams with 32nd or finer each 1 4 beat |
136 ((9 . 4) . | 136 ((9 . 4) . |
137 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8)))))))) | 137 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8)))))))) |
138 | 138 |
139 ;; in 9 8 time | 139 ;; in 9 8 time |
140 ;; use defaults, so no entries necessary | 140 ;; use defaults, so no entries necessary |
141 | 141 |
142 ;; in 9 16 time | 142 ;; in 9 16 time |
143 ;; use defaults, so no entries necessary | 143 ;; use defaults, so no entries necessary |
144 | 144 |
145 ;; in 12 4 time: | 145 ;; in 12 4 time: |
146 ;; use defaults, but end beams with 32nd or finer notes each 1 4 beat | 146 ;; use defaults, but end beams with 32nd or finer notes each 1 4 beat |
147 ((12 . 4) . | 147 ((12 . 4) . |
148 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8 8 8 8 8))
)))))) | 148 ((beamExceptions . ((end . (((1 . 32) . (8 8 8 8 8 8 8 8 8 8 8 8)))))))) |
149 | 149 |
150 ;; in 12 8 time: | 150 ;; in 12 8 time: |
151 ;; use defaults, so no entries necessary | 151 ;; use defaults, so no entries necessary |
152 | 152 |
153 ;; in 12 16 time: | 153 ;; in 12 16 time: |
154 ;; use defaults, so no entries necessary | 154 ;; use defaults, so no entries necessary |
155 | 155 |
156 ;; in 5 8 time: | 156 ;; in 5 8 time: |
157 ;; default: group (3 2) | 157 ;; default: group (3 2) |
158 ((5 . 8) . | 158 ((5 . 8) . |
159 ((beatStructure . (3 2)))) | 159 ((beatStructure . (3 2)))) |
160 | 160 |
161 ;; in 8 8 time: | 161 ;; in 8 8 time: |
162 ;; default: group (3 3 2) | 162 ;; default: group (3 3 2) |
163 ((8 . 8) . | 163 ((8 . 8) . |
164 ((beatStructure . (3 3 2)))) | 164 ((beatStructure . (3 3 2)))) |
165 | 165 |
166 )) ; end of alist definition | 166 )) ; end of alist definition |
167 | 167 |
168 ;;; | 168 ;;; |
169 ;;; Accessor and constructor functions | 169 ;;; Accessor and constructor functions |
170 ;;; | 170 ;;; |
171 | 171 |
172 (define (get-setting my-symbol time-signature time-signature-settings) | 172 (define (get-setting my-symbol time-signature time-signature-settings) |
173 "Get setting @code{my-symbol} for @code{time-signature} from | 173 "Get setting @code{my-symbol} for @code{time-signature} from |
174 @code{time-signature-settings}." | 174 @code{time-signature-settings}." |
175 (let ((my-time-signature-settings | 175 (let ((my-time-signature-settings |
176 (assoc-get time-signature time-signature-settings '()))) | 176 (assoc-get time-signature time-signature-settings '()))) |
177 (assoc-get my-symbol my-time-signature-settings '()))) | 177 (assoc-get my-symbol my-time-signature-settings '()))) |
178 | 178 |
179 (define-public (make-setting base-fraction | 179 (define-public (make-setting base-fraction |
180 beat-structure | 180 beat-structure |
181 beam-exceptions) | 181 beam-exceptions) |
182 (list | 182 (list |
183 (cons 'baseMoment base-fraction) | 183 (cons 'baseMoment base-fraction) |
184 (cons 'beatStructure beat-structure) | 184 (cons 'beatStructure beat-structure) |
185 (cons 'beamExceptions beam-exceptions))) | 185 (cons 'beamExceptions beam-exceptions))) |
186 | 186 |
187 (define-public (base-fraction time-signature time-signature-settings) | 187 (define-public (base-fraction time-signature time-signature-settings) |
188 "Get @code{baseMoment} fraction value for @var{time-signature} from | 188 "Get @code{baseMoment} fraction value for @var{time-signature} from |
189 @var{time-signature-settings}." | 189 @var{time-signature-settings}." |
190 (let ((return-value (get-setting 'baseMoment | 190 (let ((return-value (get-setting 'baseMoment |
191 time-signature | 191 time-signature |
192 time-signature-settings))) | 192 time-signature-settings))) |
193 (if (null? return-value) | 193 (if (null? return-value) |
194 (cons 1 (cdr time-signature)) | 194 (cons 1 (cdr time-signature)) |
195 return-value))) | 195 return-value))) |
196 | 196 |
197 (define-public (beat-structure base-fraction time-signature time-signature-setti
ngs) | 197 (define-public (beat-structure base-fraction time-signature time-signature-setti
ngs) |
198 "Get @code{beatStructure} value in @var{base-fraction} units | 198 "Get @code{beatStructure} value in @var{base-fraction} units |
199 for @var{time-signature} from @var{time-signature-settings}." | 199 for @var{time-signature} from @var{time-signature-settings}." |
200 (define (fraction-divide numerator denominator) | 200 (define (fraction-divide numerator denominator) |
201 (/ (* (car numerator) (cdr denominator)) | 201 (/ (* (car numerator) (cdr denominator)) |
202 (* (cdr numerator) (car denominator)))) | 202 (* (cdr numerator) (car denominator)))) |
203 | 203 |
204 (let ((return-value (get-setting 'beatStructure | 204 (let ((return-value (get-setting 'beatStructure |
205 time-signature | 205 time-signature |
(...skipping 10 matching lines...) Expand all Loading... |
216 (beat-count (fraction-divide time-signature beat-length))) | 216 (beat-count (fraction-divide time-signature beat-length))) |
217 (if (integer? beat-count) | 217 (if (integer? beat-count) |
218 (make-list beat-count group-size) | 218 (make-list beat-count group-size) |
219 '())) | 219 '())) |
220 ;; use value obtained from time-signature-settings | 220 ;; use value obtained from time-signature-settings |
221 return-value))) | 221 return-value))) |
222 | 222 |
223 (define-public (beam-exceptions time-signature time-signature-settings) | 223 (define-public (beam-exceptions time-signature time-signature-settings) |
224 "Get @code{beamExceptions} value for @var{time-signature} from | 224 "Get @code{beamExceptions} value for @var{time-signature} from |
225 @var{time-signature-settings}." | 225 @var{time-signature-settings}." |
226 (get-setting 'beamExceptions time-signature time-signature-settings)) | 226 (get-setting 'beamExceptions time-signature time-signature-settings)) |
227 | 227 |
228 | 228 |
229 ;;; Functions for overriding time-signature settings | 229 ;;; Functions for overriding time-signature settings |
230 ;;; | 230 ;;; |
231 | 231 |
232 (define (override-property-setting context property setting value) | 232 (define (override-property-setting context property setting value) |
233 "Like the C++ code that executes \\override, but without type | 233 "Like the C++ code that executes \\override, but without type |
234 checking." | 234 checking." |
235 (begin | 235 (begin |
236 (ly:context-set-property! | 236 (ly:context-set-property! |
237 context | 237 context |
238 property | 238 property |
239 (cons (cons setting value) (ly:context-property context property))))) | 239 (cons (cons setting value) (ly:context-property context property))))) |
240 | 240 |
241 (define (revert-property-setting context property setting) | 241 (define (revert-property-setting context property setting) |
242 "Like the C++ code that executes \revert, but without type | 242 "Like the C++ code that executes \revert, but without type |
243 checking." | 243 checking." |
244 | 244 |
245 (define (entry-count alist entry-key) | 245 (define (entry-count alist entry-key) |
246 "Count the number of entries in alist with a key of | 246 "Count the number of entries in alist with a key of |
247 ENTRY-KEY." | 247 ENTRY-KEY." |
248 (cond | 248 (cond |
249 ((null? alist) 0) | 249 ((null? alist) 0) |
250 ((equal? (caar alist) entry-key) | 250 ((equal? (caar alist) entry-key) |
251 (+ 1 (entry-count (cdr alist) entry-key))) | 251 (+ 1 (entry-count (cdr alist) entry-key))) |
252 (else (entry-count (cdr alist) entry-key)))) | 252 (else (entry-count (cdr alist) entry-key)))) |
253 | 253 |
254 (define (revert-member alist entry-key) | 254 (define (revert-member alist entry-key) |
255 "Return ALIST, with the first entry having a key of | 255 "Return ALIST, with the first entry having a key of |
256 ENTRY-KEY removed. ALIST is not modified, instead | 256 ENTRY-KEY removed. ALIST is not modified, instead |
257 a fresh copy of the list-head is made." | 257 a fresh copy of the list-head is made." |
258 (cond | 258 (cond |
259 ((null? alist) '()) | 259 ((null? alist) '()) |
260 ((equal? (caar alist) entry-key) (cdr alist)) | 260 ((equal? (caar alist) entry-key) (cdr alist)) |
261 (else (cons (car alist) | 261 (else (cons (car alist) |
262 (revert-member (cdr alist) entry-key))))) | 262 (revert-member (cdr alist) entry-key))))) |
263 | 263 |
264 ;; body of revert-property-setting | 264 ;; body of revert-property-setting |
265 (let ((current-value (ly:context-property context property))) | 265 (let ((current-value (ly:context-property context property))) |
266 (if (> (entry-count current-value setting) 0) | 266 (if (> (entry-count current-value setting) 0) |
267 (ly:context-set-property! | 267 (ly:context-set-property! |
268 context | 268 context |
269 property | 269 property |
270 (revert-member current-value setting))))) | 270 (revert-member current-value setting))))) |
271 | 271 |
272 (define-public (override-time-signature-setting time-signature setting) | 272 (define-public (override-time-signature-setting time-signature setting) |
273 "Override the time signature settings for the context in | 273 "Override the time signature settings for the context in |
274 @var{time-signature}, with the new setting alist @var{setting}." | 274 @var{time-signature}, with the new setting alist @var{setting}." |
275 (context-spec-music | 275 (context-spec-music |
276 (make-apply-context | 276 (make-apply-context |
277 (lambda (c) (override-property-setting | 277 (lambda (c) (override-property-setting |
278 c | 278 c |
279 'timeSignatureSettings | 279 'timeSignatureSettings |
280 time-signature | 280 time-signature |
281 setting))) | 281 setting))) |
282 'Timing)) | 282 'Timing)) |
283 | 283 |
284 (define-public (revert-time-signature-setting time-signature) | 284 (define-public (revert-time-signature-setting time-signature) |
285 (context-spec-music | 285 (context-spec-music |
286 (make-apply-context | 286 (make-apply-context |
287 (lambda (c) | 287 (lambda (c) |
288 (revert-property-setting | 288 (revert-property-setting |
289 c | 289 c |
290 'timeSignatureSettings | 290 'timeSignatureSettings |
291 time-signature))) | 291 time-signature))) |
292 'Timing)) | 292 'Timing)) |
293 | 293 |
294 | 294 |
295 | 295 |
296 | 296 |
297 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 297 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
298 ;;; Formatting of complex/compound time signatures | 298 ;;; Formatting of complex/compound time signatures |
299 | 299 |
300 (define (insert-markups l m) | 300 (define (insert-markups l m) |
301 (let ((ll (reverse l))) | 301 (let ((ll (reverse l))) |
302 (let join-markups ((markups (list (car ll))) | 302 (let join-markups ((markups (list (car ll))) |
303 (remaining (cdr ll))) | 303 (remaining (cdr ll))) |
304 (if (pair? remaining) | 304 (if (pair? remaining) |
305 (join-markups (cons (car remaining) (cons m markups)) (cdr remaining)) | 305 (join-markups (cons (car remaining) (cons m markups)) (cdr remaining)) |
306 markups)))) | 306 markups)))) |
307 | 307 |
308 ;;; Use a centered-column inside a left-column, because the centered column | 308 ;;; Use a centered-column inside a left-column, because the centered column |
309 ;;; moves its reference point to the center, which the left-column undoes. | 309 ;;; moves its reference point to the center, which the left-column undoes. |
310 (define (format-time-fraction time-sig-fraction) | 310 (define (format-time-fraction time-sig-fraction) |
311 (let* ((revargs (reverse (map number->string time-sig-fraction))) | 311 (let* ((revargs (reverse (map number->string time-sig-fraction))) |
312 (den (car revargs)) | 312 (den (car revargs)) |
313 (nums (reverse (cdr revargs)))) | 313 (nums (reverse (cdr revargs)))) |
314 (make-override-markup '(baseline-skip . 0) | 314 (make-override-markup '(baseline-skip . 0) |
315 (make-number-markup | 315 (make-number-markup |
316 (make-left-column-markup (list | 316 (make-left-column-markup (list |
317 (make-center-column-markup (list | 317 (make-center-column-markup
(list |
318 (make-line-markup (insert-markups nums "+")) | 318
(make-line-markup (insert-markups nums "+")) |
319 den)))))))) | 319
den)))))))) |
320 | 320 |
321 (define (format-complex-compound-time time-sig) | 321 (define (format-complex-compound-time time-sig) |
322 (make-override-markup '(baseline-skip . 0) | 322 (make-override-markup '(baseline-skip . 0) |
323 (make-number-markup | 323 (make-number-markup |
324 (make-line-markup | 324 (make-line-markup |
325 (insert-markups (map format-time-fraction time-sig) | 325 (insert-markups (map format-time-fraction time-sig) |
326 (make-vcenter-markup "+")))))) | 326 (make-vcenter-markup "+")))))) |
327 | 327 |
328 (define-public (format-compound-time time-sig) | 328 (define-public (format-compound-time time-sig) |
329 (cond | 329 (cond |
330 ((not (pair? time-sig)) (null-markup)) | 330 ((not (pair? time-sig)) (null-markup)) |
331 ((pair? (car time-sig)) (format-complex-compound-time time-sig)) | 331 ((pair? (car time-sig)) (format-complex-compound-time time-sig)) |
332 (else (format-time-fraction time-sig)))) | 332 (else (format-time-fraction time-sig)))) |
333 | 333 |
334 | 334 |
335 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 335 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
336 ;;; Measure length calculation of (possibly complex) compound time signatures | 336 ;;; Measure length calculation of (possibly complex) compound time signatures |
337 | 337 |
338 (define (calculate-time-fraction time-sig-fraction) | 338 (define (calculate-time-fraction time-sig-fraction) |
339 (let* ((revargs (reverse time-sig-fraction)) | 339 (let* ((revargs (reverse time-sig-fraction)) |
340 (den (car revargs)) | 340 (den (car revargs)) |
341 (num (apply + (cdr revargs)))) | 341 (num (apply + (cdr revargs)))) |
342 (ly:make-moment num den))) | 342 (ly:make-moment num den))) |
343 | 343 |
344 (define (calculate-complex-compound-time time-sig) | 344 (define (calculate-complex-compound-time time-sig) |
345 (let add-moment ((moment ZERO-MOMENT) | 345 (let add-moment ((moment ZERO-MOMENT) |
346 (remaining (map calculate-time-fraction time-sig))) | 346 (remaining (map calculate-time-fraction time-sig))) |
347 (if (pair? remaining) | 347 (if (pair? remaining) |
348 (add-moment (ly:moment-add moment (car remaining)) (cdr remaining)) | 348 (add-moment (ly:moment-add moment (car remaining)) (cdr remaining)) |
349 moment))) | 349 moment))) |
350 | 350 |
351 (define-public (calculate-compound-measure-length time-sig) | 351 (define-public (calculate-compound-measure-length time-sig) |
352 (cond | 352 (cond |
353 ((not (pair? time-sig)) (ly:make-moment 4 4)) | 353 ((not (pair? time-sig)) (ly:make-moment 4 4)) |
354 ((pair? (car time-sig)) (calculate-complex-compound-time time-sig)) | 354 ((pair? (car time-sig)) (calculate-complex-compound-time time-sig)) |
355 (else (calculate-time-fraction time-sig)))) | 355 (else (calculate-time-fraction time-sig)))) |
356 | 356 |
357 | 357 |
358 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 358 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
359 ;;; Base beat length: Use the smallest denominator from all fraction | 359 ;;; Base beat length: Use the smallest denominator from all fraction |
360 | 360 |
361 (define (calculate-compound-base-beat-full time-sig) | 361 (define (calculate-compound-base-beat-full time-sig) |
362 (apply max (map last time-sig))) | 362 (apply max (map last time-sig))) |
363 | 363 |
364 (define-public (calculate-compound-base-beat time-sig) | 364 (define-public (calculate-compound-base-beat time-sig) |
365 (ly:make-moment 1 | 365 (ly:make-moment 1 |
366 (cond | 366 (cond |
367 ((not (pair? time-sig)) 4) | 367 ((not (pair? time-sig)) 4) |
368 ((pair? (car time-sig)) (calculate-compound-base-beat-full time-sig)) | 368 ((pair? (car time-sig)) (calculate-compound-base-beat-full ti
me-sig)) |
369 (else (calculate-compound-base-beat-full (list time-sig)))))) | 369 (else (calculate-compound-base-beat-full (list time-sig)))))) |
370 | 370 |
371 | 371 |
372 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 372 ;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% |
373 ;;; Beat Grouping | 373 ;;; Beat Grouping |
374 | 374 |
375 (define (normalize-fraction frac beat) | 375 (define (normalize-fraction frac beat) |
376 (let* ((thisbeat (car (reverse frac))) | 376 (let* ((thisbeat (car (reverse frac))) |
377 (factor (/ beat thisbeat))) | 377 (factor (/ beat thisbeat))) |
378 (map (lambda (f) (* factor f)) frac))) | 378 (map (lambda (f) (* factor f)) frac))) |
379 | 379 |
380 (define (beat-grouping-internal time-sig) | 380 (define (beat-grouping-internal time-sig) |
381 ;; Normalize to given beat, extract the beats and join them to one list | 381 ;; Normalize to given beat, extract the beats and join them to one list |
382 (let* ((beat (calculate-compound-base-beat-full time-sig)) | 382 (let* ((beat (calculate-compound-base-beat-full time-sig)) |
383 (normalized (map (lambda (f) (normalize-fraction f beat)) time-sig)) | 383 (normalized (map (lambda (f) (normalize-fraction f beat)) time-sig)) |
384 (beats (map (lambda (f) (reverse (cdr (reverse f)))) normalized))) | 384 (beats (map (lambda (f) (reverse (cdr (reverse f)))) normalized))) |
385 (apply append beats))) | 385 (apply append beats))) |
386 | 386 |
387 (define-public (calculate-compound-beat-grouping time-sig) | 387 (define-public (calculate-compound-beat-grouping time-sig) |
388 (cond | 388 (cond |
389 ((not (pair? time-sig)) '(2 . 2)) | 389 ((not (pair? time-sig)) '(2 . 2)) |
390 ((pair? (car time-sig)) (beat-grouping-internal time-sig)) | 390 ((pair? (car time-sig)) (beat-grouping-internal time-sig)) |
391 (else (beat-grouping-internal (list time-sig))))) | 391 (else (beat-grouping-internal (list time-sig))))) |
OLD | NEW |