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 % Trills, turns, mordents and pralls are expanded with rallentendo
26 % and accelerando taken into account.
28 % As my scheme knowledge is poor (I was teaching myself as I went), there
29 % is much scope for improvement.
31 % See: http://nicta.com.au/people/chubbp/articulate for additional
32 % information about how the articulate function works.
35 % Articulations on a single note (staccato, staccatissimo, portato, tenuto).
36 % Slurs and phrasing slurs.
37 % Ornaments (i.e. mordents, trills, turns).
38 % Rallentando, accelerando, ritard and 'a tempo'.
40 % Please refer to 'MIDI output' (Section 3.5) in the Notation Reference
41 % Manual for a more detailed list of supported items.
43 %%% Technical Details:
44 % * Any note not under a slur or phrasing slur, and not marked with an
45 % explicit articulation, is shortened by ac:normalFactor (default 7/8).
46 % (Shortening a note means replacing the note with a note of a smaller
47 % duration, and a rest to make up for the difference between the durations
48 % of the original and the shortened note.)
49 % * Notes marked with articulations are shortened by factors specific to the
50 % articulation as follows:
51 % staccato not under a slur: ac:staccatoFactor (default 1/2)
52 % under a slur: ac:portatoFactor (default 3/4)
53 % staccatissimo ac:staccatissimoFactor (default 1/4)
54 % portato ac:portatoFactor (default 3/4)
55 % tenuto ac:tenutoFactor (default 1/1 - by default, notes marked
56 % tenuto are not shortened)
57 % * Appogiaturas are made to take half the value of the note following,
58 % without taking dots into account (so in \appoggiatura c8 d2. the c
59 % will take the time of a crotchet).
60 % * Trills and turns are expanded. The algorithm tries to choose notes
61 % within the time of the current tempo that lead to each twiddle being
62 % around 1/8 seconds; this can be adjusted with the ac:maxTwiddleTime
64 % * Rall, poco rall and a tempo are observed. It'd be fairly trivial to
65 % make accel. and stringendo and so on work too.
69 % In the \score section do:
71 % all the rest of the score
73 % or use the lilywrap script.
78 % * Fix quantisation for dynamics on single note (replace note
79 % with tied 128th notes?) -- started, needs work.
80 % * Make \fp do the right thing (loud start, then quiet).
82 % * Inegalite. Notes on-beat steal time from notes off-beat.
83 % Degree of stealing is a parameter: from 1.0 (straight)
84 % to 1.5 (extreme swing). Also fix tenuto to use this.
86 % * add accel (to match rall), and molto rall. I've never seen
87 % molto accel but some composer somewhere has probably used it.
89 % * Fermata, and Fermata Lunga
90 % * Add more synonyms for accel and rall: rit ritard stringendo
93 % * Rall at end of piece
94 % * Very slight accel into a phrase, rall out of it.
95 % * Dynamics during a phrase???? unclear how these should be in
98 % * Trill algorithm needs work.
100 % * Cope with more ornaments/articulations.
101 % inverted-turns, etc.
102 % -- accent needs better control of dynamics.
103 % -- Handling of generic ornaments (in lily, `\stopped'; in
104 % most early music: ornament this note (trill, turn
105 % or mordent as the player wishes))
107 % * Automatic gruppetto at end of trill; better handling of
108 % initial/final grace notes on trill
110 % * Automatic ornaments.
111 % * Spot cadences and ornament
112 % * Look for quaver-dotted note for trills, for example.
113 % * Fill in steps. (Needs lookahead/lookbehind.)
114 % * `afterturn' -- a turn after the start of a note.
115 % * accidentals for trills and turns
118 % * Heikki Tauriainen: handle also the \portato articulation (both as an
119 % explicit articulation, and as the articulation to use for slurred
120 % notes marked \staccato).
121 % * David Kastrup: remove redefinitions of \afterGrace and \appoggiatura
122 % and let their actions be performed when \articulate is called by
123 % recognizing and replacing LilyPond's default code for these constructs.
124 % Cf issue 4517 in LilyPond's tracker.
125 % * David Kastrup: basic 2.15.28 compatibility by using event-chord-wrap!
126 % This should really be done by rewriting the code more thoroughly.
127 % * From Iain Nicol: appoggiatura timings were out; add staccatissimo; fix
128 % trillSpanner endpoints.
129 % * Also handle Breathing events (by throwing them away). This isn't ideal;
130 % one should really shorten the note before a little. But I don't know
131 % how to do lookahead in scheme.
132 % * Also ignore explicit line breaks.
133 % * Add Mordents (reported by Patrick Karl)
138 #(use-modules (srfi srfi-1))
139 #(use-modules (srfi srfi-11))
140 #(use-modules (ice-9 debug))
141 #(use-modules (scm display-lily))
144 % How much to compress notes marked Staccato. CPE Bach says `as short as
145 % may conveniently be played, as if the keys were too hot to touch'.
146 % Most modern sources say 1/2 the notated length of a note.
147 #(define ac:staccatoFactor '(1 . 2))
149 % How much to compress notes marked staccatissimo.
150 #(define ac:staccatissimoFactor '(1 . 4))
152 % Shortening factor for notes marked portato (or slurred notes marked
154 #(define ac:portatoFactor '(3 . 4))
156 % And tenuto (if we ever implement time stealing, this should be >1.0)
157 #(define ac:tenutoFactor '(1 . 1))
159 % How much to articulate normal notes. CPE Bach says 1/2 (and
160 % staccato should be `as short as may conveniently be played') but this
161 % sounds too short for modern music. 7/8 sounds about right.
162 #(define ac:normalFactor '(7 . 8))
164 % How much to slow down for a rall. or a poco rall.
165 % (or speed up for accel or poco accel)
166 #(define ac:rallFactor (ly:make-moment 60/100)) % 40% slowdown
167 #(define ac:pocoRallFactor (ly:make-moment 90/100)) % 10% slowdown
169 % The absolute time for a twiddle in a trill, in minutes.
170 % Start with 1/4 seconds == 1/240 minutes
171 #(define ac:maxTwiddleTime (ly:make-moment 1/240))
173 % How long ordinary grace notes should be relative to their notated
174 % duration. 9/40 is LilyPond's built-in behaviour for MIDI output
175 % (though the notation reference says 1/4).
176 #(define ac:defaultGraceFactor 9/40)
178 % What proportion of an ordinary grace note's time should be stolen
179 % from preceding notes (as opposed to stealing from the principal note).
180 % Composers' intentions for this vary. Taking all from the preceding
181 % notes is LilyPond's built-in behaviour for MIDI output.
182 #(define ac:defaultGraceBackwardness 1)
185 % Internal variables, don't touch.
186 % (should probably be part of a context somehow)
188 % Whether to slur, or not
189 #(define ac:inSlur #f)
190 #(define ac:inPhrasingSlur #f)
192 % Whether the current noteevent is in a trill spanner
193 #(define ac:inTrill #f)
195 % assume start in C major. Key change events override this.
196 % Could get from context, but don't know how.
197 #(define ac:current-key (make-music
200 (ly:make-pitch -1 0 0)
211 #(define ac:currentTempo (ly:make-moment 15/1)) % 4 = 60, measured wholes per minute
212 #(define ac:lastTempo ac:currentTempo) % for 'a tempo' or 'tempo I'
214 % The duration of the current note. Start at a crotchet
215 % for no good reason.
216 #(define ac:currentDuration (ly:make-duration 2 0 1/1))
218 % Amount of musical time (in whole notes) that we need to steal from the
220 #(define ac:stealForward 0)
222 % List of events in the output so far, in reverse order, from which we can
224 #(define ac:eventsBackward '())
226 % Log events for the backward chain.
227 #(define (ac:logEventsBackward music)
230 (case (ly:music-property m 'name)
232 (set! ac:eventsBackward (cons m ac:eventsBackward))
234 ((BarCheck SkipMusic)
235 (let ((wm (make-sequential-music (list m))))
236 (set! ac:eventsBackward (cons wm ac:eventsBackward))
242 % Steal time from the backward chain. Adds to ac:stealForward (with a
243 % warning) if it couldn't backward-steal all that was desired.
244 #(define (ac:stealTimeBackward tosteal)
247 (if (null? ac:eventsBackward)
249 (ly:warning (_ "articulation failed to steal ~a note backward at beginning of music; stealing forward instead") tosteal)
250 (set! ac:stealForward (+ ac:stealForward tosteal)))
252 ((lastev (car ac:eventsBackward))
253 (levlen (ly:moment-main (ly:music-length lastev))))
254 (if (< tosteal levlen)
256 (ly:music-compress lastev (ly:make-moment (/ (- levlen tosteal) levlen)))
259 (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
260 (ly:music-property lastev 'elements))
261 (ly:warning (_ "stealing the entirety of a note's time")))
262 (set! (ly:music-property lastev 'elements) '())
263 (set! ac:eventsBackward (cdr ac:eventsBackward))
264 (ac:stealTimeBackward (- tosteal levlen))))))))
266 % Debugging: display a moment plus some text.
267 % Returns its moment argument so can be used in-line.
268 #(define (display-moment text m)
270 (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
274 % Track tempo (and maybe later, other context properties)
275 % as they change. Needs to better cope with saving only Tempo I,
276 % otherwise "a tempo" goes back to the tempo before the last change.
277 #(define (ac:adjust-props sym music)
279 ((tempoWholesPerMinute)
280 (set! ac:currentTempo (ly:music-property music 'value))
281 (set! ac:lastTempo ac:currentTempo)
284 % Raise note one step in the current diatonic scale.
285 #(define (ac:up note)
286 (let* ((pitch (ly:music-property note 'pitch))
287 (notename (ly:pitch-notename pitch))
288 (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
289 (alterations (ly:music-property ac:current-key 'pitch-alist))
290 (new-alteration (cdr (assq new-notename alterations)))
291 (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
292 (ly:pitch-octave pitch)))
294 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
297 % Lower note one step in the current diatonic scale.
298 #(define (ac:down note)
299 (begin (let* ((pitch (ly:music-property note 'pitch))
300 (notename (ly:pitch-notename pitch))
301 (new-notename (if (eq? notename 0) 6 (- notename 1)))
302 (alterations (ly:music-property ac:current-key 'pitch-alist))
303 (new-alteration (cdr (assq new-notename alterations)))
304 (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
305 (ly:pitch-octave pitch)))
307 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
310 % Shorten a note, and save the note's original duration in ac:currentDuration
311 #(define (ac:articulate-one-note m fraction)
312 "Replace m with m*fraction"
313 (if (eq? 'NoteEvent (ly:music-property m 'name))
315 ((dur (ly:music-property m 'duration))
316 (l (ly:duration-log dur))
317 (d (ly:duration-dot-count dur))
318 (factor (ly:duration-factor dur))
320 (denom (cdr fraction)))
322 (set! ac:currentDuration dur)
323 (set! (ly:music-property m 'duration)
324 (ly:make-duration l d
326 (* denom (cdr factor))))))
329 % helper routine to set duration.
330 #(define (ac:setduration music duration)
331 "Set a note's duration."
332 (let ((eventtype (ly:music-property music 'name)))
335 (eq? eventtype 'NoteEvent)
336 (eq? eventtype 'RestEvent)
337 (eq? eventtype 'SkipEvent))
338 (set! (ly:music-property music 'duration) duration))))
340 % Add an articulation event to a note.
341 % Used in afterGrace to mark all notes as tenuto, so they're not shortened
342 #(define (ac:add-articulation type music)
343 (music-map (lambda (m)
344 (if (eq? 'EventChord (ly:music-property m 'name))
345 (set! (ly:music-property m 'elements)
346 (append (ly:music-property m 'elements)
347 (list (make-music 'ArticulationEvent 'articulation-type type)))))
351 % Convert a long note to an equivalent set of short notes, tied together.
352 % This is needed to get smooth dynamics changes.
353 % Need to deal properly with stuff other than the notes (dynamics, markup etc)
354 % Still experimental, so disabled for now.
355 #(define (ac:to128 music) music)
357 #(define (ac:to128_disabled music)
358 (if (or (eq? 'SkipEvent (ly:music-property music 'name))
359 (eq? 'NoteEvent (ly:music-property music 'name)))
360 (let* ((dur (ly:music-property music 'duration))
361 (log2 (ly:duration-log dur))
362 (shiftcount (- 6 log2))
363 (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
364 (set! (ly:music-property music 'elements)
365 (cons (make-music 'TieEvent) (ly:music-property music 'elements)))
366 (make-sequential-music (list
367 (make-repeat "unfold" (1- (expt 2 shiftcount))
368 (make-sequential-music (list music)) '())
373 % absolute time in minutes of a length of music, as a rational number (moment)
374 #(define (ac:abstime music)
375 (ly:moment-div (ly:music-length music) ac:currentTempo))
377 % convert absolute time (in minutes) to a moment in the current tempo
378 #(define (ac:abs->mom m)
379 (ly:moment-mul m ac:currentTempo))
382 % a moment that is ac:maxTwiddletime seconds at the current tempo.
383 #(define (ac:targetTwiddleTime)
384 (ac:abs->mom ac:maxTwiddleTime))
387 % Nearest twiddletime (in minutes) achievable with power-of-2 divisions of
388 % the original music. (twiddletime is the time for one pair of notes
390 % If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
391 #(define (ac:twiddletime music)
392 (let* ((tr (filter (lambda (x)
393 (and (eq? 'ArticulationEvent (ly:music-property x 'name))
394 (string= "trill" (ly:music-property x 'articulation-type))))
395 (ly:music-property music 'elements)))
396 (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
398 (hemisemimom (ly:make-moment 1/64))
399 (t (ac:targetTwiddleTime)))
400 (if (ly:moment? pre-t)
406 % Note: I'm assuming early music practice of starting on the auxiliary note.
407 % Needs to add gruppetto if it's a long trill (TODO)
408 #(define (ac:trill music)
409 " Replace music with time-compressed repeats of the music,
410 maybe accelerating if the length is longer than a crotchet "
411 (let* ((hemisemidur (ly:make-duration 5 0 1/1))
412 (orig-len (ly:music-length music))
413 (t (ac:twiddletime music))
415 (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
416 (c1 (ly:moment-div orig-len t))
418 (round (/ (ly:moment-main-numerator c1)
419 (* 2 (ly:moment-main-denominator c1))))))
420 (count (if (< c2 2) 2 c2)))
422 (set! (ly:music-property music 'elements)
423 (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
424 (ly:music-property music 'elements)))
425 (map (lambda (y) (ac:setduration y hemisemidur))
426 (ly:music-property music 'elements))
427 (set! uppernote (ly:music-deep-copy music))
428 (map (lambda (y) (ac:up y))
430 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
431 (ly:music-property uppernote 'elements)))
433 (let* ((trillMusicElements
434 (let loop ((so_far (list uppernote music))
437 (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
439 (trillMusic (make-sequential-music trillMusicElements))
440 (newlen (ly:music-length trillMusic))
441 (factor (ly:moment-div orig-len newlen)))
442 (ly:music-compress trillMusic factor)
443 ; accelerating the music seems to put lily into an infinite loop in
444 ; its layout and midi engines.
445 ; (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
446 ; (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
448 ; (ac:accel trillMusic factor))
452 % Copy music and strip articulations, ties, etc., for generating
454 #(define (ac:note-copy music)
455 "return a copy of music that is only notes, no articulations, ties, slurs etc"
456 (let ((new-music (ly:music-deep-copy music)))
457 (set! (ly:music-property new-music 'articulations) '())
458 (set! (ly:music-property new-music 'elements)
459 (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
460 (ly:music-property new-music 'elements)))
464 % Generate a tempoChangeEvent and its associated property setting.
466 #(define (ac:tempoChange tempo)
467 (make-sequential-music
468 (list (make-music 'TempoChangeEvent
472 (ly:make-duration 0 0 1/1))
474 (make-property-set 'tempoWholesPerMinute tempo) 'Score))))
477 % Totally unfold repeats, so that the non-obvious sequencing doesn't
478 % confuse us. This is necessary for time stealing to work, because
479 % that relies on the sequence in which we see events matching their
480 % audible sequence. Also unfold multi-measure rests to equivalent
481 % skips, with preceding and following bar checks, so that time stealing
482 % can change the length of the pause without falling foul of the
483 % implicit bar checks.
485 #(define (ac:unfoldMusic music)
488 (case (ly:music-property m 'name)
489 ((UnfoldedRepeatedMusic)
491 ((body (ly:music-property m 'element))
492 (altl (ly:music-property m 'elements))
493 (rc (ly:music-property m 'repeat-count)))
495 (make-sequential-music
496 (list-tabulate rc (lambda (i) (ly:music-deep-copy body))))
497 (let ((ealtl (if (> (length altl) rc) (take altl rc) altl)))
498 (make-sequential-music
502 (- rc (length ealtl))
503 (lambda (i) (list (ly:music-deep-copy body) (ly:music-deep-copy (car ealtl)))))
504 (map (lambda (alt) (list (ly:music-deep-copy body) alt)) ealtl))))))))
508 (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
509 (ly:music-property m 'elements))))
513 ((tremtype (ly:music-property (car trem) 'tremolo-type))
514 (tremtype-log (1- (integer-length tremtype)))
515 (durev (find (lambda (v) (not (null? (ly:music-property v 'duration)))) evl))
516 (totaldur (if durev (ly:music-property durev 'duration) (ly:make-duration tremtype-log 0 1)))
517 (tgt-nrep (/ (duration-visual-length totaldur) (duration-log-factor tremtype-log)))
518 (eff-nrep (max (truncate tgt-nrep) 1))
519 (tremdur (ly:make-duration tremtype-log 0
520 (* (/ tgt-nrep eff-nrep) (ly:duration-scale totaldur)))))
521 (or (and (= eff-nrep tgt-nrep) (= (ash 1 tremtype-log) tremtype))
522 (ly:warning (_ "non-integer tremolo ~a:~a")
523 (duration->lily-string (duration-visual totaldur) #:force-duration #t #:time-scale 1)
527 (or (null? (ly:music-property v 'duration))
528 (set! (ly:music-property v 'duration) tremdur)))
530 (set! (ly:music-property m 'elements) evl)
531 (make-sequential-music
532 (list-tabulate eff-nrep (lambda (i) (ly:music-deep-copy m))))))))
533 ((MultiMeasureRestMusic)
534 (make-sequential-music
536 (make-music 'BarCheck)
537 (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
538 (make-music 'BarCheck))))
541 (unfold-repeats music)))
543 % If there's an articulation, use it.
544 % If in a slur, use (1 . 1) instead (unless the note is marked staccato,
545 % in which case use ac:portatoFactor).
546 % Treat phrasing slurs as slurs, but allow explicit articulation.
548 % Expect an EventChord.
550 % trills, turns, ornaments etc. are also treated as Articulations.
551 % Split into two functions:
552 % ac:getactions traverses the elements in the EventChord
553 % and calculates the parameters.
554 % ac:articulate-chord applies the actions to each NoteEvent in
556 #(define (ac:getactions music)
557 (let ((at-end-of-slur #f))
558 (let loop ((factor ac:normalFactor)
560 (es (ly:music-property music 'elements))
564 (set! (ly:music-property music 'elements) (reverse newelements))
566 (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
570 (let ((st ac:stealForward))
574 (set! ac:stealForward 0)
578 (ac:inTrill '(trill))
579 ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
580 (list 'articulation '(1 . 1)))
581 ((and (eq? factor ac:staccatoFactor) (or ac:inSlur at-end-of-slur))
582 (list 'articulation ac:portatoFactor))
583 (else (list 'articulation factor))))))
587 (case (ly:music-property e 'name)
589 ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
590 (loop factor newelements tail actions))
592 ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
593 (loop (cons 1 1) (cons e newelements) tail actions))
596 (let ((articname (ly:music-property e 'articulation-type)))
597 ; TODO: add more here
599 ((string= articname "staccato")
600 (loop ac:staccatoFactor newelements tail actions))
601 ((string= articname "staccatissimo")
602 (loop ac:staccatissimoFactor newelements tail actions))
603 ((string= articname "portato")
604 (loop ac:portatoFactor newelements tail actions))
605 ((string= articname "tenuto")
606 (loop ac:tenutoFactor newelements tail actions))
607 ((string= articname "mordent")
608 (loop (cons 1 1) newelements tail (cons 'mordent actions)))
609 ((string= articname "prall")
610 (loop (cons 1 1) newelements tail (cons 'prall actions)))
611 ((string= articname "trill")
612 (loop (cons 1 1) newelements tail (cons 'trill actions)))
613 ((string= articname "turn")
614 (loop (cons 1 1) newelements tail (cons 'turn actions)))
615 (else (loop factor (cons e newelements) tail actions)))))
618 (let ((t (ly:music-property e 'text)))
619 (if (not (string? t))
620 (loop factor (cons e newelements) tail actions)
628 (loop factor (cons e newelements) tail (cons 'rall actions)))
630 (string= t "accelerando")
632 (string= t "accel."))
633 (loop factor (cons e newelements) tail (cons 'accel actions)))
635 (string= t "poco accel."))
636 (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
638 (string= t "poco rall.")
639 (string= t "poco rit."))
640 (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
641 ((or (string= t "a tempo")
642 (string= t "tempo I"))
643 (loop factor (cons e newelements) tail (cons 'aTempo actions)))
644 (else (loop factor (cons e newelements) tail actions)))))))
647 (let ((direction (ly:music-property e 'span-direction)))
648 (set! ac:inSlur (eq? direction -1))
649 (set! at-end-of-slur (eq? direction 1))
650 (loop factor newelements tail actions)))
653 (let ((direction (ly:music-property e 'span-direction)))
654 (set! ac:inTrill (eq? direction -1))
656 (loop factor newelements tail (cons 'trill actions))
657 (loop factor (cons e newelements) tail actions))))
660 (let ((direction (ly:music-property e 'span-direction)))
661 (set! ac:inPhrasingSlur (eq? direction -1))
662 (loop factor newelements tail actions)))
664 (else (loop factor (cons e newelements) tail actions))))))))
668 #(define (ac:articulate-chord music)
670 ((eq? 'EventChord (ly:music-property music 'name))
671 (ac:logEventsBackward
672 (let loop ((actions (ac:getactions music)))
674 (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
682 (lambda (x) (ac:articulate-one-note x (cadr actions)))
683 (ly:music-property music 'elements))
685 ((num (caadr actions))
686 (denom (cdadr actions))
687 (mult (ly:duration-factor ac:currentDuration))
688 (newnum (* (- denom num) (car mult)))
689 (newdenom (* (cdr mult) denom))
690 (len (ly:duration-log ac:currentDuration))
691 (dots (ly:duration-dot-count ac:currentDuration)))
693 (if (not (eq? num denom))
694 (make-sequential-music
695 (list (ac:to128 music)
696 (make-music 'EventChord 'elements
698 (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
702 (set! ac:lastTempo ac:currentTempo)
703 (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
704 (let ((pset (ac:tempoChange ac:currentTempo)))
705 (if (null? (cdr actions))
706 (make-sequential-music (list pset music))
707 (make-sequential-music
708 (list pset (loop (cdr actions)))))))
711 (set! ac:lastTempo ac:currentTempo)
712 (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
713 (let ((pset (ac:tempoChange ac:currentTempo)))
714 (if (null? (cdr actions))
715 (make-sequential-music (list pset music))
716 (make-sequential-music
717 (list pset (loop (cdr actions)))))))
720 (set! ac:lastTempo ac:currentTempo)
721 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
722 (let ((pset (ac:tempoChange ac:currentTempo)))
723 (if (null? (cdr actions))
724 (make-sequential-music (list pset music))
725 (make-sequential-music
726 (list pset (loop (cdr actions)))))))
729 (set! ac:lastTempo ac:currentTempo)
730 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
731 (let ((pset (ac:tempoChange ac:currentTempo)))
732 (if (null? (cdr actions))
733 (make-sequential-music (list pset music))
734 (make-sequential-music
735 (list pset (loop (cdr actions)))))))
738 (set! ac:currentTempo ac:lastTempo)
740 (let ((pset (ac:tempoChange ac:currentTempo)))
741 (if (null? (cdr actions))
742 (make-sequential-music (list pset music))
743 (make-sequential-music
744 (list pset (loop (cdr actions)))))))
750 ; A pralltriller symbol can either mean an inverted mordent
751 ; or a half-shake -- a short, two twiddle trill.
752 ; We implement as a half-shake.
754 ((origlength (ly:music-length music))
755 (gracedur (ly:make-duration 5 0 1/1))
756 (gracenote (ac:note-copy music))
757 (abovenote (ac:note-copy music))
758 (abovenoteTwo (ac:note-copy music))
759 (mainnote (ly:music-deep-copy music)))
761 (map (lambda (y) (ac:setduration y gracedur))
762 (ly:music-property gracenote 'elements))
763 (map (lambda (y) (ac:setduration y gracedur))
764 (ly:music-property abovenote 'elements))
765 (map (lambda (y) (ac:setduration y gracedur))
766 (ly:music-property abovenoteTwo 'elements))
767 (map (lambda (y) (ac:up y))
769 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
770 (ly:music-property abovenote 'elements)))
771 (map (lambda (y) (ac:up y))
773 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
774 (ly:music-property abovenoteTwo 'elements)))
775 (let* ((prallMusic (make-sequential-music
776 (list abovenote gracenote abovenoteTwo mainnote)))
777 (newlen (ly:music-length prallMusic))
778 (factor (ly:moment-div origlength newlen)))
779 (ly:music-compress prallMusic factor))))
783 ((origlength (ly:music-length music))
784 (gracedur (ly:make-duration 5 0 1/1))
785 (gracenote (ac:note-copy music))
786 (belownote (ac:note-copy music)))
787 (map (lambda (y) (ac:setduration y gracedur))
788 (ly:music-property gracenote 'elements))
789 (map (lambda (y) (ac:setduration y gracedur))
790 (ly:music-property belownote 'elements))
791 (map (lambda (y) (ac:down y))
793 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
794 (ly:music-property belownote 'elements)))
796 (let* ((mordentMusic (make-sequential-music (list gracenote belownote music)))
797 (newlen (ly:music-length mordentMusic))
798 (factor (ly:moment-div origlength newlen)))
799 (ly:music-compress mordentMusic factor))))
803 ((dur (ly:music-property
804 (car (ly:music-property music 'elements)) 'duration))
805 (factor (ly:duration-factor dur))
806 (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
807 (ly:duration-dot-count dur) (car factor)(cdr factor))))
809 (map (lambda (y) (ac:setduration y newdur))
810 (ly:music-property music 'elements))
811 (let* ((above (ly:music-deep-copy music))
812 (below (ly:music-deep-copy music))
813 (newmusic (make-sequential-music (list above music below music))))
815 (map (lambda (y) (ac:down y))
817 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
818 (ly:music-property below 'elements)))
819 (map (lambda (y) (ac:up y))
821 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
822 (ly:music-property above 'elements)))
826 ((totallen (ly:moment-main (ly:music-length music)))
827 (steallen (cadr actions)))
828 (if (>= steallen totallen)
830 (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
831 (ly:music-property music 'elements))
832 (ly:warning (_ "stealing the entirety of a note's time")))
833 (set! ac:stealForward (- steallen totallen))
834 (make-sequential-music '()))
836 (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
837 (loop (cddr actions))))))
840 ((eq? 'GraceMusic (ly:music-property music 'name))
843 (call-with-current-continuation
847 (if (eq? 'EventChord (ly:music-property m 'name))
853 (let ((fev-pos (find-tail (lambda (m) (eq? m first-ev)) ac:eventsBackward)))
855 (set! ac:eventsBackward (cdr fev-pos))
856 (ly:warning (_ "articulation of grace notes has gone awry"))))))
858 ((gmus (ly:music-compress (ly:music-property music 'element)
859 (ly:make-moment ac:defaultGraceFactor)))
860 (glen (ly:moment-main (ly:music-length gmus))))
861 (ac:stealTimeBackward (* glen ac:defaultGraceBackwardness))
862 (set! ac:stealForward (+ ac:stealForward (* glen (- 1 ac:defaultGraceBackwardness))))
865 ((memq (ly:music-property music 'name) '(BarCheck SkipMusic))
866 (let ((totallen (ly:moment-main (ly:music-length music)))
867 (steallen ac:stealForward))
870 (ac:logEventsBackward music))
871 ((< steallen totallen)
872 (set! ac:stealForward 0)
873 (ac:logEventsBackward
874 (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))))
876 (set! ac:stealForward (- steallen totallen))
877 (make-sequential-music '())))))
879 ((eq? 'KeyChangeEvent (ly:music-property music 'name))
880 (set! ac:current-key music)
883 ((eq? 'PropertySet (ly:music-property music 'name))
884 (ac:adjust-props (ly:music-property music 'symbol) music)
891 % At last ... here's the music function that applies all the above to a
893 articulate = #(define-music-function (music)
895 "Adjust times of note to add tenuto, staccato and
896 normal articulations.
900 (set! ac:stealForward 0)
901 (set! ac:eventsBackward '()))
905 (ac:startup-replacements music)))
907 (or (= ac:stealForward 0)
909 (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
910 (set! ac:stealForward 0)))
911 (set! ac:eventsBackward '()))))
913 #(define (ac:startup-replacements music)
914 (fold (lambda (f m) (f m))
918 ac:replace-aftergrace
919 ac:replace-appoggiatura
922 #(define (ac:replace-aftergrace music)
926 (expr (music 'SimultaneousMusic
927 elements (?before-grace
928 (music 'SequentialMusic
929 elements ((music 'SkipMusic)
932 (ac:aftergrace ?before-grace ?grace)))
935 #(define (ac:replace-appoggiatura music)
936 ;; appoggiature are ugly to deal with since they require a main
937 ;; note following them. We only try dealing with this followership
938 ;; in sequential music
941 (if (eq? 'SequentialMusic (ly:music-property m 'name))
944 (let ((expr (car elts))
945 (main (and (pair? (cdr elts)) (cadr elts))))
947 ;;stolen from define-music-display-methods
956 ;; we check whether ?start and ?stop look like
957 ;; startAppoggiaturaMusic stopAppoggiaturaMusic
958 (and (with-music-match (?start (music
965 span-direction START))))))
967 (with-music-match (?stop (music
974 span-direction STOP))))))
976 (let* ((app (ac:appoggiatura ?music main))
977 (apps (ly:music-property app 'elements)))
978 (set-car! elts (car apps))
979 (set-car! (cdr elts) (cadr apps))
981 (ly:music-property m 'elements)))
985 % Override \afterGrace to be in terms of audio, not spacing.
986 % Special handling for a gruppetto after a trill.
987 #(define (ac:aftergrace main grace)
989 ((main-length (ly:music-length main))
990 (grace-orig-length (ly:music-length grace))
991 (gracelen (ac:twiddletime main))
992 (grace-factor (ly:moment-div gracelen grace-orig-length))
993 (new-main-length (ly:moment-sub main-length gracelen))
994 (factor (ly:moment-div new-main-length main-length))
996 (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
999 (eq? 'ArticulationEvent (ly:music-property z 'name))
1000 (string= "trill" (ly:music-property z 'articulation-type))))
1001 (ly:music-property main 'elements)))
1002 (ac:add-articulation "tenuto" grace)
1003 (make-sequential-music (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
1005 % An appoggiatura takes half the duration of the main note,
1006 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
1007 % Somewhere around the end of the 19th, start of 20th century the rules
1008 % changed, but my main interest is early music.
1009 #(define (ac:appoggiatura grace main)
1010 (let* ((maindur (ly:music-length main))
1011 (grace-orig-len (ly:music-length grace))
1012 (main-orig-len (ly:music-length main))
1013 (numerator (ly:moment-main-numerator maindur))
1014 (factor (if (eq? (remainder numerator 3) 0)
1015 (ly:make-moment 1/3) (ly:make-moment 1/2))))
1016 (ly:music-compress grace
1017 (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
1018 (ly:music-compress main (ly:moment-sub (ly:make-moment 1/1) factor))
1020 (set! (ly:music-property grace 'elements)
1021 (append (ly:music-property grace 'elements)
1022 (list (make-music 'SlurEvent 'span-direction -1))))
1023 (set! (ly:music-property main 'elements)
1024 (append (ly:music-property main 'elements)
1025 (list (make-music 'SlurEvent 'span-direction 1))))
1026 (make-sequential-music (list grace main))))