]> git.donarmstrong.com Git - lilypond.git/blob - ly/music-functions-init.ly
*** empty log message ***
[lilypond.git] / ly / music-functions-init.ly
1 % -*-Scheme-*-
2
3 \version "2.9.12"
4
5 %% need SRFI-1 filter 
6
7 #(use-modules (srfi srfi-1))  
8 %% FIXME: guile-1.7 required?
9 %#(use-modules (scm display-lily))invalid module name for use-syntax ((srfi srfi-39))
10
11 #(use-modules (scm display-lily))
12 #(display-lily-init parser)
13
14
15 acciaccatura =
16 #(def-grace-function startAcciaccaturaMusic stopAcciaccaturaMusic)
17
18
19 addquote =
20 #(define-music-function (parser location name music) (string? ly:music?)
21    "Add a piece of music to be quoted "
22    (add-quotable name music)
23    (make-music 'SequentialMusic 'void #t))
24
25
26 afterGraceFraction =
27 #(cons 6 8)
28
29 afterGrace =
30 #(define-music-function
31   (parser location main grace)
32   (ly:music? ly:music?)
33
34   (let*
35       ((main-length (ly:music-length main))
36        (fraction  (ly:parser-lookup parser 'afterGraceFraction)))
37     
38     (make-simultaneous-music
39      (list
40       main
41       (make-sequential-music
42        (list
43
44         (make-music 'SkipMusic
45                     'duration (ly:make-duration
46                                0 0
47                                (* (ly:moment-main-numerator main-length)
48                                   (car fraction))
49                                (* (ly:moment-main-denominator main-length)
50                                   (cdr fraction)) ))
51         (make-music 'GraceMusic
52                     'element grace)))))))
53
54 applyMusic =
55 #(define-music-function (parser location func music) (procedure? ly:music?)
56                (func music))
57
58
59 applyOutput =
60 #(define-music-function (parser location ctx proc) (symbol? procedure?)
61                 (make-music 'ApplyOutputEvent
62                   'origin location
63                   'procedure proc
64                   'context-type ctx))
65
66 appoggiatura =
67 #(def-grace-function startAppoggiaturaMusic stopAppoggiaturaMusic)
68
69
70
71 % for regression testing purposes.
72 assertBeamQuant =
73 #(define-music-function (parser location l r) (pair? pair?)
74   (make-grob-property-override 'Beam 'positions
75    (ly:make-simple-closure
76     (ly:make-simple-closure
77      (append
78       (list chain-grob-member-functions `(,cons 0 0))
79       (check-quant-callbacks l r))))))
80     
81 % for regression testing purposes.
82 assertBeamSlope =
83 #(define-music-function (parser location comp) (procedure?)
84   (make-grob-property-override 'Beam 'positions
85    (ly:make-simple-closure
86     (ly:make-simple-closure
87      (append
88       (list chain-grob-member-functions `(,cons 0 0))
89       (check-slope-callbacks comp))))))
90
91
92
93 autochange =
94 #(define-music-function (parser location music) (ly:music?)
95                (make-autochange-music music))
96
97 applyContext =
98 #(define-music-function (parser location proc) (procedure?)
99                  (make-music 'ApplyContext 
100                    'origin location
101                    'procedure proc))
102
103 bar =
104 #(define-music-function (parser location type)
105    (string?)
106    (context-spec-music
107     (make-property-set 'whichBar type)
108     'Timing))
109
110
111 barNumberCheck =
112 #(define-music-function (parser location n) (integer?)
113    (make-music 'ApplyContext 
114                'origin location
115                'procedure 
116                (lambda (c)
117                  (let*
118                      ((cbn (ly:context-property c 'currentBarNumber)))
119                    (if (not (= cbn n))
120                        (ly:input-message location "Barcheck failed got ~a expect ~a"
121                                          cbn n))))))
122
123
124 %% why a function?
125 breathe =
126 #(define-music-function (parser location) ()
127             (make-music 'EventChord 
128               'origin location
129               'elements (list (make-music 'BreathingSignEvent))))
130
131 bendAfter =
132 #(define-music-function (parser location delta) (integer?)
133               
134   (make-music 'BendAfterEvent
135    'delta-pitch delta))
136
137 clef =
138 #(define-music-function (parser location type)
139    (string?)
140    
141    "Set the current clef."
142
143    (make-clef-set type))
144
145
146 compressMusic =
147 #(define-music-function
148                   (parser location fraction music) (number-pair? ly:music?)
149                   (ly:music-compress music (ly:make-moment (car fraction) (cdr fraction))))
150
151
152 cueDuring = 
153 #(define-music-function
154   (parser location what dir main-music)
155   (string? ly:dir? ly:music?)
156   (make-music 'QuoteMusic
157               'element main-music 
158               'quoted-context-type 'Voice
159               'quoted-context-id "cue"
160               'quoted-music-name what
161               'quoted-voice-direction dir
162               'origin location))
163
164
165 displayLilyMusic =
166 #(define-music-function (parser location music) (ly:music?)
167    (display-lily-music music)
168    music)
169
170 displayMusic =
171 #(define-music-function (parser location music) (ly:music?)
172                  (display-scheme-music music)
173                  music)
174
175 featherDurations=
176 #(define-music-function (parser location factor argument) (ly:moment? ly:music?)
177
178    "Rearrange durations in ARGUMENT so there is an
179 acceleration/deceleration. "
180    
181    (let*
182        ((orig-duration (ly:music-length argument))
183         (multiplier (ly:make-moment 1 1)))
184
185      (music-map 
186       (lambda (mus)
187         (if (and (eq? (ly:music-property mus 'name) 'EventChord)
188                  (< 0 (ly:moment-main-denominator (ly:music-length mus))))
189             (begin
190               (ly:music-compress mus multiplier)
191               (set! multiplier (ly:moment-mul factor multiplier)))
192             )
193         mus)
194       argument)
195
196      (ly:music-compress
197       argument
198       (ly:moment-div orig-duration (ly:music-length argument)))
199
200      argument))
201
202 grace =
203 #(def-grace-function startGraceMusic stopGraceMusic)
204
205 keepWithTag =
206 #(define-music-function
207   (parser location tag music) (symbol? ly:music?)
208   (music-filter
209    (lambda (m)
210     (let* ((tags (ly:music-property m 'tags))
211            (res (memq tag tags)))
212      (or
213       (eq? tags '())
214       res)))
215    music))
216
217
218
219 killCues =
220 #(define-music-function
221    (parser location music)
222    (ly:music?)
223    (music-map
224     (lambda (mus)
225       (if (string? (ly:music-property mus 'quoted-music-name))
226           (ly:music-property mus 'element)
227           mus)) music))
228    
229
230 makeClusters =
231 #(define-music-function
232                 (parser location arg) (ly:music?)
233                 (music-map note-to-cluster arg))
234
235 musicMap =
236 #(define-music-function (parser location proc mus) (procedure? ly:music?)
237              (music-map proc mus))
238
239
240
241 oldaddlyrics =
242 #(define-music-function (parser location music lyrics) (ly:music? ly:music?)
243
244               (make-music 'OldLyricCombineMusic 
245                           'origin location
246                           'elements (list music lyrics)))
247
248
249 overrideProperty =
250 #(define-music-function (parser location name property value)
251    (string? symbol? scheme?)
252
253
254    "Set @var{property} to @var{value} in all grobs named @var{name}.
255 The @var{name} argument is a string of the form @code{\"Context.GrobName\"}
256 or @code{\"GrobName\"}"
257
258    (let*
259        ((name-components (string-split name #\.))
260         (context-name 'Bottom)
261         (grob-name #f))
262
263      (if (> 2 (length name-components))
264          (set! grob-name (string->symbol (car name-components)))
265          (begin
266            (set! grob-name (string->symbol (list-ref name-components 1)))
267            (set! context-name (string->symbol (list-ref name-components 0)))))
268
269      (make-music 'ApplyOutputEvent
270                  'origin location
271                  'context-type context-name
272                  'procedure
273                  (lambda (grob orig-context context)
274                    (if (equal?
275                         (cdr (assoc 'name (ly:grob-property grob 'meta)))
276                         grob-name)
277                        (set! (ly:grob-property grob property) value))))))
278
279
280 removeWithTag = 
281 #(define-music-function
282   (parser location tag music) (symbol? ly:music?)
283   (music-filter
284    (lambda (m)
285     (let* ((tags (ly:music-property m 'tags))
286            (res (memq tag tags)))
287      (not res)))
288  music))
289
290 %% Todo:
291 %% doing
292 %% define-music-function in a .scm causes crash.
293
294
295 octave =
296 #(define-music-function (parser location pitch-note) (ly:music?)
297    "octave check"
298
299    (make-music 'RelativeOctaveCheck
300                'origin location
301                'pitch (pitch-of-note pitch-note) 
302                ))
303 partcombine =
304 #(define-music-function (parser location part1 part2) (ly:music? ly:music?)
305                 (make-part-combine-music (list part1 part2)))
306
307               
308 pitchedTrill =
309 #(define-music-function
310    (parser location main-note secondary-note)
311    (ly:music? ly:music?)
312    (let*
313        ((get-notes (lambda (ev-chord)
314                      (filter
315                       (lambda (m) (eq? 'NoteEvent (ly:music-property m 'name)))
316                       (ly:music-property ev-chord 'elements))))
317         (sec-note-events (get-notes secondary-note))
318         (trill-events (filter (lambda (m) (memq 'trill-span-event (ly:music-property m 'types)))
319                               (ly:music-property main-note 'elements)))
320
321         (trill-pitch
322          (if (pair? sec-note-events)
323              (ly:music-property (car sec-note-events) 'pitch)
324              )))
325      
326      (if (ly:pitch? trill-pitch)
327          (for-each (lambda (m) (ly:music-set-property! m 'pitch trill-pitch))
328                    trill-events)
329          (begin
330            (ly:warning (_ "Second argument of \\pitchedTrill should be single note: "))
331            (display sec-note-events)))
332
333      main-note))
334
335
336
337
338
339    
340 parenthesize =
341 #(define-music-function (parser loc arg) (ly:music?)
342    "Tag @var{arg} to be parenthesized."
343
344    (set! (ly:music-property arg 'parenthesize) #t)
345    arg)
346
347 parallelMusic =
348 #(define-music-function (parser location voice-ids music) (list? ly:music?)
349   "Define parallel music sequences, separated by '|' (bar check signs),
350 and assign them to the identifiers provided in @var{voice-ids}.
351
352 @var{voice-ids}: a list of music identifiers (symbols containing only letters)
353
354 @var{music}: a music sequence, containing BarChecks as limiting expressions.
355
356 Example:
357   \\parallelMusic #'(A B C) {
358     c c | d d | e e |
359     d d | e e | f f |
360   }
361 <==>
362   A = { c c | d d | }
363   B = { d d | e e | }
364   C = { e e | f f | }
365 "
366   (let* ((voices (apply circular-list (make-list (length voice-ids) (list))))
367          (current-voices voices)
368          (current-sequence (list)))
369     ;;
370     ;; utilities
371     (define (push-music m)
372       "Push the music expression into the current sequence"
373       (set! current-sequence (cons m current-sequence)))
374     (define (change-voice)
375       "Stores the previously built sequence into the current voice and
376        change to the following voice."
377       (list-set! current-voices 0 (cons (make-music 'SequentialMusic 
378                                          'elements (reverse! current-sequence))
379                                         (car current-voices)))
380       (set! current-sequence (list))
381       (set! current-voices (cdr current-voices)))
382     (define (bar-check? m)
383       "Checks whether m is a bar check."
384       (eq? (ly:music-property m 'name) 'BarCheck))
385     (define (music-origin music)
386       "Recursively search an origin location stored in music."
387       (cond ((null? music) #f)
388             ((not (null? (ly:music-property music 'origin)))
389              (ly:music-property music 'origin))
390             (else (or (music-origin (ly:music-property music 'element))
391                       (let ((origins (remove not (map music-origin 
392                                                       (ly:music-property music 'elements)))))
393                         (and (not (null? origins)) (car origins)))))))
394     ;;
395     ;; first, split the music and fill in voices
396     (map-in-order (lambda (m)
397                     (push-music m)
398                     (if (bar-check? m) (change-voice)))
399                   (ly:music-property music 'elements))
400     (if (not (null? current-sequence)) (change-voice))
401     ;; un-circularize `voices' and reorder the voices
402     (set! voices (map-in-order (lambda (dummy seqs)
403                                  (reverse! seqs))
404                                voice-ids voices))
405     ;;
406     ;; set origin location of each sequence in each voice
407     ;; for better type error tracking
408     (for-each (lambda (voice)
409                 (for-each (lambda (seq)
410                             (set! (ly:music-property seq 'origin)
411                                   (or (music-origin seq) location)))
412                           voice))
413               voices)
414     ;;
415     ;; check sequence length
416     (apply for-each (lambda (. seqs)
417                       (let ((moment-reference (ly:music-length (car seqs))))
418                         (for-each (lambda (seq moment)
419                                     (if (not (equal? moment moment-reference))
420                                         (ly:music-message seq 
421                                          "Bars in parallel music don't have the same length")))
422                           seqs (map-in-order ly:music-length seqs))))
423            voices)
424    ;;
425    ;; bind voice identifiers to the voices
426    (map (lambda (voice-id voice)
427           (ly:parser-define! parser voice-id 
428                              (make-music 'SequentialMusic 
429                                'origin location
430                                'elements voice)))
431         voice-ids voices))
432  ;; Return an empty sequence. this function is actually a "void" function.
433  (make-music 'SequentialMusic 'void #t))
434
435
436
437 quoteDuring = #
438 (define-music-function
439   (parser location what main-music)
440   (string? ly:music?)
441   (make-music 'QuoteMusic
442               'element main-music
443               'quoted-music-name what
444               'origin location))
445
446
447
448 resetRelativeOctave  =
449 #(define-music-function
450     (parser location reference-note)
451     (ly:music?)
452     "Set the octave inside a \\relative section."
453
454    (let*
455     ((notes (ly:music-property reference-note 'elements))
456      (pitch (ly:music-property (car notes) 'pitch)))
457
458     (set! (ly:music-property reference-note 'elements) '())
459     (set! (ly:music-property reference-note
460        'to-relative-callback)
461        (lambda (music last-pitch)
462         pitch))
463
464     reference-note))
465
466
467
468 shiftDurations =
469 #(define-music-function (parser location dur dots arg) (integer? integer? ly:music?)
470    ""
471
472    
473    (music-map
474     (lambda (x)
475       (shift-one-duration-log x dur dots)) arg))
476
477
478 %% this is a stub. Write your own to suit the spacing tweak output.
479 spacingTweaks =
480 #(define-music-function (parser location parameters) (list?)
481    (make-music 'SequentialMusic 'void #t))
482
483
484 transposedCueDuring = #
485 (define-music-function
486   (parser location what dir pitch-note main-music)
487   (string? ly:dir? ly:music? ly:music?)
488
489   "Insert notes from the part @var{what} into a voice called @code{cue},
490 using the transposition defined by @var{pitch-note}.  This happens
491 simultaneously with @var{main-music}, which is usually a rest.  The
492 argument @var{dir} determines whether the cue notes should be notated
493 as a first or second voice."
494
495   (make-music 'QuoteMusic
496               'element main-music
497               'quoted-context-type 'Voice
498               'quoted-context-id "cue"
499               'quoted-music-name what
500               'quoted-voice-direction dir
501               'quoted-transposition (pitch-of-note pitch-note)
502               'origin location))
503
504
505
506
507
508 tweak = #(define-music-function (parser location sym val arg)
509            (symbol? scheme? ly:music?)
510
511            "Add @code{sym . val} to the @code{tweaks} property of @var{arg}."
512
513            
514            (set!
515             (ly:music-property arg 'tweaks)
516             (acons sym val
517                    (ly:music-property arg 'tweaks)))
518            arg)
519
520 tag = #(define-music-function (parser location tag arg)
521    (symbol? ly:music?)
522
523    "Add @var{tag} to the @code{tags} property of @var{arg}."
524
525    (set!
526     (ly:music-property arg 'tags)
527     (cons tag
528           (ly:music-property arg 'tags)))
529    arg)
530
531
532 unfoldRepeats =
533 #(define-music-function (parser location music) (ly:music?)
534                   (unfold-repeats music))