]> git.donarmstrong.com Git - lilypond.git/blob - scm/music-functions.scm
ly- -> ly:
[lilypond.git] / scm / music-functions.scm
1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2 ;; tuplets.
3
4 (define-public (denominator-tuplet-formatter mus)
5   (number->string (ly:get-mus-property mus 'denominator)))
6
7 (define-public (fraction-tuplet-formatter mus)
8   (string-append (number->string (ly:get-mus-property mus 'numerator))
9                  ":"
10                  (number->string (ly:get-mus-property mus 'denominator))
11                  ))
12
13 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
14
15
16 (define-public (shift-duration-log music shift dot)
17   "Recurse through music, adding SHIFT to ly:duration-log and optionally 
18   a dot to any note encountered. This scales the music up by a factor 
19   2^shift * (2 - (1/2)^dot)"
20   (let* ((es (ly:get-mus-property music 'elements))
21          (e (ly:get-mus-property music 'element))
22          (n  (ly:music-name music))
23          (f  (lambda (x)  (shift-duration-log x shift dot)))
24          )
25
26     ;; FIXME: broken by the great music rename.
27     (if (or (equal? n "Note_req")
28             (equal? n "Rest_req"))
29         (let* (
30                (d (ly:get-mus-property music 'duration))
31                (cp (ly:duration-factor d))
32                (nd (ly:make-duration (+ shift (ly:duration-log d))
33                                   (+ dot (duration-dot-count d))
34                                   (car cp)
35                                   (cdr cp)))
36                
37                )
38           (ly:set-mus-property! music 'duration nd)
39           ))
40     
41     (if (pair? es)
42         (ly:set-mus-property!
43          music 'elements
44          (map f es)))
45     
46     (if (ly:music? e)
47         (ly:set-mus-property!
48          music 'element
49          (f e)))
50     
51     music))
52
53
54 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
55 ;; repeats.
56
57 (define-public (unfold-repeats music)
58 "
59 This function replaces all repeats  with unfold repeats. It was 
60 written by Rune Zedeler. "
61   (let* ((es (ly:get-mus-property music 'elements))
62          (e (ly:get-mus-property music 'element))
63          (n  (ly:music-name music)))
64  
65     (if (equal? n "Repeated_music")
66         (begin
67           (if (equal?
68                (ly:get-mus-property music 'iterator-ctor)
69                Chord_tremolo_iterator::constructor)
70               (shift-ly:duration-log music  (ly:intlog2 (ly:get-mus-property music 'repeat-count)) 0)
71               )
72           (ly:set-mus-property!
73            music 'length Repeated_music::unfolded_music_length)
74           (ly:set-mus-property!
75            music 'start-moment-function Repeated_music::first_start)
76           (ly:set-mus-property!
77            music 'iterator-ctor Unfolded_repeat_iterator::constructor)))
78
79     (if (pair? es)
80         (ly:set-mus-property!
81          music 'elements
82          (map unfold-repeats es)))
83
84     (if (ly:music? e)
85         (ly:set-mus-property!
86          music 'element
87          (unfold-repeats e)))
88
89     music))
90
91
92 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
93 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
94
95 (define  (pitchify-scripts music)
96   "Copy the pitch fields of the Note_requests into  Text_script_requests, to aid
97 Fingering_engraver."
98   (define (find-note musics)
99     (filter-list (lambda (m) (equal? (ly:music-name m) "Note_req")) musics)
100     )
101   (define (find-scripts musics)
102     (filter-list (lambda (m) (equal? (ly:music-name m) "Text_script_req")) musics))
103
104   (let* (
105          (e (ly:get-mus-property music 'element))
106          (es (ly:get-mus-property music 'elements))
107          (notes (find-note es))
108          (pitch (if (pair? notes) (ly:get-mus-property (car  notes) 'pitch) #f))
109          )
110
111     (if pitch
112         (map (lambda (x) (ly:set-mus-property! x 'pitch pitch)) (find-scripts es))
113         )
114         
115     (if (pair? es)
116         (ly:set-mus-property!
117          music 'elements
118          (map pitchify-scripts es)))
119
120     (if (ly:music? e)
121         (ly:set-mus-property!
122          music 'element
123          (pitchify-scripts e)))
124
125     music))
126
127
128 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
129 ;; property setting music objs.
130 (define-public (make-grob-property-set grob gprop val)
131   "Make a M-exp that sets GPROP to VAL in GROBS. Does a pop first, i.e.
132 this is not an override 
133 "
134   
135    (let* ((m (make-music-by-name  'OverrideProperty)))
136      (ly:set-mus-property! m 'symbol grob)
137      (ly:set-mus-property! m 'grob-property gprop)
138      (ly:set-mus-property! m 'grob-value val)
139      (ly:set-mus-property! m 'pop-first #t)
140                 
141      m
142    
143    ))
144
145
146 (define-public (make-grob-property-revert grob gprop)
147   "Revert the grob property GPROP for GROB."
148    (let* ((m (make-music-by-name  'OverrideProperty)))
149      (ly:set-mus-property! m 'symbol grob)
150      (ly:set-mus-property! m 'grob-property gprop)
151                 
152      m
153    
154    ))
155    
156 (define-public (make-voice-props-set n)
157   (make-sequential-music
158    (append
159       (map (lambda (x) (make-grob-property-set x 'direction
160                                                (if (odd? n) -1 1)))
161            '(Tie Slur Stem Dots))
162       (list
163        (make-grob-property-set 'NoteColumn 'horizontal-shift (quotient n 2))
164        (make-grob-property-set 'MultiMeasureRest 'staff-position
165                                (if (odd? n) -4 4)
166                                )
167        
168        )
169    )
170   ))
171
172 (define-public (make-voice-props-revert)
173   (make-sequential-music
174    (list
175       (make-grob-property-revert 'Tie 'direction)
176       (make-grob-property-revert 'Dots 'direction)
177       (make-grob-property-revert 'Stem 'direction)
178       (make-grob-property-revert 'Slur 'direction)          
179       (make-grob-property-revert 'NoteColumn 'horizontal-shift)
180    ))
181   )
182
183 (define-public (context-spec-music m context . rest)
184   "Add \context CONTEXT = foo to M. "
185   
186   (let* ((cm (make-music-by-name 'ContextSpeccedMusic)))
187     (ly:set-mus-property! cm 'element m)
188     (ly:set-mus-property! cm 'context-type context)
189     (if (and  (pair? rest) (string? (car rest)))
190         (ly:set-mus-property! cm 'context-id (car rest))
191     )
192     cm
193   ))
194
195 (define-public (make-sequential-music elts)
196   (let*  ((m (make-music-by-name 'SequentialMusic)))
197     (ly:set-mus-property! m 'elements elts)
198     m
199   ))
200
201 (define-public (make-simultaneous-music elts)
202   (let*  ((m (make-music-by-name 'SimultaneousMusic)))
203     (ly:set-mus-property! m 'elements elts)
204     m
205     ))
206
207 (define-public (make-event-chord elts)
208   (let*  ((m (make-music-by-name 'EventChord)))
209     (ly:set-mus-property! m 'elements elts)
210     m
211     ))
212
213
214 (define-public (make-multi-measure-rest duration location)
215   (let*
216       (
217        (start (make-music-by-name 'MultiMeasureRestEvent))
218        (stop  (make-music-by-name 'MultiMeasureRestEvent))
219        (skip ( make-music-by-name 'SkipEvent))
220        (ch (make-music-by-name 'BarCheck))
221        (ch2  (make-music-by-name 'BarCheck))
222        )
223
224     (ly:set-mus-property! start 'span-direction START)
225     (ly:set-mus-property! stop 'span-direction STOP)    
226     (ly:set-mus-property! skip 'duration duration)
227     (map (lambda (x) (ly:set-mus-property! x 'origin location))
228          (list start stop skip ch ch2))
229     (make-sequential-music
230      (list
231       ch
232       (make-event-chord (list start))
233       (make-event-chord (list skip))
234       (make-event-chord (list stop))
235       ch2
236       ))
237     ))
238
239 (define-public (make-penalty-music pen)
240  (let
241      ((m (make-music-by-name 'BreakEvent)))
242    (ly:set-mus-property! m 'penalty pen)
243    m))
244
245 (define-public (make-articulation name)
246   (let* (
247          (m (make-music-by-name 'ArticulationEvent))
248       )
249       (ly:set-mus-property! m 'articulation-type name)
250       m
251   ))
252
253
254 (define-public (set-mus-properties! m alist)
255   "Set all of ALIST as properties of M." 
256   (if (pair? alist)
257       (begin
258         (ly:set-mus-property! m (caar alist) (cdar alist))
259         (set-mus-properties! m (cdr alist)))
260   ))
261
262 (define-public (music-separator? m)
263   "Is M a separator?"
264   (let* ((ts (ly:get-mus-property m 'types )))
265     (memq 'separator ts)
266   ))
267
268 (define (split-one sep?  l acc)
269   "Split off the first parts before separator and return both parts.
270
271 "
272   (if (null? l)
273       (cons acc '())
274       (if (sep? (car l))
275           (cons acc (cdr l))
276           (split-one sep? (cdr l) (cons (car l) acc))
277           )
278       ))
279
280 (define-public (split-list l sep?)
281   "
282
283 (display (split-list '(a b c / d e f / g) (lambda (x) (equal? x '/))) )
284 =>
285  ...
286
287 "
288   (if (null? l)
289       '()
290       (let* ((c (split-one sep? l '())))
291         (cons (reverse! (car c) '()) (split-list (cdr c) sep?))
292         )
293       )
294   )
295
296 ;;; splitting chords into voices.
297
298 (define (voicify-list lst number)
299    "Make a list of Musics.
300
301    voicify-list :: [ [Music ] ] -> number -> [Music]
302    LST is a list music-lists.
303 "
304
305    (if (null? lst) '()
306        (cons (context-spec-music
307               (make-sequential-music
308                (list
309                 (make-voice-props-set number)
310                 (make-simultaneous-music (car lst))))
311
312               "Voice"  (number->string number))
313               (voicify-list (cdr lst) (+ number 1))
314        ))
315    )
316
317 (define (voicify-chord ch)
318   "Split the parts of a chord into different Voices using separator"
319    (let* ((es (ly:get-mus-property ch 'elements)))
320
321
322      (ly:set-mus-property!  ch 'elements
323        (voicify-list (split-list es music-separator?) 0))
324      ch
325    ))
326
327 (define (voicify-music m)
328    "Recursively split chords that are separated with \\ "
329    
330    (if (not (ly:music? m))
331        (begin (display m)
332        (error "not music!"))
333        )
334    (let*
335        ((es (ly:get-mus-property m 'elements))
336         (e (ly:get-mus-property m 'element))
337         )
338      (if (pair? es)
339          (ly:set-mus-property! m 'elements (map voicify-music es)))
340      (if (ly:music? e)
341          (ly:set-mus-property! m 'element  (voicify-music e)))
342      (if
343       (and (equal? (ly:music-name m) "Simultaneous_music")
344            (reduce (lambda (x y ) (or x y))     (map music-separator? es)))
345       (voicify-chord m)
346       )
347
348      m
349      ))
350
351 (define-public (empty-music)
352   (ly:id (make-music-by-name 'Music))
353   )
354 ;;;
355
356 ; Make a function that checks score element for being of a specific type. 
357 (define-public (make-type-checker symbol)
358   (lambda (elt)
359     ;;(display  symbol)
360     ;;(eq? #t (ly:get-grob-property elt symbol))
361     (not (eq? #f (memq symbol (ly:get-grob-property elt 'interfaces))))))
362
363
364 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
365 ;; warn for bare chords at start.
366
367 (define (has-request-chord elts)
368   (reduce (lambda (x y) (or x y)) (map (lambda (x) (equal? (ly:music-name x)
369                                                            "Request_chord")) elts)
370   ))
371
372 (define (ly:music-message music msg)
373   (let* (
374       (ip (ly:get-mus-property music 'origin))
375       )
376
377     (if (ly:input-location? ip)
378         (ly:input-message ip msg)
379         (ly:warn msg))
380   ))
381   
382 (define (check-start-chords music)
383   "Check music expression for a Simultaneous_music containing notes\n(ie. Request_chords), without context specification. Called  from parser."
384   
385      (let*
386        ((es (ly:get-mus-property music 'elements))
387         (e (ly:get-mus-property music 'element))
388         (name (ly:music-name music)) 
389         )
390
391        (cond 
392          ((equal? name "Context_specced_music") #t)
393          ((equal? name "Simultaneous_music")
394
395           (if (has-request-chord es)
396               (ly:music-message music "Starting score with a chord.\nPlease insert an explicit \\context before chord")
397               (map check-start-chords es)))
398          
399          ((equal? name "Sequential_music")
400            (if (pair? es)
401                (check-start-chords (car es))))
402           (else (if (ly:music? e) (check-start-chords e )))
403        
404        ))
405      music
406      )
407
408
409 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
410 ;; switch it on here, so parsing and init isn't checked (too slow!)
411
412 ;; automatic music transformations.
413
414 (define (switch-on-debugging m)
415   (set-debug-cell-accesses! 15000)
416   m
417   )
418
419 (define-public toplevel-music-functions
420   (list check-start-chords
421         voicify-music
422
423 ; switch-on-debugging
424         ))
425
426