Rietveld Code Review Tool
Help | Bug tracker | Discussion group | Source code | Sign in
(20)

Side by Side Diff: scm/time-signature-settings.scm

Issue 6814080: Applies scheme indentation according to the GNU guidelines (Closed) Base URL: http://git.savannah.gnu.org/gitweb/?p=lilypond.git/trunk/
Patch Set: Created 12 years, 5 months ago
Left:
Right:
Use n/p to move between diff chunks; N/P to move between comments. Please Sign in to add in-line comments.
Jump to:
View unified diff | Download patch
OLDNEW
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
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
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)))))
OLDNEW
« scm/define-music-types.scm ('K') | « scm/text.scm ('k') | scm/titling.scm » ('j') | no next file with comments »

Powered by Google App Engine
RSS Feeds Recent Issues | This issue
This is Rietveld f62528b