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