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:
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 (srfi srfi-1))
95 #(use-modules (srfi srfi-11))
96 #(use-modules (ice-9 debug))
97 #(use-modules (scm display-lily))
100 % How much to compress notes marked Staccato. CPE Bach says `as short as
101 % may conveniently be played, as if the keys were too hot to touch'.
102 % Most modern sources say 1/2 the notated length of a note.
103 #(define ac:staccatoFactor '(1 . 2))
105 % How much to compress notes marked staccatissimo.
106 #(define ac:staccatissimoFactor '(1 . 4))
108 % And tenuto (if we ever implement time stealing, this should be >1.0)
109 #(define ac:tenutoFactor '(1 . 1))
111 % How much to articulate normal notes. CPE Bach says 1/2 (and
112 % staccato should be `as short as may conveniently be played') but this
113 % sounds too short for modern music. 7/8 sounds about right.
114 #(define ac:normalFactor '(7 . 8))
116 % How much to slow down for a rall. or a poco rall.
117 % (or speed up for accel or poco accel)
118 #(define ac:rallFactor (ly:make-moment 60/100)) % 40% slowdown
119 #(define ac:pocoRallFactor (ly:make-moment 90/100)) % 10% slowdown
121 % The absolute time for a twiddle in a trill, in minutes.
122 % Start with 1/4 seconds == 1/240 minutes
123 #(define ac:maxTwiddleTime (ly:make-moment 1/240))
125 % How long ordinary grace notes should be relative to their notated
126 % duration. 9/40 is LilyPond's built-in behaviour for MIDI output
127 % (though the notation reference says 1/4).
128 #(define ac:defaultGraceFactor 9/40)
130 % What proportion of an ordinary grace note's time should be stolen
131 % from preceding notes (as opposed to stealing from the principal note).
132 % Composers' intentions for this vary. Taking all from the preceding
133 % notes is LilyPond's built-in behaviour for MIDI output.
134 #(define ac:defaultGraceBackwardness 1)
137 % Internal variables, don't touch.
138 % (should probably be part of a context somehow)
140 % Whether to slur, or not
141 #(define ac:inSlur #f)
142 #(define ac:inPhrasingSlur #f)
144 % Whether the current noteevent is in a trill spanner
145 #(define ac:inTrill #f)
147 % assume start in C major. Key change events override this.
148 % Could get from context, but don't know how.
149 #(define ac:current-key (make-music
152 (ly:make-pitch -1 0 0)
163 #(define ac:currentTempo (ly:make-moment 15/1)) % 4 = 60, measured wholes per minute
164 #(define ac:lastTempo ac:currentTempo) % for 'a tempo' or 'tempo I'
166 % The duration of the current note. Start at a crotchet
167 % for no good reason.
168 #(define ac:currentDuration (ly:make-duration 2 0 1/1))
170 % Amount of musical time (in whole notes) that we need to steal from the
172 #(define ac:stealForward 0)
174 % List of events in the output so far, in reverse order, from which we can
176 #(define ac:eventsBackward '())
178 % Log events for the backward chain.
179 #(define (ac:logEventsBackward music)
182 (case (ly:music-property m 'name)
184 (set! ac:eventsBackward (cons m ac:eventsBackward))
186 ((BarCheck SkipMusic)
187 (let ((wm (make-sequential-music (list m))))
188 (set! ac:eventsBackward (cons wm ac:eventsBackward))
194 % Steal time from the backward chain. Adds to ac:stealForward (with a
195 % warning) if it couldn't backward-steal all that was desired.
196 #(define (ac:stealTimeBackward tosteal)
199 (if (null? ac:eventsBackward)
201 (ly:warning (_ "articulation failed to steal ~a note backward at beginning of music; stealing forward instead") tosteal)
202 (set! ac:stealForward (+ ac:stealForward tosteal)))
204 ((lastev (car ac:eventsBackward))
205 (levlen (ly:moment-main (ly:music-length lastev))))
206 (if (< tosteal levlen)
208 (ly:music-compress lastev (ly:make-moment (/ (- levlen tosteal) levlen)))
211 (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
212 (ly:music-property lastev 'elements))
213 (ly:warning (_ "stealing the entirety of a note's time")))
214 (set! (ly:music-property lastev 'elements) '())
215 (set! ac:eventsBackward (cdr ac:eventsBackward))
216 (ac:stealTimeBackward (- tosteal levlen))))))))
218 % Debugging: display a moment plus some text.
219 % Returns its moment argument so can be used in-line.
220 #(define (display-moment text m)
222 (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
226 % Track tempo (and maybe later, other context properties)
227 % as they change. Needs to better cope with saving only Tempo I,
228 % otherwise "a tempo" goes back to the tempo before the last change.
229 #(define (ac:adjust-props sym music)
231 ((tempoWholesPerMinute)
232 (set! ac:currentTempo (ly:music-property music 'value))
233 (set! ac:lastTempo ac:currentTempo)
236 % Raise note one step in the current diatonic scale.
237 #(define (ac:up note)
238 (let* ((pitch (ly:music-property note 'pitch))
239 (notename (ly:pitch-notename pitch))
240 (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
241 (alterations (ly:music-property ac:current-key 'pitch-alist))
242 (new-alteration (cdr (assq new-notename alterations)))
243 (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
244 (ly:pitch-octave pitch)))
246 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
249 % Lower note one step in the current diatonic scale.
250 #(define (ac:down note)
251 (begin (let* ((pitch (ly:music-property note 'pitch))
252 (notename (ly:pitch-notename pitch))
253 (new-notename (if (eq? notename 0) 6 (- notename 1)))
254 (alterations (ly:music-property ac:current-key 'pitch-alist))
255 (new-alteration (cdr (assq new-notename alterations)))
256 (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
257 (ly:pitch-octave pitch)))
259 (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
262 % Shorten a note, and save the note's original duration in ac:currentDuration
263 #(define (ac:articulate-one-note m fraction)
264 "Replace m with m*fraction"
265 (if (eq? 'NoteEvent (ly:music-property m 'name))
267 ((dur (ly:music-property m 'duration))
268 (l (ly:duration-log dur))
269 (d (ly:duration-dot-count dur))
270 (factor (ly:duration-factor dur))
272 (denom (cdr fraction)))
274 (set! ac:currentDuration dur)
275 (set! (ly:music-property m 'duration)
276 (ly:make-duration l d
278 (* denom (cdr factor))))))
281 % helper routine to set duration.
282 #(define (ac:setduration music duration)
283 "Set a note's duration."
284 (let ((eventtype (ly:music-property music 'name)))
287 (eq? eventtype 'NoteEvent)
288 (eq? eventtype 'RestEvent)
289 (eq? eventtype 'SkipEvent))
290 (set! (ly:music-property music 'duration) duration))))
292 % Add an articulation event to a note.
293 % Used in afterGrace to mark all notes as tenuto, so they're not shortened
294 #(define (ac:add-articulation type music)
295 (music-map (lambda (m)
296 (if (eq? 'EventChord (ly:music-property m 'name))
297 (set! (ly:music-property m 'elements)
298 (append (ly:music-property m 'elements)
299 (list (make-music 'ArticulationEvent 'articulation-type type)))))
303 % Convert a long note to an equivalent set of short notes, tied together.
304 % This is needed to get smooth dynamics changes.
305 % Need to deal properly with stuff other than the notes (dynamics, markup etc)
306 % Still experimental, so disabled for now.
307 #(define (ac:to128 music) music)
309 #(define (ac:to128_disabled music)
310 (if (or (eq? 'SkipEvent (ly:music-property music 'name))
311 (eq? 'NoteEvent (ly:music-property music 'name)))
312 (let* ((dur (ly:music-property music 'duration))
313 (log2 (ly:duration-log dur))
314 (shiftcount (- 6 log2))
315 (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
316 (set! (ly:music-property music 'elements)
317 (cons (make-music 'TieEvent) (ly:music-property music 'elements)))
318 (make-sequential-music (list
319 (make-repeat "unfold" (1- (expt 2 shiftcount))
320 (make-sequential-music (list music)) '())
325 % absolute time in minutes of a length of music, as a rational number (moment)
326 #(define (ac:abstime music)
327 (ly:moment-div (ly:music-length music) ac:currentTempo))
329 % convert absolute time (in minutes) to a moment in the current tempo
330 #(define (ac:abs->mom m)
331 (ly:moment-mul m ac:currentTempo))
334 % a moment that is ac:maxTwiddletime seconds at the current tempo.
335 #(define (ac:targetTwiddleTime)
336 (ac:abs->mom ac:maxTwiddleTime))
339 % Nearest twiddletime (in minutes) achievable with power-of-2 divisions of
340 % the original music. (twiddletime is the time for one pair of notes
342 % If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
343 #(define (ac:twiddletime music)
344 (let* ((tr (filter (lambda (x)
345 (and (eq? 'ArticulationEvent (ly:music-property x 'name))
346 (string= "trill" (ly:music-property x 'articulation-type))))
347 (ly:music-property music 'elements)))
348 (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
350 (t (ac:targetTwiddleTime)))
351 (if (ly:moment? pre-t)
353 (let loop ((len (ly:music-length music)))
354 (if (ly:moment<? t len)
355 (loop (ly:moment-mul len (ly:make-moment 1/2)))
360 % Note: I'm assuming early music practice of starting on the auxiliary note.
361 % Needs to add gruppetto if it's a long trill (TODO)
362 #(define (ac:trill music)
363 " Replace music with time-compressed repeats of the music,
364 maybe accelerating if the length is longer than a crotchet "
365 (let* ((hemisemidur (ly:make-duration 5 0 1/1))
366 (orig-len (ly:music-length music))
367 (t (ac:twiddletime music))
369 (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
370 (c1 (ly:moment-div orig-len note_moment))
372 (round (/ (ly:moment-main-numerator c1)
373 (* 2 (ly:moment-main-denominator c1))))))
374 (count (if (< c2 2) 2 c2)))
376 (set! (ly:music-property music 'elements)
377 (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
378 (ly:music-property music 'elements)))
379 (map (lambda (y) (ac:setduration y hemisemidur))
380 (ly:music-property music 'elements))
381 (set! uppernote (ly:music-deep-copy music))
382 (map (lambda (y) (ac:up y))
384 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
385 (ly:music-property uppernote 'elements)))
387 (let* ((trillMusicElements
388 (let loop ((so_far (list uppernote music))
391 (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
393 (trillMusic (make-sequential-music trillMusicElements))
394 (newlen (ly:music-length trillMusic))
395 (factor (ly:moment-div orig-len newlen)))
396 (ly:music-compress trillMusic factor)
397 ; accelerating the music seems to put lily into an infinite loop in
398 ; its layout and midi engines.
399 ; (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
400 ; (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
402 ; (ac:accel trillMusic factor))
406 % Generate a tempoChangeEvent and its associated property setting.
408 #(define (ac:tempoChange tempo)
409 (make-sequential-music
410 (list (make-music 'TempoChangeEvent
414 (ly:make-duration 0 0 1/1))
416 (make-property-set 'tempoWholesPerMinute tempo) 'Score))))
419 % Totally unfold repeats, so that the non-obvious sequencing doesn't
420 % confuse us. This is necessary for time stealing to work, because
421 % that relies on the sequence in which we see events matching their
422 % audible sequence. Also unfold multi-measure rests to equivalent
423 % skips, with preceding and following bar checks, so that time stealing
424 % can change the length of the pause without falling foul of the
425 % implicit bar checks.
427 #(define (ac:unfoldMusic music)
430 (case (ly:music-property m 'name)
431 ((UnfoldedRepeatedMusic)
433 ((body (ly:music-property m 'element))
434 (altl (ly:music-property m 'elements))
435 (rc (ly:music-property m 'repeat-count)))
437 (make-sequential-music
438 (list-tabulate rc (lambda (i) (ly:music-deep-copy body))))
439 (let ((ealtl (if (> (length altl) rc) (take altl rc) altl)))
440 (make-sequential-music
444 (- rc (length ealtl))
445 (lambda (i) (list (ly:music-deep-copy body) (ly:music-deep-copy (car ealtl)))))
446 (map (lambda (alt) (list (ly:music-deep-copy body) alt)) ealtl))))))))
450 (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
451 (ly:music-property m 'elements))))
455 ((tremtype (ly:music-property (car trem) 'tremolo-type))
456 (tremtype-log (1- (integer-length tremtype)))
457 (durev (find (lambda (v) (not (null? (ly:music-property v 'duration)))) evl))
458 (totaldur (if durev (ly:music-property durev 'duration) (ly:make-duration tremtype-log 0 1)))
459 (tgt-nrep (/ (duration-visual-length totaldur) (duration-log-factor tremtype-log)))
460 (eff-nrep (max (truncate tgt-nrep) 1))
461 (tremdur (ly:make-duration tremtype-log 0
462 (* (/ tgt-nrep eff-nrep) (ly:duration-scale totaldur)))))
463 (or (and (= eff-nrep tgt-nrep) (= (ash 1 tremtype-log) tremtype))
464 (ly:warning (_ "non-integer tremolo ~a:~a")
465 (duration->lily-string (duration-visual totaldur) #:force-duration #t #:time-scale 1)
469 (or (null? (ly:music-property v 'duration))
470 (set! (ly:music-property v 'duration) tremdur)))
472 (set! (ly:music-property m 'elements) evl)
473 (make-sequential-music
474 (list-tabulate eff-nrep (lambda (i) (ly:music-deep-copy m))))))))
475 ((MultiMeasureRestMusic)
476 (make-sequential-music
478 (make-music 'BarCheck)
479 (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
480 (make-music 'BarCheck))))
483 (unfold-repeats music)))
485 % If there's an articulation, use it.
486 % If in a slur, use (1 . 1) instead.
487 % Treat phrasing slurs as slurs, but allow explicit articulation.
488 % (Maybe should treat staccato under a phrasing slur as mezzo-staccato?)
490 % Expect an EventChord.
492 % trills, turns, ornaments etc. are also treated as Articulations.
493 % Split into two functions:
494 % ac:getactions traverses the elements in the EventChord
495 % and calculates the parameters.
496 % ac:articulate-chord applies the actions to each NoteEvent in
498 #(define (ac:getactions music)
499 (let loop ((factor ac:normalFactor)
501 (es (ly:music-property music 'elements))
505 (set! (ly:music-property music 'elements) (reverse newelements))
507 (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
511 (let ((st ac:stealForward))
515 (set! ac:stealForward 0)
519 (ac:inTrill '(trill))
520 ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
521 (list 'articulation '(1 . 1)))
522 (else (list 'articulation factor))))))
526 (case (ly:music-property e 'name)
528 ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
529 (loop factor newelements tail actions))
531 ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
532 (loop (cons 1 1) (cons e newelements) tail actions))
535 (let ((articname (ly:music-property e 'articulation-type)))
536 ; TODO: add more here
538 ((string= articname "staccato")
539 (loop ac:staccatoFactor newelements tail actions))
540 ((string= articname "staccatissimo")
541 (loop ac:staccatissimoFactor newelements tail actions))
542 ((string= articname "tenuto")
543 (loop ac:tenutoFactor newelements tail actions))
544 ((string= articname "mordent")
545 (loop (cons 1 1) newelements tail (cons 'mordent actions)))
546 ((string= articname "prall")
547 (loop (cons 1 1) newelements tail (cons 'prall actions)))
548 ((string= articname "trill")
549 (loop (cons 1 1) newelements tail (cons 'trill actions)))
550 ((string= articname "turn")
551 (loop (cons 1 1) newelements tail (cons 'turn actions)))
552 (else (loop factor (cons e newelements) tail actions)))))
555 (let ((t (ly:music-property e 'text)))
556 (if (not (string? t))
557 (loop factor (cons e newelements) tail actions)
565 (loop factor (cons e newelements) tail (cons 'rall actions)))
567 (string= t "accelerando")
569 (string= t "accel."))
570 (loop factor (cons e newelements) tail (cons 'accel actions)))
572 (string= t "poco accel."))
573 (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
575 (string= t "poco rall.")
576 (string= t "poco rit."))
577 (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
578 ((or (string= t "a tempo")
579 (string= t "tempo I"))
580 (loop factor (cons e newelements) tail (cons 'aTempo actions)))
581 (else (loop factor (cons e newelements) tail actions)))))))
584 (let ((direction (ly:music-property e 'span-direction)))
585 (set! ac:inSlur (eq? direction -1))
586 (loop factor newelements tail actions)))
589 (let ((direction (ly:music-property e 'span-direction)))
590 (set! ac:inTrill (eq? direction -1))
592 (loop factor newelements tail (cons 'trill actions))
593 (loop factor (cons e newelements) tail actions))))
596 (let ((direction (ly:music-property e 'span-direction)))
597 (set! ac:inPhrasingSlur (eq? direction -1))
598 (loop factor newelements tail actions)))
600 (else (loop factor (cons e newelements) tail actions)))))))
604 #(define (ac:articulate-chord music)
606 ((eq? 'EventChord (ly:music-property music 'name))
607 (ac:logEventsBackward
608 (let loop ((actions (ac:getactions music)))
610 (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
618 (lambda (x) (ac:articulate-one-note x (cadr actions)))
619 (ly:music-property music 'elements))
621 ((num (caadr actions))
622 (denom (cdadr actions))
623 (mult (ly:duration-factor ac:currentDuration))
624 (newnum (* (- denom num) (car mult)))
625 (newdenom (* (cdr mult) denom))
626 (len (ly:duration-log ac:currentDuration))
627 (dots (ly:duration-dot-count ac:currentDuration)))
629 (if (not (eq? num denom))
630 (make-sequential-music
631 (list (ac:to128 music)
632 (make-music 'EventChord 'elements
634 (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
638 (set! ac:lastTempo ac:currentTempo)
639 (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
640 (let ((pset (ac:tempoChange ac:currentTempo)))
641 (if (null? (cdr actions))
642 (make-sequential-music (list pset music))
643 (make-sequential-music
644 (list pset (loop (cdr actions)))))))
647 (set! ac:lastTempo ac:currentTempo)
648 (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
649 (let ((pset (ac:tempoChange ac:currentTempo)))
650 (if (null? (cdr actions))
651 (make-sequential-music (list pset music))
652 (make-sequential-music
653 (list pset (loop (cdr actions)))))))
656 (set! ac:lastTempo ac:currentTempo)
657 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
658 (let ((pset (ac:tempoChange ac:currentTempo)))
659 (if (null? (cdr actions))
660 (make-sequential-music (list pset music))
661 (make-sequential-music
662 (list pset (loop (cdr actions)))))))
665 (set! ac:lastTempo ac:currentTempo)
666 (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
667 (let ((pset (ac:tempoChange ac:currentTempo)))
668 (if (null? (cdr actions))
669 (make-sequential-music (list pset music))
670 (make-sequential-music
671 (list pset (loop (cdr actions)))))))
674 (set! ac:currentTempo ac:lastTempo)
676 (let ((pset (ac:tempoChange ac:currentTempo)))
677 (if (null? (cdr actions))
678 (make-sequential-music (list pset music))
679 (make-sequential-music
680 (list pset (loop (cdr actions)))))))
686 ; A pralltriller symbol can either mean an inverted mordent
687 ; or a half-shake -- a short, two twiddle trill.
688 ; We implement as a half-shake.
690 ((totallength (ly:music-length music))
691 (newlen (ly:moment-sub totallength (ly:make-moment 3/32)))
692 (newdur (ly:make-duration
694 (ly:moment-main-numerator newlen)
695 (ly:moment-main-denominator newlen)))
696 (gracedur (ly:make-duration 5 0 1/1))
697 (gracenote (ly:music-deep-copy music))
698 (abovenote (ly:music-deep-copy music))
699 (mainnote (ly:music-deep-copy music))
700 (prall (make-sequential-music (list gracenote abovenote)))
702 (music-map (lambda (n)
703 (if (eq? 'NoteEvent (ly:music-property n 'name))
704 (set! (ly:music-property n 'duration) gracedur))
707 (music-map (lambda (n)
708 (if (eq? 'NoteEvent (ly:music-property n 'name))
709 (set! (ly:music-property n 'duration) gracedur))
712 (music-map (lambda (n)
713 (if (eq? 'NoteEvent (ly:music-property n 'name))
714 (set! (ly:music-property n 'duration) newdur))
718 (map (lambda (y) (ac:up y))
720 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
721 (ly:music-property abovenote 'elements)))
722 (make-sequential-music (list abovenote gracenote abovenote mainnote))))
726 ((totaldur (ly:music-property
727 (car (ly:music-property music 'elements)) 'duration))
728 (dur (ly:duration-length totaldur))
729 (newlen (ly:moment-sub dur (ly:make-moment 2/32)))
730 (newdur (ly:make-duration
732 (ly:moment-main-numerator newlen)
733 (ly:moment-main-denominator newlen)))
734 (gracenote (ly:music-deep-copy music))
735 (belownote (ly:music-deep-copy music))
736 (mainnote (ly:music-deep-copy music))
737 (mordent (make-sequential-music (list gracenote belownote)))
740 (music-map (lambda (n)
741 (if (eq? 'NoteEvent (ly:music-property n 'name))
742 (set! (ly:music-property n 'duration)
743 (ly:make-duration 5 0 1/1)))
746 (music-map (lambda (n)
747 (if (eq? 'NoteEvent (ly:music-property n 'name))
748 (set! (ly:music-property n 'duration) newdur))
751 (map (lambda (y) (ac:down y))
753 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
754 (ly:music-property belownote 'elements)))
755 (make-sequential-music (list mordent mainnote)))))
758 ((dur (ly:music-property
759 (car (ly:music-property music 'elements)) 'duration))
760 (factor (ly:duration-factor dur))
761 (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
762 (ly:duration-dot-count dur) (car factor)(cdr factor))))
764 (map (lambda (y) (ac:setduration y newdur))
765 (ly:music-property music 'elements))
766 (let* ((above (ly:music-deep-copy music))
767 (below (ly:music-deep-copy music))
768 (newmusic (make-sequential-music (list above music below music))))
770 (map (lambda (y) (ac:down y))
772 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
773 (ly:music-property below 'elements)))
774 (map (lambda (y) (ac:up y))
776 (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
777 (ly:music-property above 'elements)))
781 ((totallen (ly:moment-main (ly:music-length music)))
782 (steallen (cadr actions)))
783 (if (>= steallen totallen)
785 (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
786 (ly:music-property music 'elements))
787 (ly:warning (_ "stealing the entirety of a note's time")))
788 (set! ac:stealForward (- steallen totallen))
789 (make-sequential-music '()))
791 (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
792 (loop (cddr actions))))))
795 ((eq? 'GraceMusic (ly:music-property music 'name))
798 (call-with-current-continuation
802 (if (eq? 'EventChord (ly:music-property m 'name))
808 (let ((fev-pos (find-tail (lambda (m) (eq? m first-ev)) ac:eventsBackward)))
810 (set! ac:eventsBackward (cdr fev-pos))
811 (ly:warning (_ "articulation of grace notes has gone awry"))))))
813 ((gmus (ly:music-compress (ly:music-property music 'element)
814 (ly:make-moment ac:defaultGraceFactor)))
815 (glen (ly:moment-main (ly:music-length gmus))))
816 (ac:stealTimeBackward (* glen ac:defaultGraceBackwardness))
817 (set! ac:stealForward (+ ac:stealForward (* glen (- 1 ac:defaultGraceBackwardness))))
820 ((memq (ly:music-property music 'name) '(BarCheck SkipMusic))
821 (let ((totallen (ly:moment-main (ly:music-length music)))
822 (steallen ac:stealForward))
825 (ac:logEventsBackward music))
826 ((< steallen totallen)
827 (set! ac:stealForward 0)
828 (ac:logEventsBackward
829 (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))))
831 (set! ac:stealForward (- steallen totallen))
832 (make-sequential-music '())))))
834 ((eq? 'KeyChangeEvent (ly:music-property music 'name))
835 (set! ac:current-key music)
838 ((eq? 'PropertySet (ly:music-property music 'name))
839 (ac:adjust-props (ly:music-property music 'symbol) music)
846 % At last ... here's the music function that applies all the above to a
848 articulate = #(define-music-function (parser location music)
850 "Adjust times of note to add tenuto, staccato and
851 normal articulations.
855 (set! ac:stealForward 0)
856 (set! ac:eventsBackward '()))
860 (ac:unfoldMusic (event-chord-wrap! music parser))))
862 (or (= ac:stealForward 0)
864 (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
865 (set! ac:stealForward 0)))
866 (set! ac:eventsBackward '()))))
869 % Override \afterGrace to be in terms of audio, not spacing.
870 % Special handling for a gruppetto after a trill.
872 #(define-music-function
873 (parser location main grace)
874 (ly:music? ly:music?)
876 (set! main (event-chord-wrap! main parser))
877 (set! grace (event-chord-wrap! grace parser))
879 ((main-length (ly:music-length main))
880 (grace-orig-length (ly:music-length grace))
881 (gracelen (ac:twiddletime main))
882 (grace-factor (ly:moment-div gracelen grace-orig-length))
883 (new-main-length (ly:moment-sub main-length gracelen))
884 (factor (ly:moment-div new-main-length main-length))
886 (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
889 (eq? 'ArticulationEvent (ly:music-property z 'name))
890 (string= "trill" (ly:music-property z 'articulation-type))))
891 (ly:music-property main 'elements)))
892 (ac:add-articulation "tenuto" grace)
893 (make-sequential-music (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
895 % An appoggiatura takes half the duration of the main note,
896 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
897 % Somewhere around the end of the 19th, start of 20th century the rules
898 % changed, but my main interest is early music.
900 #(define-music-function (parser location grace main)
901 (ly:music? ly:music?)
902 (set! grace (event-chord-wrap! grace parser))
903 (set! main (event-chord-wrap! main parser))
904 (let* ((maindur (ly:music-length main))
905 (grace-orig-len (ly:music-length grace))
906 (main-orig-len (ly:music-length main))
907 (numerator (ly:moment-main-numerator maindur))
908 (factor (if (eq? (remainder numerator 3) 0)
909 (ly:make-moment 1/3) (ly:make-moment 1/2))))
910 (ly:music-compress grace
911 (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
912 (ly:music-compress main (ly:moment-sub (ly:make-moment 1/1) factor))
914 (set! (ly:music-property grace 'elements)
915 (append (ly:music-property grace 'elements)
916 (list (make-music 'SlurEvent 'span-direction -1))))
917 (set! (ly:music-property main 'elements)
918 (append (ly:music-property main 'elements)
919 (list (make-music 'SlurEvent 'span-direction 1))))
920 (make-sequential-music (list grace main))))