2 % Copyright (C) 2008, 2009, 2010, 2011 NICTA
3 % Author: Peter Chubb <peter.chubb AT nicta.com.au>
4 % $Id: articulate.ly,v 1.7 2011-03-24 00:40:00 peterc Exp $
7 % This program is free software; you can redistribute it and/or modify
8 % it under the terms of the GNU General Public License, version 3,
9 % as published by the Free Software Foundation.
11 % WARNING: this file under GPLv3 only, not GPLv3+
13 % This program is distributed in the hope that it will be useful,
14 % but WITHOUT ANY WARRANTY; without even the implied warranty of
15 % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16 % See the GNU General Public License for more details. It is
17 % available in the Lilypond source tree, or at
18 % http://www.gnu.org/licenses/gpl-3.0.html
20 % This script tries to make MIDI output from LilyPond a little more realistic.
21 % It tries to take articulations (slurs, staccato, etc) into account, by
22 % replacing notes with sequential music of suitably time-scaled note plus
25 % It also tries to unfold trills turns etc., and take rallentendo
26 % and accelerando into account.
28 % As my scheme knowledge is poor (I was teaching myself as I went), there
29 % is much scope for improvement.
33 % In the \score section do:
34 % \unfoldRepeats \articulate <<
35 % all the rest of the score
37 % or use the lilywrap script.
39 % TO DO (prioritised, the ones that'll make the most difference first)
42 % * Fix quantisation for dynamics on single note (replace note
43 % with tied 128th notes?) -- started, needs work.
44 % * Make \fp do the right thing (loud start, then quiet).
46 % * Inegalite. Notes on-beat steal time from notes off-beat.
47 % Degree of stealing is a parameter: from 1.0 (straight)
48 % to 1.5 (extreme swing). Also fix tenuto to use this.
50 % * add accel (to match rall), and molto rall. I've never seen
51 % molto accel but some composer somewhere has probably used it.
53 % * Fermata, and Fermata Lunga
54 % * Add more synonyms for accel and rall: rit ritard stringendo
57 % * Rall at end of piece
58 % * Very slight accel into a phrase, rall out of it.
59 % * Dynamics during a phrase???? unclear how these should be in
62 % * Trill algorithm needs work.
64 % * Cope with more ornaments/articulations.
65 % inverted-turns, etc.
66 % -- accent needs better control of dynamics.
67 % -- Articulations: mezzo-staccato, portato.
68 % -- Handling of generic ornaments (in lily, `\stopped'; in
69 % most early music: ornament this note (trill, turn
70 % or mordent as the player wishes))
71 % * Automatic gruppetto at end of trill; better handling of
72 % initial/final grace notes on trill
73 % * Automatic ornaments.
74 % * Spot cadences and ornament
75 % * Look for quaver-dotted note for trills, for example.
76 % * Fill in steps. (Needs lookahead/lookbehind.)
77 % * `afterturn' -- a turn after the start of a note.
78 % * accidentals for trills and turns
81 % * David Kastrup: basic 2.15.28 compatibility by using event-chord-wrap!
82 % This should really be done by rewriting the code more thoroughly.
83 % * From Iain Nicol: appoggiatura timings were out; add staccatissimo; fix
84 % trillSpanner endpoints.
85 % * Also handle Breathing events (by throwing them away). This isn't ideal;
86 % one should really shorten the note before a little. But I don't know
87 % how to do lookahead in scheme.
88 % * Also ignore explicit line breaks.
89 % * Add Mordents (reported by Patrick Karl)
94 #(use-modules (ice-9 debug))
95 #(use-modules (scm display-lily))
98 % How much to compress notes marked Staccato. CPE Bach says `as short as
99 % may conveniently be played, as if the keys were too hot to touch'.
100 % Most modern sources say 1/2 the notated length of a note.
101 #(define ac:staccatoFactor '(1 . 2))
103 % How much to compress notes marked staccatissimo.
104 #(define ac:staccatissimoFactor '(1 . 4))
106 % And tenuto (if we ever implement time stealing, this should be >1.0)
107 #(define ac:tenutoFactor '(1 . 1))
109 % How much to articulate normal notes. CPE Bach says 1/2 (and
110 % staccato should be `as short as may conveniently be played') but this
111 % sounds too short for modern music. 7/8 sounds about right.
112 #(define ac:normalFactor '(7 . 8))
114 % How much to slow down for a rall. or a poco rall.
115 % (or speed up for accel or poco accel)
116 #(define ac:rallFactor (ly:make-moment 60 100)) % 40% slowdown
117 #(define ac:pocoRallFactor (ly:make-moment 90 100)) % 10% slowdown
119 % The absolute time for a twiddle in a trill, in minutes.
120 % Start with 1/4 seconds == 1/240 minutes
121 #(define ac:maxTwiddleTime (ly:make-moment 1 240))
124 % Internal variables, don't touch.
125 % (should probably be part of a context somehow)
127 % Whether to slur, or not
128 #(define ac:inSlur #f)
129 #(define ac:inPhrasingSlur #f)
131 % Whether the current noteevent is in a trill spanner
132 #(define ac:inTrill #f)
134 % assume start in C major. Key change events override this.
135 % Could get from context, but don't know how.
136 #(define ac:current-key (make-music
139 (ly:make-pitch -1 0 0)
150 #(define ac:currentTempo (ly:make-moment 15 1)) % 4 = 60, measured wholes per minute
151 #(define ac:lastTempo ac:currentTempo) % for 'a tempo' or 'tempo I'
153 % The duration of the current note. Start at a crotchet
154 % for no good reason.
155 #(define ac:currentDuration (ly:make-duration 2 0 1 1))
157 % Debugging: display a moment plus some text.
158 % Returns its moment argument so can be used in-line.
159 #(define (display-moment text m)
161 (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
165 % Track tempo (and maybe later, other context properties)
166 % as they change. Needs to better cope with saving only Tempo I,
167 % otherwise "a tempo" goes back to the tempo before the last change.
168 #(define (ac:adjust-props sym music)
170 ((tempoWholesPerMinute)
171 (set! ac:currentTempo (ly:music-property music 'value))
172 (set! ac:lastTempo ac:currentTempo)
175 % Raise note one step in the current diatonic scale.
176 #(define (ac:up note)
177 (let* ((pitch (ly:music-property note 'pitch))
178 (notename (ly:pitch-notename pitch))
179 (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
180 (alterations (ly:music-property ac:current-key 'pitch-alist))
181 (new-alteration (cdr (assq new-notename alterations)))
182 (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
183 (ly:pitch-octave pitch)))
185 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
188 % Lower note one step in the current diatonic scale.
189 #(define (ac:down note)
190 (begin (let* ((pitch (ly:music-property note 'pitch))
191 (notename (ly:pitch-notename pitch))
192 (new-notename (if (eq? notename 0) 6 (- notename 1)))
193 (alterations (ly:music-property ac:current-key 'pitch-alist))
194 (new-alteration (cdr (assq new-notename alterations)))
195 (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
196 (ly:pitch-octave pitch)))
198 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
201 % Shorten a note, and save the note's original duration in ac:currentDuration
202 #(define (ac:articulate-one-note m fraction)
203 "Replace m with m*fraction"
204 (if (eq? 'NoteEvent (ly:music-property m 'name))
206 ((dur (ly:music-property m 'duration))
207 (l (ly:duration-log dur))
208 (d (ly:duration-dot-count dur))
209 (factor (ly:duration-factor dur))
211 (denom (cdr fraction)))
213 (set! ac:currentDuration dur)
214 (set! (ly:music-property m 'duration)
215 (ly:make-duration l d
217 (* denom (cdr factor))))))
220 % helper routine to set duration.
221 #(define (ac:setduration music duration)
222 "Set a note's duration."
223 (let ((eventtype (ly:music-property music 'name)))
226 (eq? eventtype 'NoteEvent)
227 (eq? eventtype 'RestEvent)
228 (eq? eventtype 'SkipEvent))
229 (set! (ly:music-property music 'duration) duration))))
231 % Add an articulation event to a note.
232 % Used in afterGrace to mark all notes as tenuto, so they're not shortened
233 #(define (ac:add-articulation type music)
234 (music-map (lambda (m)
235 (if (eq? 'EventChord (ly:music-property m 'name))
236 (set! (ly:music-property m 'elements)
237 (append (ly:music-property m 'elements)
238 (list (make-music 'ArticulationEvent 'articulation-type type)))))
242 % Convert a long note to an equivalent set of short notes, tied together.
243 % This is needed to get smooth dynamics changes.
244 % Need to deal properly with stuff other than the notes (dynamics, markup etc)
245 % Still experimental, so disabled for now.
246 #(define (ac:to128 music) music)
248 #(define (ac:to128_disabled music)
249 (if (or (eq? 'SkipEvent (ly:music-property music 'name))
250 (eq? 'NoteEvent (ly:music-property music 'name)))
251 (let* ((dur (ly:music-property music 'duration))
252 (log2 (ly:duration-log dur))
253 (shiftcount (- 6 log2))
254 (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
255 (set! (ly:music-property music 'elements)
256 (cons (make-music 'TieEvent) (ly:music-property music 'elements)))
257 (make-sequential-music (list
258 (make-repeat "unfold" (1- (expt 2 shiftcount))
259 (make-sequential-music (list music)) '())
264 % absolute time in minutes of a length of music, as a rational number (moment)
265 #(define (ac:abstime music)
266 (ly:moment-div (ly:music-length music) ac:currentTempo))
268 % convert absolute time (in minutes) to a moment in the current tempo
269 #(define (ac:abs->mom m)
270 (ly:moment-mul m ac:currentTempo))
273 % a moment that is ac:maxTwiddletime seconds at the current tempo.
274 #(define (ac:targetTwiddleTime)
275 (ac:abs->mom ac:maxTwiddleTime))
278 % Nearest twiddletime (in minutes) achievable with power-of-2 divisions of
279 % the original music. (twiddletime is the time for one pair of notes
281 % If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
282 #(define (ac:twiddletime music)
283 (let* ((tr (filter (lambda (x)
284 (and (eq? 'ArticulationEvent (ly:music-property x 'name))
285 (string= "trill" (ly:music-property x 'articulation-type))))
286 (ly:music-property music 'elements)))
287 (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
289 (t (ac:targetTwiddleTime)))
290 (if (ly:moment? pre-t)
292 (let loop ((len (ly:music-length music)))
293 (if (ly:moment<? t len)
294 (loop (ly:moment-mul len (ly:make-moment 1 2)))
299 % Note: I'm assuming early music practice of starting on the auxiliary note.
300 % Needs to add gruppetto if it's a long trill (TODO)
301 #(define (ac:trill music)
302 " Replace music with time-compressed repeats of the music,
303 maybe accelerating if the length is longer than a crotchet "
304 (let* ((hemisemidur (ly:make-duration 5 0 1 1))
305 (orig-len (ly:music-length music))
306 (t (ac:twiddletime music))
308 (note_moment (ly:moment-mul t (ly:make-moment 1 2)))
309 (c1 (ly:moment-div orig-len note_moment))
311 (round (/ (ly:moment-main-numerator c1)
312 (* 2 (ly:moment-main-denominator c1))))))
313 (count (if (< c2 2) 2 c2)))
315 (set! (ly:music-property music 'elements)
316 (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
317 (ly:music-property music 'elements)))
318 (map (lambda (y) (ac:setduration y hemisemidur))
319 (ly:music-property music 'elements))
320 (set! uppernote (ly:music-deep-copy music))
321 (map (lambda (y) (ac:up y))
323 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
324 (ly:music-property uppernote 'elements)))
326 (let* ((trillMusicElements
327 (let loop ((so_far (list uppernote music))
330 (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
332 (trillMusic (make-sequential-music trillMusicElements))
333 (newlen (ly:music-length trillMusic))
334 (factor (ly:moment-div orig-len newlen)))
335 (ly:music-compress trillMusic factor)
336 ; accelerating the music seems to put lily into an infinite loop in
337 ; its layout and midi engines.
338 ; (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
339 ; (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
341 ; (ac:accel trillMusic factor))
347 % If there's an articulation, use it.
348 % If in a slur, use (1 . 1) instead.
349 % Treat phrasing slurs as slurs, but allow explicit articulation.
350 % (Maybe should treat staccato under a phrasing slur as mezzo-staccato?)
352 % Expect an EventChord.
354 % trills, turns, ornaments etc. are also treated as Articulations.
355 % Split into two functions:
356 % ac:getactions traverses the elements in the EventChord
357 % and calculates the parameters.
358 % ac:articulate-chord applies the actions to each NoteEvent in
360 #(define (ac:getactions music)
361 (let loop ((factor ac:normalFactor)
363 (es (ly:music-property music 'elements))
367 (set! (ly:music-property music 'elements) (reverse newelements))
369 (ac:inTrill (cons 'trill actions))
370 ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
371 (append actions (list 'articulation '(1 . 1)) ))
372 (else (append actions (list 'articulation factor)))))
376 (case (ly:music-property e 'name)
378 ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
379 (loop factor newelements tail actions))
381 ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
382 (loop (cons 1 1) (cons e newelements) tail actions))
385 (let ((articname (ly:music-property e 'articulation-type)))
386 ; TODO: add more here
388 ((string= articname "staccato")
389 (loop ac:staccatoFactor newelements tail actions))
390 ((string= articname "staccatissimo")
391 (loop ac:staccatissimoFactor newelements tail actions))
392 ((string= articname "tenuto")
393 (loop ac:tenutoFactor newelements tail actions))
394 ((string= articname "mordent")
395 (loop (cons 1 1) newelements tail (cons 'mordent actions)))
396 ((string= articname "prall")
397 (loop (cons 1 1) newelements tail (cons 'trill actions)))
398 ((string= articname "trill")
399 (loop (cons 1 1) newelements tail (cons 'trill actions)))
400 ((string= articname "turn")
401 (loop (cons 1 1) newelements tail (cons 'turn actions)))
402 (else (loop factor (cons e newelements) tail actions)))))
405 (let ((t (ly:music-property e 'text)))
406 (if (not (string? t))
407 (loop factor (cons e newelements) tail actions)
415 (loop factor (cons e newelements) tail (cons 'rall actions)))
417 (string= t "poco rall.")
418 (string= t "poco rit."))
419 (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
420 ((or (string= t "a tempo")
421 (string= t "tempo I"))
422 (loop factor (cons e newelements) tail (cons 'aTempo actions)))
423 (else (loop factor (cons e newelements) tail actions)))))))
426 (let ((direction (ly:music-property e 'span-direction)))
427 (set! ac:inSlur (eq? direction -1))
428 (loop factor newelements tail actions)))
431 (let ((direction (ly:music-property e 'span-direction)))
432 (set! ac:inTrill (eq? direction -1))
434 (loop factor newelements tail (cons 'trill actions))
435 (loop factor (cons e newelements) tail actions))))
438 (let ((direction (ly:music-property e 'span-direction)))
439 (set! ac:inPhrasingSlur (eq? direction -1))
440 (loop factor newelements tail actions)))
442 (else (loop factor (cons e newelements) tail actions)))))))
446 #(define (ac:articulate-chord music)
450 ((eq? 'EventChord (ly:music-property music 'name))
451 (let loop ((actions (ac:getactions music)))
453 (if (ly:moment> (ly:music-length music) (make-moment 1 4))
461 (lambda (x) (ac:articulate-one-note x (cadr actions)))
462 (ly:music-property music 'elements))
464 ((num (caadr actions))
465 (denom (cdadr actions))
466 (mult (ly:duration-factor ac:currentDuration))
467 (newnum (* (- denom num) (car mult)))
468 (newdenom (* (cdr mult) denom))
469 (len (ly:duration-log ac:currentDuration))
470 (dots (ly:duration-dot-count ac:currentDuration)))
472 (if (not (eq? num denom))
473 (make-sequential-music
474 (list (ac:to128 music)
475 (make-music 'EventChord 'elements
477 (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
481 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
482 (let ((pset (make-music 'PropertySet
486 'tempoWholesPerMinute)))
487 (if (null? (cdr actions))
488 (make-sequential-music (list pset music))
489 (make-sequential-music
490 (list pset (loop (cdr actions)))))))
493 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
494 (let ((pset (make-music 'PropertySet
498 'tempoWholesPerMinute)))
499 (if (null? (cdr actions))
500 (make-sequential-music (list pset music))
501 (make-sequential-music
502 (list pset (loop (cdr actions)))))))
505 (set! ac:currentTempo ac:lastTempo)
506 (let ((pset (make-music 'PropertySet
510 'tempoWholesPerMinute)))
511 (if (null? (cdr actions))
512 (make-sequential-music (list pset music))
513 (make-sequential-music
514 (list pset (loop (cdr actions)))))))
521 ((dur (ly:music-property
522 (car (ly:music-property music 'elements)) 'duration))
523 (factor (ly:duration-factor dur))
524 (gracenote (ly:music-deep-copy music))
525 (mainnote (ly:music-deep-copy music))
526 (belownote (ly:music-deep-copy music))
527 (mordent (make-sequential-music (list gracenote belownote)))
530 (music-map (lambda (n)
531 (if (eq? 'NoteEvent (ly:music-property n 'name))
532 (set! (ly:music-property n 'duration)(ly:make-duration 3 0 1 1)))
535 (map (lambda (y) (ac:down y))
537 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
538 (ly:music-property belownote 'elements)))
539 (make-sequential-music (list (make-grace-music mordent) mainnote)))))
542 ((dur (ly:music-property
543 (car (ly:music-property music 'elements)) 'duration))
544 (factor (ly:duration-factor dur))
545 (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
546 (ly:duration-dot-count dur) (car factor)(cdr factor))))
548 (map (lambda (y) (ac:setduration y newdur))
549 (ly:music-property music 'elements))
550 (let* ((above (ly:music-deep-copy music))
551 (below (ly:music-deep-copy music))
552 (newmusic (make-sequential-music (list above music below music))))
554 (map (lambda (y) (ac:down y))
556 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
557 (ly:music-property below 'elements)))
558 (map (lambda (y) (ac:up y))
560 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
561 (ly:music-property above 'elements)))
565 ((eq? 'KeyChangeEvent (ly:music-property music 'name))
566 (set! ac:current-key music)
570 ((eq? 'PropertySet (ly:music-property music 'name))
571 (ac:adjust-props (ly:music-property music 'symbol) music)
579 % At last ... here's the music function that aplies all the above to a
581 articulate = #(define-music-function (parser location music)
583 "Adjust times of note to add tenuto, staccato and
584 normal articulations.
586 (set! music (event-chord-wrap! music parser))
587 (music-map ac:articulate-chord music)
591 % Override \afterGrace to be in terms of audio, not spacing.
592 % Special handling for a gruppetto after a trill.
594 #(define-music-function
595 (parser location main grace)
596 (ly:music? ly:music?)
598 (set! main (event-chord-wrap! main parser))
599 (set! grace (event-chord-wrap! grace parser))
601 ((main-length (ly:music-length main))
602 (grace-orig-length (ly:music-length grace))
603 (gracelen (ac:twiddletime main))
604 (grace-factor (ly:moment-div gracelen grace-orig-length))
605 (new-main-length (ly:moment-sub main-length gracelen))
606 (factor (ly:moment-div new-main-length main-length))
608 (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
611 (eq? 'ArticulationEvent (ly:music-property z 'name))
612 (string= "trill" (ly:music-property z 'articulation-type))))
613 (ly:music-property main 'elements)))
614 (ac:add-articulation "tenuto" grace)
615 (make-sequential-music (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
617 % An appoggiatura takes half the duration of the main note,
618 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
619 % Somewhere around the end of the 19th, start of 20th century the rules
620 % changed, but my main interest is early music.
622 #(define-music-function (parser location grace main)
623 (ly:music? ly:music?)
624 (set! grace (event-chord-wrap! grace parser))
625 (set! main (event-chord-wrap! main parser))
626 (let* ((maindur (ly:music-length main))
627 (grace-orig-len (ly:music-length grace))
628 (main-orig-len (ly:music-length main))
629 (numerator (ly:moment-main-numerator maindur))
630 (factor (if (eq? (remainder numerator 3) 0)
631 (ly:make-moment 1 3) (ly:make-moment 1 2))))
632 (ly:music-compress grace
633 (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
634 (ly:music-compress main (ly:moment-sub (ly:make-moment 1 1) factor))
636 (set! (ly:music-property grace 'elements)
637 (append (ly:music-property grace 'elements)
638 (list (make-music 'SlurEvent 'span-direction -1))))
639 (set! (ly:music-property main 'elements)
640 (append (ly:music-property main 'elements)
641 (list (make-music 'SlurEvent 'span-direction 1))))
642 (make-sequential-music (list grace main))))