OLD | NEW |
1 ;;;; music-functions.scm -- | 1 ;;;; music-functions.scm -- |
2 ;;;; | 2 ;;;; |
3 ;;;; source file of the GNU LilyPond music typesetter | 3 ;;;; source file of the GNU LilyPond music typesetter |
4 ;;;; | 4 ;;;; |
5 ;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org> | 5 ;;;; (c) 1998--2009 Jan Nieuwenhuizen <janneke@gnu.org> |
6 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> | 6 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl> |
7 | 7 |
8 ;; (use-modules (ice-9 optargs)) | 8 ;; (use-modules (ice-9 optargs)) |
9 | 9 |
10 ;;; ly:music-property with setter | 10 ;;; ly:music-property with setter |
11 ;;; (ly:music-property my-music 'elements) | 11 ;;; (ly:music-property my-music 'elements) |
12 ;;; ==> the 'elements property | 12 ;;; ==> the 'elements property |
13 ;;; (set! (ly:music-property my-music 'elements) value) | 13 ;;; (set! (ly:music-property my-music 'elements) value) |
14 ;;; ==> set the 'elements property and return it | 14 ;;; ==> set the 'elements property and return it |
15 (define-public ly:music-property | 15 (define-public ly:music-property |
16 (make-procedure-with-setter ly:music-property | 16 (make-procedure-with-setter ly:music-property |
17 ly:music-set-property!)) | 17 ly:music-set-property!)) |
18 | 18 |
(...skipping 10 matching lines...) Expand all Loading... |
29 (make-procedure-with-setter ly:prob-property | 29 (make-procedure-with-setter ly:prob-property |
30 ly:prob-set-property!)) | 30 ly:prob-set-property!)) |
31 | 31 |
32 (define-public (music-map function music) | 32 (define-public (music-map function music) |
33 "Apply @var{function} to @var{music} and all of the music it contains. | 33 "Apply @var{function} to @var{music} and all of the music it contains. |
34 | 34 |
35 First it recurses over the children, then the function is applied to MUSIC. | 35 First it recurses over the children, then the function is applied to MUSIC. |
36 " | 36 " |
37 (let ((es (ly:music-property music 'elements)) | 37 (let ((es (ly:music-property music 'elements)) |
38 (e (ly:music-property music 'element))) | 38 (e (ly:music-property music 'element))) |
39 (set! (ly:music-property music 'elements) | 39 (set! (ly:music-property music 'elements) |
40 (map (lambda (y) (music-map function y)) es)) | 40 (map (lambda (y) (music-map function y)) es)) |
41 (if (ly:music? e) | 41 (if (ly:music? e) |
42 (set! (ly:music-property music 'element) | 42 (set! (ly:music-property music 'element) |
43 (music-map function e))) | 43 (music-map function e))) |
44 (function music))) | 44 (function music))) |
45 | 45 |
46 (define-public (music-filter pred? music) | 46 (define-public (music-filter pred? music) |
47 "Filter out music expressions that do not satisfy PRED." | 47 "Filter out music expressions that do not satisfy PRED." |
48 | 48 |
49 (define (inner-music-filter pred? music) | 49 (define (inner-music-filter pred? music) |
50 "Recursive function." | 50 "Recursive function." |
51 (let* ((es (ly:music-property music 'elements)) | 51 (let* ((es (ly:music-property music 'elements)) |
52 (e (ly:music-property music 'element)) | 52 (e (ly:music-property music 'element)) |
53 (as (ly:music-property music 'articulations)) | 53 (as (ly:music-property music 'articulations)) |
54 (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter p
red? y)) as))) | 54 (filtered-as (filter ly:music? (map (lambda (y) (inner-music-filter p
red? y)) as))) |
55 (filtered-e (if (ly:music? e) | 55 (filtered-e (if (ly:music? e) |
56 (inner-music-filter pred? e) | 56 (inner-music-filter pred? e) |
57 e)) | 57 e)) |
58 (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter p
red? y)) es)))) | 58 (filtered-es (filter ly:music? (map (lambda (y) (inner-music-filter p
red? y)) es)))) |
(...skipping 10 matching lines...) Expand all Loading... |
69 | 69 |
70 (set! music (inner-music-filter pred? music)) | 70 (set! music (inner-music-filter pred? music)) |
71 (if (ly:music? music) | 71 (if (ly:music? music) |
72 music | 72 music |
73 (make-music 'Music))) ;must return music. | 73 (make-music 'Music))) ;must return music. |
74 | 74 |
75 (define-public (display-music music) | 75 (define-public (display-music music) |
76 "Display music, not done with music-map for clarity of presentation." | 76 "Display music, not done with music-map for clarity of presentation." |
77 | 77 |
78 (display music) | 78 (display music) |
79 (display ": { ") | 79 (display ": { ") |
80 (let ((es (ly:music-property music 'elements)) | 80 (let ((es (ly:music-property music 'elements)) |
81 (e (ly:music-property music 'element))) | 81 (e (ly:music-property music 'element))) |
82 (display (ly:music-mutable-properties music)) | 82 (display (ly:music-mutable-properties music)) |
83 (if (pair? es) | 83 (if (pair? es) |
84 (begin (display "\nElements: {\n") | 84 (begin (display "\nElements: {\n") |
85 (map display-music es) | 85 (map display-music es) |
86 (display "}\n"))) | 86 (display "}\n"))) |
87 (if (ly:music? e) | 87 (if (ly:music? e) |
88 (begin | 88 (begin |
89 (display "\nChild:") | 89 (display "\nChild:") |
90 (display-music e)))) | 90 (display-music e)))) |
91 (display " }\n") | 91 (display " }\n") |
92 music) | 92 music) |
93 | 93 |
94 ;;; | 94 ;;; |
95 ;;; A scheme music pretty printer | 95 ;;; A scheme music pretty printer |
96 ;;; | 96 ;;; |
97 (define (markup-expression->make-markup markup-expression) | 97 (define (markup-expression->make-markup markup-expression) |
98 "Transform `markup-expression' into an equivalent, hopefuly readable, scheme e
xpression. | 98 "Transform `markup-expression' into an equivalent, hopefuly readable, scheme e
xpression. |
99 For instance, | 99 For instance, |
100 \\markup \\bold \\italic hello | 100 \\markup \\bold \\italic hello |
101 ==> | 101 ==> |
102 (markup #:line (#:bold (#:italic (#:simple \"hello\"))))" | 102 (markup #:line (#:bold (#:italic (#:simple \"hello\"))))" |
103 (define (proc->command-keyword proc) | 103 (define (proc->command-keyword proc) |
104 "Return a keyword, eg. `#:bold', from the `proc' function, eg. #<procedure b
old-markup (layout props arg)>" | 104 "Return a keyword, eg. `#:bold', from the `proc' function, eg. #<procedure b
old-markup (layout props arg)>" |
105 (let ((cmd-markup (symbol->string (procedure-name proc)))) | 105 (let ((cmd-markup (symbol->string (procedure-name proc)))) |
106 (symbol->keyword (string->symbol (substring cmd-markup 0 (- (string-length
cmd-markup) | 106 (symbol->keyword (string->symbol (substring cmd-markup 0 (- (string-length
cmd-markup) |
107 (string-length
"-markup"))))))) | 107 (string-length
"-markup"))))))) |
108 (define (transform-arg arg) | 108 (define (transform-arg arg) |
109 (cond ((and (pair? arg) (markup? (car arg))) ;; a markup list | 109 (cond ((and (pair? arg) (markup? (car arg))) ;; a markup list |
(...skipping 14 matching lines...) Expand all Loading... |
124 `(markup ,@(inner-markup->make-markup markup-expression)))) | 124 `(markup ,@(inner-markup->make-markup markup-expression)))) |
125 | 125 |
126 (define-public (music->make-music obj) | 126 (define-public (music->make-music obj) |
127 "Generate a expression that, once evaluated, may return an object equivalent t
o `obj', | 127 "Generate a expression that, once evaluated, may return an object equivalent t
o `obj', |
128 that is, for a music expression, a (make-music ...) form." | 128 that is, for a music expression, a (make-music ...) form." |
129 (cond (;; markup expression | 129 (cond (;; markup expression |
130 (markup? obj) | 130 (markup? obj) |
131 (markup-expression->make-markup obj)) | 131 (markup-expression->make-markup obj)) |
132 (;; music expression | 132 (;; music expression |
133 (ly:music? obj) | 133 (ly:music? obj) |
134 » `(make-music | 134 » `(make-music |
135 ',(ly:music-property obj 'name) | 135 ',(ly:music-property obj 'name) |
136 ,@(apply append (map (lambda (prop) | 136 ,@(apply append (map (lambda (prop) |
137 `(',(car prop) | 137 `(',(car prop) |
138 ,(music->make-music (cdr prop)))) | 138 ,(music->make-music (cdr prop)))) |
139 (remove (lambda (prop) | 139 (remove (lambda (prop) |
140 (eqv? (car prop) 'origin)) | 140 (eqv? (car prop) 'origin)) |
141 (ly:music-mutable-properties obj)))))) | 141 (ly:music-mutable-properties obj)))))) |
142 (;; moment | 142 (;; moment |
143 (ly:moment? obj) | 143 (ly:moment? obj) |
144 `(ly:make-moment ,(ly:moment-main-numerator obj) | 144 `(ly:make-moment ,(ly:moment-main-numerator obj) |
(...skipping 18 matching lines...) Expand all Loading... |
163 (symbol? obj) | 163 (symbol? obj) |
164 `',obj) | 164 `',obj) |
165 (;; an empty list (avoid having an unquoted empty list) | 165 (;; an empty list (avoid having an unquoted empty list) |
166 (null? obj) | 166 (null? obj) |
167 `'()) | 167 `'()) |
168 (;; a proper list | 168 (;; a proper list |
169 (list? obj) | 169 (list? obj) |
170 `(list ,@(map music->make-music obj))) | 170 `(list ,@(map music->make-music obj))) |
171 (;; a pair | 171 (;; a pair |
172 (pair? obj) | 172 (pair? obj) |
173 » `(cons ,(music->make-music (car obj)) | 173 » `(cons ,(music->make-music (car obj)) |
174 ,(music->make-music (cdr obj)))) | 174 ,(music->make-music (cdr obj)))) |
175 (else | 175 (else |
176 obj))) | 176 obj))) |
177 | 177 |
178 (use-modules (ice-9 pretty-print)) | 178 (use-modules (ice-9 pretty-print)) |
179 (define*-public (display-scheme-music obj #:optional (port (current-output-port)
)) | 179 (define*-public (display-scheme-music obj #:optional (port (current-output-port)
)) |
180 "Displays `obj', typically a music expression, in a friendly fashion, | 180 "Displays `obj', typically a music expression, in a friendly fashion, |
181 which often can be read back in order to generate an equivalent expression. | 181 which often can be read back in order to generate an equivalent expression. |
182 | 182 |
183 Returns `obj'. | 183 Returns `obj'. |
(...skipping 13 matching lines...) Expand all Loading... |
197 (memoize-clef-names supported-clefs) | 197 (memoize-clef-names supported-clefs) |
198 (parameterize ((*indent* 0) | 198 (parameterize ((*indent* 0) |
199 (*previous-duration* (ly:make-duration 2)) | 199 (*previous-duration* (ly:make-duration 2)) |
200 (*force-duration* force-duration)) | 200 (*force-duration* force-duration)) |
201 (display (music->lily-string expr parser)) | 201 (display (music->lily-string expr parser)) |
202 (newline))) | 202 (newline))) |
203 | 203 |
204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 204 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
205 | 205 |
206 (define-public (shift-one-duration-log music shift dot) | 206 (define-public (shift-one-duration-log music shift dot) |
207 " add SHIFT to duration-log of 'duration in music and optionally | 207 " add SHIFT to duration-log of 'duration in music and optionally |
208 a dot to any note encountered. This scales the music up by a factor | 208 a dot to any note encountered. This scales the music up by a factor |
209 2^shift * (2 - (1/2)^dot)" | 209 2^shift * (2 - (1/2)^dot)" |
210 (let ((d (ly:music-property music 'duration))) | 210 (let ((d (ly:music-property music 'duration))) |
211 (if (ly:duration? d) | 211 (if (ly:duration? d) |
212 (let* ((cp (ly:duration-factor d)) | 212 (let* ((cp (ly:duration-factor d)) |
213 (nd (ly:make-duration (+ shift (ly:duration-log d)) | 213 (nd (ly:make-duration (+ shift (ly:duration-log d)) |
214 (+ dot (ly:duration-dot-count d)) | 214 (+ dot (ly:duration-dot-count d)) |
215 (car cp) | 215 (car cp) |
216 (cdr cp)))) | 216 (cdr cp)))) |
217 (set! (ly:music-property music 'duration) nd))) | 217 (set! (ly:music-property music 'duration) nd))) |
218 music)) | 218 music)) |
(...skipping 90 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
309 | 309 |
310 (if (equal? old-name 'TremoloRepeatedMusic) | 310 (if (equal? old-name 'TremoloRepeatedMusic) |
311 (let* ((seq-arg? (memq 'sequential-music | 311 (let* ((seq-arg? (memq 'sequential-music |
312 (ly:music-property e 'types))) | 312 (ly:music-property e 'types))) |
313 (count (ly:music-property music 'repeat-count)) | 313 (count (ly:music-property music 'repeat-count)) |
314 (dot-shift (if (= 0 (remainder count 3)) | 314 (dot-shift (if (= 0 (remainder count 3)) |
315 -1 0))) | 315 -1 0))) |
316 | 316 |
317 (if (= 0 -1) | 317 (if (= 0 -1) |
318 (set! count (* 2 (quotient count 3)))) | 318 (set! count (* 2 (quotient count 3)))) |
319 » » | 319 |
320 (shift-duration-log music (+ (if seq-arg? 1 0) | 320 (shift-duration-log music (+ (if seq-arg? 1 0) |
321 (ly:intlog2 count)) dot-shift) | 321 (ly:intlog2 count)) dot-shift) |
322 » » | 322 |
323 (if seq-arg? | 323 (if seq-arg? |
324 (ly:music-compress e (ly:make-moment (length (ly:music-prope
rty | 324 (ly:music-compress e (ly:make-moment (length (ly:music-prope
rty |
325 e 'elements))
1))))))) | 325 e 'elements))
1))))))) |
326 » | 326 |
327 | 327 |
328 (if (pair? es) | 328 (if (pair? es) |
329 (set! (ly:music-property music 'elements) | 329 (set! (ly:music-property music 'elements) |
330 (map unfold-repeats es))) | 330 (map unfold-repeats es))) |
331 (if (ly:music? e) | 331 (if (ly:music? e) |
332 (set! (ly:music-property music 'element) | 332 (set! (ly:music-property music 'element) |
333 (unfold-repeats e))) | 333 (unfold-repeats e))) |
334 music)) | 334 music)) |
335 | 335 |
336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
337 ;; property setting music objs. | 337 ;; property setting music objs. |
(...skipping 49 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
387 (Voice Dots font-size -3) | 387 (Voice Dots font-size -3) |
388 (Voice Stem length-fraction 0.8) | 388 (Voice Stem length-fraction 0.8) |
389 (Voice Stem no-stem-extend #t) | 389 (Voice Stem no-stem-extend #t) |
390 (Voice Beam thickness 0.384) | 390 (Voice Beam thickness 0.384) |
391 (Voice Beam length-fraction 0.8) | 391 (Voice Beam length-fraction 0.8) |
392 (Voice Accidental font-size -4) | 392 (Voice Accidental font-size -4) |
393 (Voice AccidentalCautionary font-size -4) | 393 (Voice AccidentalCautionary font-size -4) |
394 (Voice Script font-size -3) | 394 (Voice Script font-size -3) |
395 (Voice Fingering font-size -8) | 395 (Voice Fingering font-size -8) |
396 (Voice StringNumber font-size -8))) | 396 (Voice StringNumber font-size -8))) |
397 | 397 |
398 (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) | 398 (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2)) |
399 (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4
)))))) | 399 (make-grob-property-set 'MultiMeasureRest 'staff-position (if (odd? n) -4 4
)))))) |
400 | 400 |
401 (define-safe-public (make-voice-props-revert) | 401 (define-safe-public (make-voice-props-revert) |
402 (make-sequential-music | 402 (make-sequential-music |
403 (append | 403 (append |
404 (map (lambda (x) (make-grob-property-revert x 'direction)) | 404 (map (lambda (x) (make-grob-property-revert x 'direction)) |
405 direction-polyphonic-grobs) | 405 direction-polyphonic-grobs) |
406 (list (make-property-unset 'graceSettings) | 406 (list (make-property-unset 'graceSettings) |
407 (make-grob-property-revert 'NoteColumn 'horizontal-shift) | 407 (make-grob-property-revert 'NoteColumn 'horizontal-shift) |
408 (make-grob-property-revert 'MultiMeasureRest 'staff-position))))) | 408 (make-grob-property-revert 'MultiMeasureRest 'staff-position))))) |
409 | 409 |
(...skipping 56 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
466 | 466 |
467 (define-public (make-property-unset sym) | 467 (define-public (make-property-unset sym) |
468 (make-music 'PropertyUnset | 468 (make-music 'PropertyUnset |
469 'symbol sym)) | 469 'symbol sym)) |
470 | 470 |
471 (define-public (make-ottava-set octavation) | 471 (define-public (make-ottava-set octavation) |
472 (let ((m (make-music 'ApplyContext))) | 472 (let ((m (make-music 'ApplyContext))) |
473 (define (ottava-modify context) | 473 (define (ottava-modify context) |
474 "Either reset middleCPosition to the stored original, or remember | 474 "Either reset middleCPosition to the stored original, or remember |
475 old middleCPosition, add OCTAVATION to middleCPosition, and set | 475 old middleCPosition, add OCTAVATION to middleCPosition, and set |
476 OTTAVATION to `8va', or whatever appropriate."» | 476 OTTAVATION to `8va', or whatever appropriate." |
477 (if (number? (ly:context-property context 'middleCOffset)) | 477 (if (number? (ly:context-property context 'middleCOffset)) |
478 (let ((where (ly:context-property-where-defined context 'middleCOffset
))) | 478 (let ((where (ly:context-property-where-defined context 'middleCOffset
))) |
479 (ly:context-unset-property where 'middleCOffset) | 479 (ly:context-unset-property where 'middleCOffset) |
480 (ly:context-unset-property where 'ottavation))) | 480 (ly:context-unset-property where 'ottavation))) |
481 | 481 |
482 (let* ((offset (* -7 octavation)) | 482 (let* ((offset (* -7 octavation)) |
483 (string (cdr (assoc octavation '((2 . "15ma") | 483 (string (cdr (assoc octavation '((2 . "15ma") |
484 (1 . "8va") | 484 (1 . "8va") |
485 (0 . #f) | 485 (0 . #f) |
486 (-1 . "8vb") | 486 (-1 . "8vb") |
487 (-2 . "15mb")))))) | 487 (-2 . "15mb")))))) |
488 (ly:context-set-property! context 'middleCOffset offset) | 488 (ly:context-set-property! context 'middleCOffset offset) |
489 (ly:context-set-property! context 'ottavation string) | 489 (ly:context-set-property! context 'ottavation string) |
490 (ly:set-middle-C! context))) | 490 (ly:set-middle-C! context))) |
491 (set! (ly:music-property m 'procedure) ottava-modify) | 491 (set! (ly:music-property m 'procedure) ottava-modify) |
492 (context-spec-music m 'Staff))) | 492 (context-spec-music m 'Staff))) |
493 | 493 |
494 (define-public (set-octavation ottavation) | 494 (define-public (set-octavation ottavation) |
495 (ly:export (make-ottava-set ottavation))) | 495 (ly:export (make-ottava-set ottavation))) |
496 | 496 |
497 (define-public (make-time-signature-set num den . rest) | 497 ;;; Need to keep this definition for \time calls from parser |
498 "Set properties for time signature NUM/DEN. Rest can contain a list | 498 (define-public (make-time-signature-set num den) |
499 of beat groupings " | 499 "Set properties for time signature NUM/DEN." |
| 500 (make-beam-rule-time-signature-set num den '())) |
500 | 501 |
501 (define (standard-beat-grouping num den) | 502 ;;; Used for calls that include beat-grouping setting |
| 503 (define-public (set-time-signature num den . rest) |
| 504 "Set properties for time signature @var{num/den}. |
| 505 If @var{rest} is present, it is used to make a default |
| 506 @code{beamSetting} rule." |
| 507 (ly:export (apply make-beam-rule-time-signature-set |
| 508 (list num den rest)))) |
502 | 509 |
503 "Some standard subdivisions for time signatures." | 510 (define-public (make-beam-rule-time-signature-set num den rest) |
504 (let* | 511 "Implement settings for new time signature. Can be |
505 » ((key (cons num den)) | 512 called from either make-time-signature-set (used by \time |
506 » (entry (assoc key '( | 513 in parser) or set-time-signature (called from scheme code |
507 ; Simple time signatures | 514 included in .ly file." |
508 (( 3 . 8) . (3)) | |
509 (( 4 . 8) . (2 2)) | |
510 ; Compound time signatures | |
511 (( 6 . 4) . (3 3)) | |
512 (( 6 . 8) . (3 3)) | |
513 (( 6 . 16) . (3 3)) | |
514 (( 9 . 4) . (3 3 3)) | |
515 (( 9 . 8) . (3 3 3)) | |
516 (( 9 . 16) . (3 3 3)) | |
517 ((12 . 4) . (3 3 3 3)) | |
518 ((12 . 8) . (3 3 3 3)) | |
519 ((12 . 16) . (3 3 3 3)) | |
520 ; Some common irregular time signatures | |
521 (( 5 . 8) . (3 2)) | |
522 (( 8 . 8) . (3 3 2)) | |
523 )))) | |
524 | 515 |
525 (if entry | 516 (define (make-default-beaming-rule context) |
526 » (cdr entry) | 517 (override-property-setting |
527 » '()))) | 518 context |
| 519 'beamSettings |
| 520 (list (cons num den) 'end) |
| 521 (list (cons '* (car rest))))) |
528 | 522 |
529 (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) | 523 (let* ((set1 (make-property-set 'timeSignatureFraction (cons num den))) |
530 (beat (ly:make-moment 1 den)) | 524 (beat (ly:make-moment 1 den)) |
531 (len (ly:make-moment num den)) | 525 (len (ly:make-moment num den)) |
532 (set2 (make-property-set 'beatLength beat)) | 526 (set2 (make-property-set 'beatLength beat)) |
533 (set3 (make-property-set 'measureLength len)) | 527 (set3 (make-property-set 'measureLength len)) |
534 » (set4 (make-property-set 'beatGrouping (if (pair? rest) | 528 (beaming-rule |
535 » » » » » » (car rest) | 529 (if (null? rest) |
536 » » » » » » (standard-beat-grouping num
den)))) | 530 '() |
537 » (basic» (list set1 set2 set3 set4))) | 531 (list (make-apply-context make-default-beaming-rule)))) |
| 532 (output (cons* set1 set2 set3 beaming-rule))) |
538 (descend-to-context | 533 (descend-to-context |
539 (context-spec-music (make-sequential-music basic) 'Timing) 'Score))) | 534 (context-spec-music |
| 535 (make-sequential-music output) |
| 536 'Timing) |
| 537 'Score))) |
540 | 538 |
541 (define-public (make-mark-set label) | 539 (define-public (make-mark-set label) |
542 "Make the music for the \\mark command." | 540 "Make the music for the \\mark command." |
543 (let* ((set (if (integer? label) | 541 (let* ((set (if (integer? label) |
544 (context-spec-music (make-property-set 'rehearsalMark label) | 542 (context-spec-music (make-property-set 'rehearsalMark label) |
545 'Score) | 543 'Score) |
546 #f)) | 544 #f)) |
547 (ev (make-music 'MarkEvent)) | 545 (ev (make-music 'MarkEvent)) |
548 (ch (make-event-chord (list ev)))) | 546 (ch (make-event-chord (list ev)))) |
549 (if set | 547 (if set |
550 (make-sequential-music (list set ch)) | 548 (make-sequential-music (list set ch)) |
551 (begin | 549 (begin |
552 (set! (ly:music-property ev 'label) label) | 550 (set! (ly:music-property ev 'label) label) |
553 ch)))) | 551 ch)))) |
554 | 552 |
555 (define-public (set-time-signature num den . rest) | |
556 (ly:export (apply make-time-signature-set `(,num ,den . ,rest)))) | |
557 | |
558 (define-safe-public (make-articulation name) | 553 (define-safe-public (make-articulation name) |
559 (make-music 'ArticulationEvent | 554 (make-music 'ArticulationEvent |
560 'articulation-type name)) | 555 'articulation-type name)) |
561 | 556 |
562 (define-public (make-lyric-event string duration) | 557 (define-public (make-lyric-event string duration) |
563 (make-music 'LyricEvent | 558 (make-music 'LyricEvent |
564 'duration duration | 559 'duration duration |
565 'text string)) | 560 'text string)) |
566 | 561 |
567 (define-safe-public (make-span-event type span-dir) | 562 (define-safe-public (make-span-event type span-dir) |
568 (make-music type | 563 (make-music type |
569 'span-direction span-dir)) | 564 'span-direction span-dir)) |
570 | 565 |
571 (define-public (set-mus-properties! m alist) | 566 (define-public (set-mus-properties! m alist) |
572 "Set all of ALIST as properties of M." | 567 "Set all of ALIST as properties of M." |
573 (if (pair? alist) | 568 (if (pair? alist) |
574 (begin | 569 (begin |
575 (set! (ly:music-property m (caar alist)) (cdar alist)) | 570 (set! (ly:music-property m (caar alist)) (cdar alist)) |
576 (set-mus-properties! m (cdr alist))))) | 571 (set-mus-properties! m (cdr alist))))) |
577 | 572 |
578 (define-public (music-separator? m) | 573 (define-public (music-separator? m) |
579 "Is M a separator?" | 574 "Is M a separator?" |
580 (let ((ts (ly:music-property m 'types))) | 575 (let ((ts (ly:music-property m 'types))) |
581 (memq 'separator ts))) | 576 (memq 'separator ts))) |
582 | 577 |
(...skipping 34 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
617 (if (ly:music? e) | 612 (if (ly:music? e) |
618 (set! (ly:music-property m 'element) (voicify-music e))) | 613 (set! (ly:music-property m 'element) (voicify-music e))) |
619 (if (and (equal? (ly:music-property m 'name) 'SimultaneousMusic) | 614 (if (and (equal? (ly:music-property m 'name) 'SimultaneousMusic) |
620 (reduce (lambda (x y ) (or x y)) #f (map music-separator? es))) | 615 (reduce (lambda (x y ) (or x y)) #f (map music-separator? es))) |
621 (set! m (context-spec-music (voicify-chord m) 'Staff))) | 616 (set! m (context-spec-music (voicify-chord m) 'Staff))) |
622 m)) | 617 m)) |
623 | 618 |
624 (define-public (empty-music) | 619 (define-public (empty-music) |
625 (ly:export (make-music 'Music))) | 620 (ly:export (make-music 'Music))) |
626 | 621 |
627 ;; Make a function that checks score element for being of a specific type. | 622 ;; Make a function that checks score element for being of a specific type. |
628 (define-public (make-type-checker symbol) | 623 (define-public (make-type-checker symbol) |
629 (lambda (elt) | 624 (lambda (elt) |
630 ;;(display symbol) | |
631 ;;(eq? #t (ly:grob-property elt symbol)) | |
632 (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces)))))) | 625 (not (eq? #f (memq symbol (ly:grob-property elt 'interfaces)))))) |
633 | 626 |
634 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-co
ntext) | 627 (define-public ((outputproperty-compatibility func sym val) grob g-context ao-co
ntext) |
635 (if (func grob) | 628 (if (func grob) |
636 (set! (ly:grob-property grob sym) val))) | 629 (set! (ly:grob-property grob sym) val))) |
637 | 630 |
638 | 631 |
639 (define-public ((set-output-property grob-name symbol val) grob grob-c context) | 632 (define-public ((set-output-property grob-name symbol val) grob grob-c context) |
640 "Usage: | 633 "Usage: |
641 | 634 |
642 \\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1)) | 635 \\applyoutput #(set-output-property 'Clef 'extra-offset '(0 . 1)) |
643 | 636 |
644 " | 637 " |
645 (let ((meta (ly:grob-property grob 'meta))) | 638 (let ((meta (ly:grob-property grob 'meta))) |
646 (if (equal? (cdr (assoc 'name meta)) grob-name) | 639 (if (equal? (cdr (assoc 'name meta)) grob-name) |
647 (set! (ly:grob-property grob symbol) val)))) | 640 (set! (ly:grob-property grob symbol) val)))) |
648 | 641 |
649 | 642 |
650 ;; | 643 ;; |
651 (define-public (smart-bar-check n) | 644 (define-public (smart-bar-check n) |
652 "Make» a bar check that checks for a specific bar number. | 645 "Make» a bar check that checks for a specific bar number. |
653 " | 646 " |
654 (let ((m (make-music 'ApplyContext))) | 647 (let ((m (make-music 'ApplyContext))) |
655 (define (checker tr) | 648 (define (checker tr) |
656 (let* ((bn (ly:context-property tr 'currentBarNumber))) | 649 (let* ((bn (ly:context-property tr 'currentBarNumber))) |
657 (if (= bn n) | 650 (if (= bn n) |
658 #t | 651 #t |
659 (ly:error | 652 (ly:error |
660 ;; FIXME: uncomprehensable message | 653 ;; FIXME: uncomprehensable message |
661 (_ "Bar check failed. Expect to be at ~a, instead at ~a") | 654 (_ "Bar check failed. Expect to be at ~a, instead at ~a") |
662 n bn)))) | 655 n bn)))) |
(...skipping 74 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
737 | 730 |
738 (define-public (remove-grace-property context-name grob sym) | 731 (define-public (remove-grace-property context-name grob sym) |
739 "Remove all SYM for GROB in CONTEXT-NAME. " | 732 "Remove all SYM for GROB in CONTEXT-NAME. " |
740 (define (sym-grob-context? property sym grob context-name) | 733 (define (sym-grob-context? property sym grob context-name) |
741 (and (eq? (car property) context-name) | 734 (and (eq? (car property) context-name) |
742 (eq? (cadr property) grob) | 735 (eq? (cadr property) grob) |
743 (eq? (caddr property) sym))) | 736 (eq? (caddr property) sym))) |
744 (define (delete-prop context) | 737 (define (delete-prop context) |
745 (let* ((where (ly:context-property-where-defined context 'graceSettings)) | 738 (let* ((where (ly:context-property-where-defined context 'graceSettings)) |
746 (current (ly:context-property where 'graceSettings)) | 739 (current (ly:context-property where 'graceSettings)) |
747 (prop-settings (filter | 740 (prop-settings (filter |
748 (lambda(x) (sym-grob-context? x sym grob context-nam
e)) | 741 (lambda(x) (sym-grob-context? x sym grob context-nam
e)) |
749 current)) | 742 current)) |
750 (new-settings current)) | 743 (new-settings current)) |
751 (for-each (lambda(x) | 744 (for-each (lambda(x) |
752 (set! new-settings (delete x new-settings))) | 745 (set! new-settings (delete x new-settings))) |
753 prop-settings) | 746 prop-settings) |
754 (ly:context-set-property! where 'graceSettings new-settings))) | 747 (ly:context-set-property! where 'graceSettings new-settings))) |
755 (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice))) | 748 (ly:export (context-spec-music (make-apply-context delete-prop) 'Voice))) |
756 | 749 |
757 | 750 |
758 | 751 |
759 (defmacro-public def-grace-function (start stop . docstring) | 752 (defmacro-public def-grace-function (start stop . docstring) |
760 "Helper macro for defining grace music" | 753 "Helper macro for defining grace music" |
761 `(define-music-function (parser location music) (ly:music?) | 754 `(define-music-function (parser location music) (ly:music?) |
(...skipping 22 matching lines...) Expand all Loading... |
784 ,@body))) | 777 ,@body))) |
785 `(ly:make-music-function (list ,@signature) | 778 `(ly:make-music-function (list ,@signature) |
786 (lambda (,@args) | 779 (lambda (,@args) |
787 ,@body)))) | 780 ,@body)))) |
788 | 781 |
789 | 782 |
790 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 783 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
791 | 784 |
792 (define-public (cue-substitute quote-music) | 785 (define-public (cue-substitute quote-music) |
793 "Must happen after quote-substitute." | 786 "Must happen after quote-substitute." |
794 | 787 |
795 (if (vector? (ly:music-property quote-music 'quoted-events)) | 788 (if (vector? (ly:music-property quote-music 'quoted-events)) |
796 (let* ((dir (ly:music-property quote-music 'quoted-voice-direction)) | 789 (let* ((dir (ly:music-property quote-music 'quoted-voice-direction)) |
797 (main-voice (if (eq? 1 dir) 1 0)) | 790 (main-voice (if (eq? 1 dir) 1 0)) |
798 (cue-voice (if (eq? 1 dir) 0 1)) | 791 (cue-voice (if (eq? 1 dir) 0 1)) |
799 (main-music (ly:music-property quote-music 'element)) | 792 (main-music (ly:music-property quote-music 'element)) |
800 (return-value quote-music)) | 793 (return-value quote-music)) |
801 | 794 |
802 (if (or (eq? 1 dir) (eq? -1 dir)) | 795 (if (or (eq? 1 dir) (eq? -1 dir)) |
803 » | 796 |
804 ;; if we have stem dirs, change both quoted and main music | 797 ;; if we have stem dirs, change both quoted and main music |
805 ;; to have opposite stems. | 798 ;; to have opposite stems. |
806 (begin | 799 (begin |
807 (set! return-value | 800 (set! return-value |
808 | 801 |
809 ;; cannot context-spec Quote-music, since context | 802 ;; cannot context-spec Quote-music, since context |
810 ;; for the quotes is determined in the iterator. | 803 ;; for the quotes is determined in the iterator. |
811 (make-sequential-music | 804 (make-sequential-music |
812 (list | 805 (list |
813 (context-spec-music (make-voice-props-set cue-voice) 'CueV
oice "cue") | 806 (context-spec-music (make-voice-props-set cue-voice) 'CueV
oice "cue") |
814 quote-music | 807 quote-music |
815 (context-spec-music (make-voice-props-revert) 'CueVoice "
cue")))) | 808 (context-spec-music (make-voice-props-revert) 'CueVoice "
cue")))) |
816 (set! main-music | 809 (set! main-music |
817 (make-sequential-music | 810 (make-sequential-music |
818 (list | 811 (list |
819 (make-voice-props-set main-voice) | 812 (make-voice-props-set main-voice) |
820 main-music | 813 main-music |
821 (make-voice-props-revert)))) | 814 (make-voice-props-revert)))) |
822 (set! (ly:music-property quote-music 'element) main-music))) | 815 (set! (ly:music-property quote-music 'element) main-music))) |
823 | 816 |
824 return-value) | 817 return-value) |
825 quote-music)) | 818 quote-music)) |
826 | 819 |
827 (define-public ((quote-substitute quote-tab) music) | 820 (define-public ((quote-substitute quote-tab) music) |
828 (let* ((quoted-name (ly:music-property music 'quoted-music-name)) | 821 (let* ((quoted-name (ly:music-property music 'quoted-music-name)) |
829 (quoted-vector (if (string? quoted-name) | 822 (quoted-vector (if (string? quoted-name) |
830 (hash-ref quote-tab quoted-name #f) | 823 (hash-ref quote-tab quoted-name #f) |
831 #f))) | 824 #f))) |
832 | 825 |
833 | 826 |
834 (if (string? quoted-name) | 827 (if (string? quoted-name) |
835 (if (vector? quoted-vector) | 828 (if (vector? quoted-vector) |
836 (begin | 829 (begin |
837 (set! (ly:music-property music 'quoted-events) quoted-vector) | 830 (set! (ly:music-property music 'quoted-events) quoted-vector) |
838 (set! (ly:music-property music 'iterator-ctor) | 831 (set! (ly:music-property music 'iterator-ctor) |
839 ly:quote-iterator::constructor)) | 832 ly:quote-iterator::constructor)) |
840 (ly:warning (_ "cannot find quoted music: `~S'") quoted-name))) | 833 (ly:warning (_ "cannot find quoted music: `~S'") quoted-name))) |
841 music)) | 834 music)) |
842 | 835 |
843 | 836 |
844 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 837 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
845 ;; switch it on here, so parsing and init isn't checked (too slow!) | 838 ;; switch it on here, so parsing and init isn't checked (too slow!) |
846 ;; | 839 ;; |
847 ;; automatic music transformations. | 840 ;; automatic music transformations. |
848 | 841 |
849 (define (switch-on-debugging m) | 842 (define (switch-on-debugging m) |
850 (if (defined? 'set-debug-cell-accesses!) | 843 (if (defined? 'set-debug-cell-accesses!) |
851 (set-debug-cell-accesses! 15000)) | 844 (set-debug-cell-accesses! 15000)) |
852 m) | 845 m) |
853 | 846 |
854 (define (music-check-error music) | 847 (define (music-check-error music) |
855 (define found #f) | 848 (define found #f) |
856 (define (signal m) | 849 (define (signal m) |
857 (if (and (ly:music? m) | 850 (if (and (ly:music? m) |
858 (eq? (ly:music-property m 'error-found) #t)) | 851 (eq? (ly:music-property m 'error-found) #t)) |
859 (set! found #t))) | 852 (set! found #t))) |
860 | 853 |
861 (for-each signal (ly:music-property music 'elements)) | 854 (for-each signal (ly:music-property music 'elements)) |
862 (signal (ly:music-property music 'element)) | 855 (signal (ly:music-property music 'element)) |
863 | 856 |
864 (if found | 857 (if found |
865 (set! (ly:music-property music 'error-found) #t)) | 858 (set! (ly:music-property music 'error-found) #t)) |
866 music) | 859 music) |
867 | 860 |
868 (define (precompute-music-length music) | 861 (define (precompute-music-length music) |
869 (set! (ly:music-property music 'length) | 862 (set! (ly:music-property music 'length) |
870 (ly:music-length music)) | 863 (ly:music-length music)) |
(...skipping 89 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
960 | 953 |
961 | 954 |
962 (define-public toplevel-music-functions | 955 (define-public toplevel-music-functions |
963 (list | 956 (list |
964 (lambda (music parser) (voicify-music music)) | 957 (lambda (music parser) (voicify-music music)) |
965 (lambda (x parser) (music-map music-check-error x)) | 958 (lambda (x parser) (music-map music-check-error x)) |
966 (lambda (x parser) (music-map precompute-music-length x)) | 959 (lambda (x parser) (music-map precompute-music-length x)) |
967 (lambda (music parser) | 960 (lambda (music parser) |
968 | 961 |
969 (music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes)) music
)) | 962 (music-map (quote-substitute (ly:parser-lookup parser 'musicQuotes)) music
)) |
970 | 963 |
971 ;; switch-on-debugging | 964 ;; switch-on-debugging |
972 (lambda (x parser) (music-map cue-substitute x)) | 965 (lambda (x parser) (music-map cue-substitute x)) |
973 | 966 |
974 (lambda (x parser) | 967 (lambda (x parser) |
975 (skip-as-needed x parser) | 968 (skip-as-needed x parser) |
976 ))) | 969 ))) |
977 | 970 |
978 ;;;;;;;;;; | 971 ;;;;;;;;;; |
979 ;;; general purpose music functions | 972 ;;; general purpose music functions |
980 | 973 |
981 (define (shift-octave pitch octave-shift) | 974 (define (shift-octave pitch octave-shift) |
982 (_i "Add @var{octave-shift} to the octave of @var{pitch}.") | 975 (_i "Add @var{octave-shift} to the octave of @var{pitch}.") |
983 (ly:make-pitch | 976 (ly:make-pitch |
984 (+ (ly:pitch-octave pitch) octave-shift) | 977 (+ (ly:pitch-octave pitch) octave-shift) |
985 (ly:pitch-notename pitch) | 978 (ly:pitch-notename pitch) |
986 (ly:pitch-alteration pitch))) | 979 (ly:pitch-alteration pitch))) |
987 | 980 |
988 | 981 |
989 ;;;;;;;;;;;;;;;;; | 982 ;;;;;;;;;;;;;;;;; |
990 ;; lyrics | 983 ;; lyrics |
991 | 984 |
992 (define (apply-durations lyric-music durations) | 985 (define (apply-durations lyric-music durations) |
993 (define (apply-duration music) | 986 (define (apply-duration music) |
994 (if (and (not (equal? (ly:music-length music) ZERO-MOMENT)) | 987 (if (and (not (equal? (ly:music-length music) ZERO-MOMENT)) |
995 (ly:duration? (ly:music-property music 'duration))) | 988 (ly:duration? (ly:music-property music 'duration))) |
996 (begin | 989 (begin |
997 (set! (ly:music-property music 'duration) (car durations)) | 990 (set! (ly:music-property music 'duration) (car durations)) |
998 (set! durations (cdr durations))))) | 991 (set! durations (cdr durations))))) |
999 | 992 |
1000 (music-map apply-duration lyric-music)) | 993 (music-map apply-duration lyric-music)) |
1001 | 994 |
1002 | 995 |
1003 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 996 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1004 ;; accidentals | 997 ;; accidentals |
1005 | 998 |
1006 (define (recent-enough? bar-number alteration-def laziness) | 999 (define (recent-enough? bar-number alteration-def laziness) |
1007 (if (or (number? alteration-def) | 1000 (if (or (number? alteration-def) |
1008 (equal? laziness #t)) | 1001 (equal? laziness #t)) |
1009 #t | 1002 #t |
(...skipping 302 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
1312 (set-accidentals-properties #f | 1305 (set-accidentals-properties #f |
1313 `(Staff ,(make-accidental-rule 'same-octave 0
)) | 1306 `(Staff ,(make-accidental-rule 'same-octave 0
)) |
1314 `(Staff ,(make-accidental-rule 'any-octave 0) | 1307 `(Staff ,(make-accidental-rule 'any-octave 0) |
1315 ,(make-accidental-rule 'same-octave 1
) | 1308 ,(make-accidental-rule 'same-octave 1
) |
1316 GrandStaff | 1309 GrandStaff |
1317 ,(make-accidental-rule 'any-octave 0) | 1310 ,(make-accidental-rule 'any-octave 0) |
1318 ,(make-accidental-rule 'same-octave 1
)) | 1311 ,(make-accidental-rule 'same-octave 1
)) |
1319 pcontext)) | 1312 pcontext)) |
1320 | 1313 |
1321 ;; same as modern, but cautionary accidentals are printed for all sharp or
flat | 1314 ;; same as modern, but cautionary accidentals are printed for all sharp or
flat |
1322 ;; tones specified by the key signature. | 1315 ;; tones specified by the key signature. |
1323 ((equal? style 'teaching) | 1316 ((equal? style 'teaching) |
1324 (set-accidentals-properties #f | 1317 (set-accidentals-properties #f |
1325 `(Staff ,(make-accidental-rule 'same-octave
0)) | 1318 `(Staff ,(make-accidental-rule 'same-octave
0)) |
1326 `(Staff ,(make-accidental-rule 'same-octave
1) | 1319 `(Staff ,(make-accidental-rule 'same-octave
1) |
1327 ,teaching-accidental-rule) | 1320 ,teaching-accidental-rule) |
1328 context)) | 1321 context)) |
1329 | 1322 |
1330 ;; do not set localKeySignature when a note alterated differently from | 1323 ;; do not set localKeySignature when a note alterated differently from |
1331 ;; localKeySignature is found. | 1324 ;; localKeySignature is found. |
1332 ;; Causes accidentals to be printed at every note instead of | 1325 ;; Causes accidentals to be printed at every note instead of |
1333 ;; remembered for the duration of a measure. | 1326 ;; remembered for the duration of a measure. |
1334 ;; accidentals not being remembered, causing accidentals always to | 1327 ;; accidentals not being remembered, causing accidentals always to |
1335 ;; be typeset relative to the time signature | 1328 ;; be typeset relative to the time signature |
1336 ((equal? style 'forget) | 1329 ((equal? style 'forget) |
1337 (set-accidentals-properties '() | 1330 (set-accidentals-properties '() |
1338 `(Staff ,(make-accidental-rule 'same-octave -
1)) | 1331 `(Staff ,(make-accidental-rule 'same-octave -
1)) |
1339 '() | 1332 '() |
(...skipping 16 matching lines...) Expand all Loading... |
1356 "Create a skip of exactly the same length as MUS." | 1349 "Create a skip of exactly the same length as MUS." |
1357 (let* ((skip | 1350 (let* ((skip |
1358 (make-music | 1351 (make-music |
1359 'SkipEvent | 1352 'SkipEvent |
1360 'duration (ly:make-duration 0 0)))) | 1353 'duration (ly:make-duration 0 0)))) |
1361 | 1354 |
1362 (make-event-chord (list (ly:music-compress skip (ly:music-length mus)))))) | 1355 (make-event-chord (list (ly:music-compress skip (ly:music-length mus)))))) |
1363 | 1356 |
1364 (define-public (mmrest-of-length mus) | 1357 (define-public (mmrest-of-length mus) |
1365 "Create a mmrest of exactly the same length as MUS." | 1358 "Create a mmrest of exactly the same length as MUS." |
1366 | 1359 |
1367 (let* ((skip | 1360 (let* ((skip |
1368 (make-multi-measure-rest | 1361 (make-multi-measure-rest |
1369 (ly:make-duration 0 0) '()))) | 1362 (ly:make-duration 0 0) '()))) |
1370 (ly:music-compress skip (ly:music-length mus)) | 1363 (ly:music-compress skip (ly:music-length mus)) |
1371 skip)) | 1364 skip)) |
1372 | 1365 |
1373 (define-public (pitch-of-note event-chord) | 1366 (define-public (pitch-of-note event-chord) |
1374 | 1367 |
1375 (let* | 1368 (let* |
1376 ((evs (filter (lambda (x) (memq 'note-event (ly:music-property x 'types))) | 1369 ((evs (filter (lambda (x) (memq 'note-event (ly:music-property x 'types))) |
1377 (ly:music-property event-chord 'elements)))) | 1370 (ly:music-property event-chord 'elements)))) |
1378 | 1371 |
1379 (if (pair? evs) | 1372 (if (pair? evs) |
1380 (ly:music-property (car evs) 'pitch) | 1373 (ly:music-property (car evs) 'pitch) |
1381 #f))) | 1374 #f))) |
1382 | 1375 |
1383 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | 1376 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
1384 | 1377 |
1385 (define-public (extract-named-music music music-name) | 1378 (define-public (extract-named-music music music-name) |
1386 "Return a flat list of all music named @code{music-name} | 1379 "Return a flat list of all music named @code{music-name} |
1387 from @code{music}." | 1380 from @code{music}." |
1388 (let ((extracted-list | 1381 (let ((extracted-list |
1389 (if (ly:music? music) | 1382 (if (ly:music? music) |
1390 (if (eq? (ly:music-property music 'name) music-name) | 1383 (if (eq? (ly:music-property music 'name) music-name) |
1391 (list music) | 1384 (list music) |
1392 (let ((elt (ly:music-property music 'element)) | 1385 (let ((elt (ly:music-property music 'element)) |
1393 (elts (ly:music-property music 'elements))) | 1386 (elts (ly:music-property music 'elements))) |
1394 (if (ly:music? elt) | 1387 (if (ly:music? elt) |
1395 (extract-named-music elt music-name) | 1388 (extract-named-music elt music-name) |
1396 (if (null? elts) | 1389 (if (null? elts) |
1397 '() | 1390 '() |
1398 (map (lambda(x) | 1391 (map (lambda(x) |
1399 (extract-named-music x music-name )) | 1392 (extract-named-music x music-name )) |
1400 elts))))) | 1393 elts))))) |
1401 '()))) | 1394 '()))) |
1402 (flatten-list extracted-list))) | 1395 (flatten-list extracted-list))) |
1403 | 1396 |
1404 (define-public (event-chord-notes event-chord) | 1397 (define-public (event-chord-notes event-chord) |
1405 "Return a list of all notes from @{event-chord}." | 1398 "Return a list of all notes from @{event-chord}." |
1406 (filter | 1399 (filter |
1407 (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) | 1400 (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name))) |
1408 (ly:music-property event-chord 'elements))) | 1401 (ly:music-property event-chord 'elements))) |
1409 | 1402 |
1410 (define-public (event-chord-pitches event-chord) | 1403 (define-public (event-chord-pitches event-chord) |
1411 "Return a list of all pitches from @{event-chord}." | 1404 "Return a list of all pitches from @{event-chord}." |
1412 (map (lambda (x) (ly:music-property x 'pitch)) | 1405 (map (lambda (x) (ly:music-property x 'pitch)) |
1413 (event-chord-notes event-chord))) | 1406 (event-chord-notes event-chord))) |
OLD | NEW |