]> git.donarmstrong.com Git - lilypond.git/blob - ly/articulate.ly
Eliminate faulty barcheck warning in articulate.
[lilypond.git] / ly / articulate.ly
1 %
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 $
5 %
6 %
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.
10 %
11 %  WARNING: this file under GPLv3 only, not GPLv3+
12 %
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
19 %
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
23 % skip.
24 %
25 % It also tries to unfold trills turns etc., and take rallentendo
26 % and accelerando into account.
27 %
28 % As my scheme knowledge is poor (I was teaching myself as I went), there
29 % is much scope for improvement.
30
31 %
32 %%%USAGE
33 % In the \score section do:
34 %  \unfoldRepeats \articulate <<
35 %       all the rest of the score
36 % >>
37 % or use the lilywrap script.
38 %
39 % TO DO (prioritised, the ones that'll make the most difference first)
40 %
41 % * Dynamics.
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).
45 %
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.
49 %
50 % * add accel (to match rall), and molto rall. I've never seen
51 %   molto accel but some composer somewhere has probably used it.
52 %
53 % * Fermata, and Fermata Lunga
54 % * Add more synonyms for accel and rall: rit ritard stringendo
55 %
56 % * Phrasing.
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
60 %     the general case
61 %
62 % * Trill algorithm needs work.
63 %
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
79
80 % CHANGELOG
81 %  * From Iain Nicol: appoggiatura timings were out; add staccatissimo; fix
82 %    trillSpanner endpoints.
83 %  * Also handle Breathing events (by throwing them away).  This isn't ideal;
84 %    one should really shorten the note before a little.  But I don't know
85 %    how to do lookahead in scheme.
86 %  * Also ignore explicit line breaks.
87 %  * Add Mordents (reported by Patrick Karl)
88 %
89
90 \version "2.13.58"
91
92 #(use-modules (ice-9 debug))
93 #(use-modules (scm display-lily))
94
95 % PARAMETERS
96 % How much to compress notes marked Staccato.  CPE Bach says `as short as
97 % may conveniently be played, as if the keys were too hot to touch'.
98 % Most modern sources say 1/2 the notated length of a note.
99 #(define ac:staccatoFactor '(1 . 2))
100
101 % How much to compress notes marked staccatissimo.
102 #(define ac:staccatissimoFactor '(1 . 4))
103
104 % And tenuto (if we ever implement time stealing, this should be >1.0)
105 #(define ac:tenutoFactor '(1 . 1))
106
107 % How much to articulate normal notes.  CPE Bach says 1/2 (and
108 % staccato should be `as short as may conveniently be played') but this
109 % sounds too short for modern music.  7/8 sounds about right.
110 #(define ac:normalFactor '(7 . 8))
111
112 % How much to slow down for a rall. or a poco rall.
113 % (or speed up for accel or poco accel)
114 #(define ac:rallFactor (ly:make-moment 60 100)) % 40% slowdown
115 #(define ac:pocoRallFactor (ly:make-moment 90 100)) % 10% slowdown
116
117 % The absolute time for a twiddle in a trill, in minutes.
118 % Start with 1/4 seconds == 1/240 minutes
119 #(define ac:maxTwiddleTime (ly:make-moment 1 240))
120
121
122 % Internal variables, don't touch.
123 % (should probably be part of a context somehow)
124
125 % Whether to slur, or not
126 #(define ac:inSlur #f)
127 #(define ac:inPhrasingSlur #f)
128
129 % Whether the current noteevent is in a trill spanner
130 #(define ac:inTrill #f)
131
132 % assume start in C major.  Key change events override this.
133 % Could get from context, but don't know how.
134 #(define ac:current-key (make-music
135           'KeyChangeEvent
136           'tonic
137           (ly:make-pitch -1 0 0)
138           'pitch-alist
139           (list (cons 0 0)
140                 (cons 1 0)
141                 (cons 2 0)
142                 (cons 3 0)
143                 (cons 4 0)
144                 (cons 5 0)
145                 (cons 6 0))))
146
147
148 #(define ac:currentTempo (ly:make-moment 15 1)) % 4 = 60, measured wholes per minute
149 #(define ac:lastTempo ac:currentTempo) % for 'a tempo' or 'tempo I'
150
151 % The duration of the current note.  Start at a crotchet
152 % for no good reason.
153 #(define ac:currentDuration (ly:make-duration 2 0 1 1))
154
155 % Debugging: display a moment plus some text.
156 % Returns its moment argument so can be used in-line.
157 #(define (display-moment  text m)
158   (display text)
159   (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
160   m
161 )
162
163 % Track tempo (and maybe later, other context properties)
164 % as they change.  Needs to better cope with saving only Tempo I,
165 % otherwise "a tempo" goes back to the tempo before the last change.
166 #(define (ac:adjust-props sym music)
167   (case sym
168    ((tempoWholesPerMinute)
169     (set! ac:currentTempo (ly:music-property music 'value))
170     (set! ac:lastTempo ac:currentTempo)
171   )))
172
173 % Raise note one step in the current diatonic scale.
174 #(define (ac:up note)
175   (let* ((pitch (ly:music-property note 'pitch))
176          (notename (ly:pitch-notename pitch))
177          (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
178          (alterations (ly:music-property ac:current-key 'pitch-alist))
179          (new-alteration (cdr (assq new-notename alterations)))
180          (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
181                       (ly:pitch-octave pitch)))
182        )
183    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
184
185
186 % Lower note one step in the current diatonic scale.
187 #(define (ac:down note)
188   (begin  (let* ((pitch (ly:music-property note 'pitch))
189          (notename (ly:pitch-notename pitch))
190          (new-notename (if (eq? notename 0) 6 (- notename 1)))
191          (alterations (ly:music-property ac:current-key 'pitch-alist))
192          (new-alteration (cdr (assq new-notename alterations)))
193          (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
194                       (ly:pitch-octave pitch)))
195        )
196    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
197 )
198
199 % Shorten a note, and save the note's original duration in ac:currentDuration
200 #(define (ac:articulate-one-note m fraction)
201   "Replace m with m*fraction"
202   (if  (eq? 'NoteEvent (ly:music-property m 'name))
203    (let*
204     ((dur (ly:music-property m 'duration))
205      (l (ly:duration-log dur))
206      (d (ly:duration-dot-count dur))
207      (factor (ly:duration-factor dur))
208      (num (car fraction))
209      (denom (cdr fraction)))
210     (begin
211      (set! ac:currentDuration dur)
212      (set! (ly:music-property m 'duration)
213       (ly:make-duration l d
214        (* num (car factor))
215        (* denom (cdr factor))))))
216    m))
217
218 % helper routine to set duration.
219 #(define (ac:setduration music duration)
220   "Set a note's duration."
221   (let ((eventtype (ly:music-property music 'name)))
222    (if
223     (or
224      (eq? eventtype 'NoteEvent)
225      (eq? eventtype 'RestEvent)
226      (eq? eventtype 'SkipEvent))
227     (set! (ly:music-property music 'duration) duration))))
228
229 % Add an articulation event to a note.
230 % Used in afterGrace to mark all notes as tenuto, so they're not shortened
231 #(define (ac:add-articulation type music)
232     (music-map (lambda (m)
233                 (if (eq? 'EventChord (ly:music-property m 'name))
234                  (set! (ly:music-property m 'elements)
235                   (append (ly:music-property m 'elements)
236                    (list (make-music 'ArticulationEvent 'articulation-type type)))))
237                 m)
238      music))
239
240 % Convert a long note to an equivalent set of short notes, tied together.
241 % This is needed to get smooth dynamics changes.
242 % Need to deal properly with stuff other than the notes (dynamics, markup etc)
243 % Still experimental, so disabled for now.
244 #(define (ac:to128 music) music)
245
246 #(define (ac:to128_disabled music)
247   (if (or (eq? 'SkipEvent (ly:music-property music 'name))
248         (eq? 'NoteEvent (ly:music-property music 'name)))
249    (let* ((dur (ly:music-property music 'duration))
250           (log2 (ly:duration-log dur))
251          (shiftcount (- 6 log2))
252          (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
253    (set! (ly:music-property music 'elements)
254     (cons (make-music 'TieEvent) (ly:music-property music 'elements)))
255    (make-sequential-music (list
256                            (make-repeat "unfold" (1- (expt 2 shiftcount))
257                             (make-sequential-music (list music)) '())
258                            lastm)))
259  music))
260
261
262 % absolute time in minutes of a length of music, as a rational number (moment)
263 #(define (ac:abstime music)
264   (ly:moment-div (ly:music-length music) ac:currentTempo))
265
266 % convert absolute time (in minutes) to a moment in the current tempo
267 #(define (ac:abs->mom m)
268   (ly:moment-mul m ac:currentTempo))
269
270
271 % a moment that is ac:maxTwiddletime seconds at the current tempo.
272 #(define (ac:targetTwiddleTime)
273   (ac:abs->mom ac:maxTwiddleTime))
274
275
276 % Nearest twiddletime (in minutes) achievable with power-of-2 divisions of
277 % the original music.  (twiddletime is the time for one pair of notes
278 % in a trill)
279 % If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
280 #(define (ac:twiddletime music)
281   (let* ((tr (filter (lambda (x)
282                      (and (eq? 'ArticulationEvent (ly:music-property x 'name))
283                       (string= "trill" (ly:music-property x 'articulation-type))))
284               (ly:music-property music 'elements)))
285          (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
286                  '()))
287          (t (ac:targetTwiddleTime)))
288    (if (ly:moment? pre-t)
289     pre-t
290     (let loop ((len (ly:music-length music)))
291      (if (ly:moment<? t len)
292       (loop (ly:moment-mul len (ly:make-moment 1 2)))
293       len)))))
294
295
296
297 % Note: I'm assuming early music practice of starting on the auxiliary note.
298 % Needs to add gruppetto if it's a long trill (TODO)
299 #(define (ac:trill music)
300   " Replace music with time-compressed repeats of the music,
301     maybe accelerating if the length is longer than a crotchet "
302   (let* ((hemisemidur (ly:make-duration 5 0 1 1))
303          (orig-len  (ly:music-length music))
304          (t (ac:twiddletime music))
305          (uppernote '())
306          (note_moment (ly:moment-mul t (ly:make-moment 1 2)))
307          (c1 (ly:moment-div orig-len note_moment))
308          (c2 (inexact->exact
309               (round (/ (ly:moment-main-numerator c1)
310                       (* 2 (ly:moment-main-denominator c1))))))
311          (count (if (< c2 2) 2 c2)))
312
313    (set! (ly:music-property music 'elements)
314     (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
315      (ly:music-property music 'elements)))
316    (map (lambda (y) (ac:setduration y hemisemidur))
317     (ly:music-property music 'elements))
318    (set! uppernote (ly:music-deep-copy music))
319    (map (lambda (y) (ac:up y))
320     (filter
321      (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
322      (ly:music-property uppernote 'elements)))
323
324    (let* ((trillMusicElements
325           (let loop ((so_far (list uppernote music))
326                      (c count))
327            (if (> c 1)
328             (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
329             so_far)))
330           (trillMusic (make-sequential-music trillMusicElements))
331           (newlen (ly:music-length trillMusic))
332           (factor (ly:moment-div  orig-len newlen)))
333     (ly:music-compress trillMusic factor)
334 ; accelerating the music seems to put lily into an infinite loop in
335 ; its layout and midi engines.
336 ;    (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
337 ;          (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
338 ;                   1024)))
339 ;     (ac:accel trillMusic factor))
340  )))
341
342
343
344
345 % If there's an articulation, use it.
346 % If in a slur, use (1 . 1) instead.
347 % Treat phrasing slurs as slurs, but allow explicit articulation.
348 % (Maybe should treat staccato under a phrasing slur as mezzo-staccato?)
349 %
350 % Expect an EventChord.
351 %
352 % trills, turns, ornaments etc.  are also treated as Articulations.
353 % Split into two functions:
354 %  ac:getactions traverses the elements in the EventChord
355 %               and calculates the parameters.
356 %  ac:articulate-chord applies the actions to each NoteEvent in
357 %               the EventChord.
358 #(define (ac:getactions music)
359   (let  loop ((factor ac:normalFactor)
360               (newelements '())
361               (es (ly:music-property music 'elements))
362               (actions '()))
363    (if (null? es)
364     (begin
365      (set! (ly:music-property music 'elements) (reverse newelements))
366      (cond
367       (ac:inTrill (cons 'trill actions))
368       ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
369        (append actions (list 'articulation  '(1 . 1)) ))
370       (else (append actions (list 'articulation  factor)))))
371     ; else part
372     (let ((e (car es))
373           (tail (cdr es)))
374      (case (ly:music-property e 'name)
375
376       ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
377        (loop factor newelements tail actions))
378
379       ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
380        (loop (cons 1 1) (cons e newelements) tail actions))
381
382       ((ArticulationEvent)
383        (let ((articname (ly:music-property e 'articulation-type)))
384         ; TODO: add more here
385         (cond
386          ((string= articname "staccato")
387           (loop ac:staccatoFactor newelements tail actions))
388          ((string= articname "staccatissimo")
389           (loop ac:staccatissimoFactor newelements tail actions))
390          ((string= articname "tenuto")
391           (loop ac:tenutoFactor newelements tail actions))
392          ((string= articname "mordent")
393           (loop (cons 1 1) newelements tail (cons 'mordent actions)))
394          ((string= articname "prall")
395           (loop (cons 1 1) newelements tail (cons 'trill actions)))
396          ((string= articname "trill")
397           (loop (cons 1 1) newelements tail (cons 'trill actions)))
398          ((string= articname "turn")
399           (loop (cons 1 1) newelements tail (cons 'turn actions)))
400          (else (loop factor (cons e newelements) tail actions)))))
401
402       ((TextScriptEvent)
403        (let ((t (ly:music-property e 'text)))
404         (if (not (string? t))
405          (loop factor (cons e newelements) tail actions)
406          (begin
407           (cond
408            ((or
409              (string= t "rall")
410              (string= t "Rall")
411              (string= t "rit.")
412              (string= t "rall."))
413             (loop factor (cons e newelements) tail (cons 'rall actions)))
414            ((or
415              (string= t "poco rall.")
416              (string= t "poco rit."))
417             (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
418            ((or (string= t "a tempo")
419              (string= t "tempo I"))
420           (loop factor (cons e newelements) tail (cons 'aTempo actions)))
421            (else (loop factor (cons e newelements) tail actions)))))))
422
423       ((SlurEvent)
424        (let ((direction (ly:music-property e 'span-direction)))
425         (set! ac:inSlur (eq? direction -1))
426         (loop factor newelements tail actions)))
427
428       ((TrillSpanEvent)
429        (let ((direction (ly:music-property e 'span-direction)))
430         (set! ac:inTrill (eq? direction -1))
431         (if ac:inTrill
432          (loop factor newelements tail (cons 'trill actions))
433          (loop factor (cons e newelements) tail actions))))
434
435       ((PhrasingSlurEvent)
436        (let ((direction (ly:music-property e 'span-direction)))
437         (set! ac:inPhrasingSlur (eq? direction -1))
438         (loop factor newelements tail actions)))
439
440       (else (loop factor (cons e newelements) tail actions)))))))
441
442
443
444 #(define (ac:articulate-chord music)
445   (begin
446    (cond
447
448     ((eq? 'EventChord (ly:music-property music 'name))
449      (let loop ((actions (ac:getactions music)))
450       (if (null? actions)
451         (if (ly:moment> (ly:music-length music) (make-moment 1 4))
452          (ac:to128  music)
453          music)
454
455       (case (car actions)
456
457        ((articulation)
458         (map
459          (lambda (x) (ac:articulate-one-note x (cadr actions)))
460          (ly:music-property music 'elements))
461         (let*
462          ((num (caadr actions))
463           (denom (cdadr actions))
464           (mult (ly:duration-factor ac:currentDuration))
465           (newnum (* (- denom num) (car mult)))
466           (newdenom (* (cdr mult) denom))
467           (len (ly:duration-log ac:currentDuration))
468           (dots (ly:duration-dot-count ac:currentDuration)))
469
470          (if (not (eq? num denom))
471           (make-sequential-music
472            (list (ac:to128 music)
473            (make-music 'EventChord 'elements
474             (list
475              (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
476           music)))
477
478        ((rall)
479         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
480         (let ((pset (make-music 'PropertySet
481            'value
482            ac:currentTempo
483            'symbol
484            'tempoWholesPerMinute)))
485          (if (null? (cdr actions))
486           (make-sequential-music (list pset music))
487           (make-sequential-music
488            (list pset (loop (cdr actions)))))))
489
490        ((pocoRall)
491         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
492         (let ((pset (make-music 'PropertySet
493            'value
494            ac:currentTempo
495            'symbol
496            'tempoWholesPerMinute)))
497          (if (null? (cdr actions))
498           (make-sequential-music (list pset music))
499           (make-sequential-music
500            (list pset (loop (cdr actions)))))))
501
502        ((aTempo)
503         (set! ac:currentTempo ac:lastTempo)
504         (let ((pset (make-music 'PropertySet
505            'value
506            ac:currentTempo
507            'symbol
508            'tempoWholesPerMinute)))
509          (if (null? (cdr actions))
510           (make-sequential-music (list pset music))
511           (make-sequential-music
512            (list pset (loop (cdr actions)))))))
513
514        ((trill)
515          (ac:trill music))
516
517        ((mordent)
518         (let*
519          ((dur (ly:music-property
520                 (car (ly:music-property music 'elements)) 'duration))
521           (factor (ly:duration-factor dur))
522           (gracenote (ly:music-deep-copy music))
523           (mainnote (ly:music-deep-copy music))
524           (belownote (ly:music-deep-copy music))
525           (mordent (make-sequential-music (list gracenote belownote)))
526 )
527          (begin
528           (music-map (lambda (n)
529            (if (eq? 'NoteEvent (ly:music-property n 'name))
530             (set! (ly:music-property n 'duration)(ly:make-duration 3 0 1 1)))
531                       n)
532            mordent)
533           (map (lambda (y) (ac:down y))
534            (filter
535             (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
536             (ly:music-property belownote 'elements)))
537           (make-sequential-music (list (make-grace-music mordent) mainnote)))))
538        ((turn)
539         (let*
540          ((dur (ly:music-property
541                 (car (ly:music-property music 'elements)) 'duration))
542           (factor (ly:duration-factor dur))
543           (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
544                    (ly:duration-dot-count dur) (car factor)(cdr factor))))
545          (begin
546           (map (lambda (y) (ac:setduration y newdur))
547            (ly:music-property music 'elements))
548           (let* ((above (ly:music-deep-copy music))
549                  (below (ly:music-deep-copy music))
550                  (newmusic (make-sequential-music (list above music below music))))
551            (begin
552             (map (lambda (y) (ac:down y))
553              (filter
554               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
555               (ly:music-property below 'elements)))
556             (map (lambda (y) (ac:up y))
557              (filter
558               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
559               (ly:music-property above 'elements)))
560             newmusic)))))
561      ))))
562
563     ((eq? 'KeyChangeEvent (ly:music-property music 'name))
564      (set! ac:current-key music)
565      music
566    )
567
568     ((eq? 'PropertySet (ly:music-property music 'name))
569      (ac:adjust-props (ly:music-property music 'symbol) music)
570      music)
571
572     (else  music))
573  ))
574
575
576
577 % At last ... here's the music function that aplies all the above to a
578 % score.
579 articulate = #(define-music-function (parser location music)
580                (ly:music?)
581                "Adjust times of note to add tenuto, staccato and
582                 normal articulations.
583                 "
584                (music-map ac:articulate-chord music)
585                )
586
587
588 % Override \afterGrace to be in terms of audio, not spacing.
589 % Special handling for a gruppetto after a trill.
590 afterGrace =
591 #(define-music-function
592   (parser location main grace)
593   (ly:music? ly:music?)p
594
595   (let*
596    ((main-length (ly:music-length main))
597     (grace-orig-length (ly:music-length grace))
598     (gracelen (ac:twiddletime main))
599     (grace-factor (ly:moment-div gracelen grace-orig-length))
600     (new-main-length (ly:moment-sub main-length gracelen))
601     (factor (ly:moment-div new-main-length main-length))
602   )
603    (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
604          (filter (lambda (z)
605                   (and
606                    (eq? 'ArticulationEvent (ly:music-property z 'name))
607                    (string= "trill" (ly:music-property z 'articulation-type))))
608           (ly:music-property main 'elements)))
609    (ac:add-articulation "tenuto" grace)
610    (make-sequential-music  (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
611
612 % An appoggiatura takes half the duration of the main note,
613 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
614 % Somewhere around the end of the 19th, start of 20th century the rules
615 % changed, but my main interest is early music.
616 appoggiatura =
617 #(define-music-function (parser location grace main)
618   (ly:music? ly:music?)
619   (let* ((maindur (ly:music-length main))
620          (grace-orig-len (ly:music-length grace))
621          (main-orig-len (ly:music-length main))
622          (numerator (ly:moment-main-numerator maindur))
623          (factor (if (eq? (remainder numerator 3) 0)
624                   (ly:make-moment 1 3) (ly:make-moment 1 2))))
625    (ly:music-compress grace
626     (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
627    (ly:music-compress main (ly:moment-sub (ly:make-moment 1 1) factor))
628
629     (set! (ly:music-property grace 'elements)
630      (append (ly:music-property grace 'elements)
631       (list (make-music 'SlurEvent 'span-direction -1))))
632     (set! (ly:music-property main 'elements)
633      (append (ly:music-property main 'elements)
634       (list (make-music 'SlurEvent 'span-direction 1))))
635      (make-sequential-music (list grace main))))
636