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 %  * 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)
  90 %
  91
  92 \version "2.16.0"
  93
  94 #(use-modules (ice-9 debug))
  95 #(use-modules (scm display-lily))
  96
  97 % PARAMETERS
  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))
 102
 103 % How much to compress notes marked staccatissimo.
 104 #(define ac:staccatissimoFactor '(1 . 4))
 105
 106 % And tenuto (if we ever implement time stealing, this should be >1.0)
 107 #(define ac:tenutoFactor '(1 . 1))
 108
 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))
 113
 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
 118
 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))
 122
 123
 124 % Internal variables, don't touch.
 125 % (should probably be part of a context somehow)
 126
 127 % Whether to slur, or not
 128 #(define ac:inSlur #f)
 129 #(define ac:inPhrasingSlur #f)
 130
 131 % Whether the current noteevent is in a trill spanner
 132 #(define ac:inTrill #f)
 133
 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
 137           'KeyChangeEvent
 138           'tonic
 139           (ly:make-pitch -1 0 0)
 140           'pitch-alist
 141           (list (cons 0 0)
 142                 (cons 1 0)
 143                 (cons 2 0)
 144                 (cons 3 0)
 145                 (cons 4 0)
 146                 (cons 5 0)
 147                 (cons 6 0))))
 148
 149
 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'
 152
 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))
 156
 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)
 160   (display text)
 161   (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
 162   m
 163 )
 164
 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)
 169   (case sym
 170    ((tempoWholesPerMinute)
 171     (set! ac:currentTempo (ly:music-property music 'value))
 172     (set! ac:lastTempo ac:currentTempo)
 173   )))
 174
 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)))
 184        )
 185    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 186
 187
 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)))
 197        )
 198    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 199 )
 200
 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))
 205    (let*
 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))
 210      (num (car fraction))
 211      (denom (cdr fraction)))
 212     (begin
 213      (set! ac:currentDuration dur)
 214      (set! (ly:music-property m 'duration)
 215       (ly:make-duration l d
 216        (* num (car factor))
 217        (* denom (cdr factor))))))
 218    m))
 219
 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)))
 224    (if
 225     (or
 226      (eq? eventtype 'NoteEvent)
 227      (eq? eventtype 'RestEvent)
 228      (eq? eventtype 'SkipEvent))
 229     (set! (ly:music-property music 'duration) duration))))
 230
 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)))))
 239                 m)
 240      music))
 241
 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)
 247
 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)) '())
 260                            lastm)))
 261  music))
 262
 263
 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))
 267
 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))
 271
 272
 273 % a moment that is ac:maxTwiddletime seconds at the current tempo.
 274 #(define (ac:targetTwiddleTime)
 275   (ac:abs->mom ac:maxTwiddleTime))
 276
 277
 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
 280 % in a trill)
 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)
 288                  '()))
 289          (t (ac:targetTwiddleTime)))
 290    (if (ly:moment? pre-t)
 291     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)))
 295       len)))))
 296
 297
 298
 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))
 307          (uppernote '())
 308          (note_moment (ly:moment-mul t (ly:make-moment 1 2)))
 309          (c1 (ly:moment-div orig-len note_moment))
 310          (c2 (inexact->exact
 311               (round (/ (ly:moment-main-numerator c1)
 312                       (* 2 (ly:moment-main-denominator c1))))))
 313          (count (if (< c2 2) 2 c2)))
 314
 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))
 322     (filter
 323      (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 324      (ly:music-property uppernote 'elements)))
 325
 326    (let* ((trillMusicElements
 327           (let loop ((so_far (list uppernote music))
 328                      (c count))
 329            (if (> c 1)
 330             (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
 331             so_far)))
 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)))
 340 ;                   1024)))
 341 ;     (ac:accel trillMusic factor))
 342  )))
 343
 344 %
 345 % Generate a tempoChangeEvent and its associated property setting.
 346 %
 347 #(define (ac:tempoChange tempo)
 348   (make-sequential-music
 349    (list (make-music 'TempoChangeEvent
 350           'metronome-count
 351           tempo
 352           'tempo-unit
 353           (ly:make-duration 0 0 1 1))
 354     (context-spec-music
 355     (make-property-set 'tempoWholesPerMinute  tempo) 'Score))))
 356
 357 % If there's an articulation, use it.
 358 % If in a slur, use (1 . 1) instead.
 359 % Treat phrasing slurs as slurs, but allow explicit articulation.
 360 % (Maybe should treat staccato under a phrasing slur as mezzo-staccato?)
 361 %
 362 % Expect an EventChord.
 363 %
 364 % trills, turns, ornaments etc.  are also treated as Articulations.
 365 % Split into two functions:
 366 %  ac:getactions traverses the elements in the EventChord
 367 %               and calculates the parameters.
 368 %  ac:articulate-chord applies the actions to each NoteEvent in
 369 %               the EventChord.
 370 #(define (ac:getactions music)
 371   (let  loop ((factor ac:normalFactor)
 372               (newelements '())
 373               (es (ly:music-property music 'elements))
 374               (actions '()))
 375    (if (null? es)
 376     (begin
 377      (set! (ly:music-property music 'elements) (reverse newelements))
 378      (cond
 379       ((not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
 380                  newelements))
 381        actions)
 382       (ac:inTrill (cons 'trill actions))
 383       ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
 384        (append actions (list 'articulation  '(1 . 1)) ))
 385       (else (append actions (list 'articulation  factor)))))
 386     ; else part
 387     (let ((e (car es))
 388           (tail (cdr es)))
 389      (case (ly:music-property e 'name)
 390
 391       ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
 392        (loop factor newelements tail actions))
 393
 394       ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
 395        (loop (cons 1 1) (cons e newelements) tail actions))
 396
 397       ((ArticulationEvent)
 398        (let ((articname (ly:music-property e 'articulation-type)))
 399         ; TODO: add more here
 400         (cond
 401          ((string= articname "staccato")
 402           (loop ac:staccatoFactor newelements tail actions))
 403          ((string= articname "staccatissimo")
 404           (loop ac:staccatissimoFactor newelements tail actions))
 405          ((string= articname "tenuto")
 406           (loop ac:tenutoFactor newelements tail actions))
 407          ((string= articname "mordent")
 408           (loop (cons 1 1) newelements tail (cons 'mordent actions)))
 409          ((string= articname "prall")
 410           (loop (cons 1 1) newelements tail (cons 'prall actions)))
 411          ((string= articname "trill")
 412           (loop (cons 1 1) newelements tail (cons 'trill actions)))
 413          ((string= articname "turn")
 414           (loop (cons 1 1) newelements tail (cons 'turn actions)))
 415          (else (loop factor (cons e newelements) tail actions)))))
 416
 417       ((TextScriptEvent)
 418        (let ((t (ly:music-property e 'text)))
 419         (if (not (string? t))
 420          (loop factor (cons e newelements) tail actions)
 421          (begin
 422           (cond
 423            ((or
 424              (string= t "rall")
 425              (string= t "Rall")
 426              (string= t "rit.")
 427              (string= t "rall."))
 428             (loop factor (cons e newelements) tail (cons 'rall actions)))
 429            ((or
 430              (string= t "accelerando")
 431              (string= t "accel")
 432              (string= t "accel."))
 433             (loop factor (cons e newelements) tail (cons 'accel actions)))
 434            ((or
 435              (string= t "poco accel."))
 436             (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
 437            ((or
 438              (string= t "poco rall.")
 439              (string= t "poco rit."))
 440             (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
 441            ((or (string= t "a tempo")
 442              (string= t "tempo I"))
 443           (loop factor (cons e newelements) tail (cons 'aTempo actions)))
 444            (else (loop factor (cons e newelements) tail actions)))))))
 445
 446       ((SlurEvent)
 447        (let ((direction (ly:music-property e 'span-direction)))
 448         (set! ac:inSlur (eq? direction -1))
 449         (loop factor newelements tail actions)))
 450
 451       ((TrillSpanEvent)
 452        (let ((direction (ly:music-property e 'span-direction)))
 453         (set! ac:inTrill (eq? direction -1))
 454         (if ac:inTrill
 455          (loop factor newelements tail (cons 'trill actions))
 456          (loop factor (cons e newelements) tail actions))))
 457
 458       ((PhrasingSlurEvent)
 459        (let ((direction (ly:music-property e 'span-direction)))
 460         (set! ac:inPhrasingSlur (eq? direction -1))
 461         (loop factor newelements tail actions)))
 462
 463       (else (loop factor (cons e newelements) tail actions)))))))
 464
 465
 466
 467 #(define (ac:articulate-chord music)
 468   (begin
 469    (cond
 470
 471     ((eq? 'EventChord (ly:music-property music 'name))
 472      (let loop ((actions (ac:getactions music)))
 473       (if (null? actions)
 474         (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
 475          (ac:to128  music)
 476          music)
 477
 478       (case (car actions)
 479
 480        ((articulation)
 481         (map
 482          (lambda (x) (ac:articulate-one-note x (cadr actions)))
 483          (ly:music-property music 'elements))
 484         (let*
 485          ((num (caadr actions))
 486           (denom (cdadr actions))
 487           (mult (ly:duration-factor ac:currentDuration))
 488           (newnum (* (- denom num) (car mult)))
 489           (newdenom (* (cdr mult) denom))
 490           (len (ly:duration-log ac:currentDuration))
 491           (dots (ly:duration-dot-count ac:currentDuration)))
 492
 493          (if (not (eq? num denom))
 494           (make-sequential-music
 495            (list (ac:to128 music)
 496            (make-music 'EventChord 'elements
 497             (list
 498              (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
 499           music)))
 500
 501        ((accel)
 502         (set! ac:lastTempo ac:currentTempo)
 503         (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
 504         (let ((pset (ac:tempoChange ac:currentTempo)))
 505          (if (null? (cdr actions))
 506           (make-sequential-music (list pset music))
 507           (make-sequential-music
 508            (list pset (loop (cdr actions)))))))
 509
 510        ((pocoAccel)
 511         (set! ac:lastTempo ac:currentTempo)
 512         (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
 513         (let ((pset (ac:tempoChange ac:currentTempo)))
 514          (if (null? (cdr actions))
 515           (make-sequential-music (list pset music))
 516           (make-sequential-music
 517            (list pset (loop (cdr actions)))))))
 518
 519        ((rall)
 520         (set! ac:lastTempo ac:currentTempo)
 521         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
 522         (let ((pset (ac:tempoChange ac:currentTempo)))
 523          (if (null? (cdr actions))
 524           (make-sequential-music (list pset music))
 525           (make-sequential-music
 526            (list pset (loop (cdr actions)))))))
 527
 528        ((pocoRall)
 529         (set! ac:lastTempo ac:currentTempo)
 530         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
 531         (let ((pset (ac:tempoChange ac:currentTempo)))
 532          (if (null? (cdr actions))
 533           (make-sequential-music (list pset music))
 534           (make-sequential-music
 535            (list pset (loop (cdr actions)))))))
 536
 537        ((aTempo)
 538         (set! ac:currentTempo ac:lastTempo)
 539
 540         (let ((pset (ac:tempoChange ac:currentTempo)))
 541          (if (null? (cdr actions))
 542           (make-sequential-music (list pset music))
 543           (make-sequential-music
 544            (list pset (loop (cdr actions)))))))
 545
 546        ((trill)
 547          (ac:trill music))
 548
 549        ((prall)
 550         ; A pralltriller symbol can either mean an inverted mordent
 551         ; or a half-shake -- a short, two twiddle trill.
 552         ; We implement as a half-shake.
 553         (let*
 554          ((totallength (ly:music-length music))
 555           (newlen (ly:moment-sub totallength (ly:make-moment 3 32)))
 556           (newdur (ly:make-duration
 557                    0 0
 558                    (ly:moment-main-numerator newlen)
 559                    (ly:moment-main-denominator newlen)))
 560           (gracedur (ly:make-duration 5 0 1 1))
 561           (gracenote (ly:music-deep-copy music))
 562           (abovenote (ly:music-deep-copy music))
 563           (mainnote (ly:music-deep-copy music))
 564           (prall (make-sequential-music (list gracenote abovenote)))
 565         )
 566           (music-map (lambda (n)
 567            (if (eq? 'NoteEvent (ly:music-property n 'name))
 568             (set! (ly:music-property n 'duration) gracedur))
 569                       n)
 570            abovenote)
 571           (music-map (lambda (n)
 572            (if (eq? 'NoteEvent (ly:music-property n 'name))
 573             (set! (ly:music-property n 'duration) gracedur))
 574                       n)
 575            gracenote)
 576           (music-map (lambda (n)
 577            (if (eq? 'NoteEvent (ly:music-property n 'name))
 578             (set! (ly:music-property n 'duration) newdur))
 579                       n)
 580            mainnote)
 581
 582           (map (lambda (y) (ac:up y))
 583            (filter
 584             (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 585             (ly:music-property abovenote 'elements)))
 586           (make-sequential-music (list abovenote gracenote abovenote mainnote))))
 587
 588        ((mordent)
 589         (let*
 590          ((totaldur (ly:music-property
 591                 (car (ly:music-property music 'elements)) 'duration))
 592           (dur (ly:duration-length totaldur))
 593           (newlen (ly:moment-sub dur (ly:make-moment 2 32)))
 594           (newdur (ly:make-duration
 595                 0 0
 596                    (ly:moment-main-numerator newlen)
 597                    (ly:moment-main-denominator newlen)))
 598           (gracenote (ly:music-deep-copy music))
 599           (belownote (ly:music-deep-copy music))
 600           (mainnote (ly:music-deep-copy music))
 601           (mordent (make-sequential-music (list gracenote belownote)))
 602         )
 603          (begin
 604           (music-map (lambda (n)
 605            (if (eq? 'NoteEvent (ly:music-property n 'name))
 606             (set! (ly:music-property n 'duration)
 607              (ly:make-duration 5 0 1 1)))
 608                       n)
 609            mordent)
 610           (music-map (lambda (n)
 611            (if (eq? 'NoteEvent (ly:music-property n 'name))
 612             (set! (ly:music-property n 'duration) newdur))
 613                       n)
 614            mainnote)
 615           (map (lambda (y) (ac:down y))
 616            (filter
 617             (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 618             (ly:music-property belownote 'elements)))
 619           (make-sequential-music (list mordent mainnote)))))
 620        ((turn)
 621         (let*
 622          ((dur (ly:music-property
 623                 (car (ly:music-property music 'elements)) 'duration))
 624           (factor (ly:duration-factor dur))
 625           (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
 626                    (ly:duration-dot-count dur) (car factor)(cdr factor))))
 627          (begin
 628           (map (lambda (y) (ac:setduration y newdur))
 629            (ly:music-property music 'elements))
 630           (let* ((above (ly:music-deep-copy music))
 631                  (below (ly:music-deep-copy music))
 632                  (newmusic (make-sequential-music (list above music below music))))
 633            (begin
 634             (map (lambda (y) (ac:down y))
 635              (filter
 636               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 637               (ly:music-property below 'elements)))
 638             (map (lambda (y) (ac:up y))
 639              (filter
 640               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 641               (ly:music-property above 'elements)))
 642             newmusic)))))
 643      ))))
 644
 645     ((eq? 'KeyChangeEvent (ly:music-property music 'name))
 646      (set! ac:current-key music)
 647      music
 648    )
 649
 650     ((eq? 'PropertySet (ly:music-property music 'name))
 651      (ac:adjust-props (ly:music-property music 'symbol) music)
 652      music)
 653
 654     (else music))
 655  ))
 656
 657
 658
 659 % At last ... here's the music function that applies all the above to a
 660 % score.
 661 articulate = #(define-music-function (parser location music)
 662                (ly:music?)
 663                "Adjust times of note to add tenuto, staccato and
 664                 normal articulations.
 665                 "
 666                (set! music (event-chord-wrap! music parser))
 667                (music-map ac:articulate-chord music)
 668                )
 669
 670
 671 % Override \afterGrace to be in terms of audio, not spacing.
 672 % Special handling for a gruppetto after a trill.
 673 afterGrace =
 674 #(define-music-function
 675   (parser location main grace)
 676   (ly:music? ly:music?)
 677
 678   (set! main (event-chord-wrap! main parser))
 679   (set! grace (event-chord-wrap! grace parser))
 680   (let*
 681    ((main-length (ly:music-length main))
 682     (grace-orig-length (ly:music-length grace))
 683     (gracelen (ac:twiddletime main))
 684     (grace-factor (ly:moment-div gracelen grace-orig-length))
 685     (new-main-length (ly:moment-sub main-length gracelen))
 686     (factor (ly:moment-div new-main-length main-length))
 687   )
 688    (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
 689          (filter (lambda (z)
 690                   (and
 691                    (eq? 'ArticulationEvent (ly:music-property z 'name))
 692                    (string= "trill" (ly:music-property z 'articulation-type))))
 693           (ly:music-property main 'elements)))
 694    (ac:add-articulation "tenuto" grace)
 695    (make-sequential-music  (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
 696
 697 % An appoggiatura takes half the duration of the main note,
 698 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
 699 % Somewhere around the end of the 19th, start of 20th century the rules
 700 % changed, but my main interest is early music.
 701 appoggiatura =
 702 #(define-music-function (parser location grace main)
 703   (ly:music? ly:music?)
 704   (set! grace (event-chord-wrap! grace parser))
 705   (set! main (event-chord-wrap! main parser))
 706   (let* ((maindur (ly:music-length main))
 707          (grace-orig-len (ly:music-length grace))
 708          (main-orig-len (ly:music-length main))
 709          (numerator (ly:moment-main-numerator maindur))
 710          (factor (if (eq? (remainder numerator 3) 0)
 711                   (ly:make-moment 1 3) (ly:make-moment 1 2))))
 712    (ly:music-compress grace
 713     (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
 714    (ly:music-compress main (ly:moment-sub (ly:make-moment 1 1) factor))
 715
 716     (set! (ly:music-property grace 'elements)
 717      (append (ly:music-property grace 'elements)
 718       (list (make-music 'SlurEvent 'span-direction -1))))
 719     (set! (ly:music-property main 'elements)
 720      (append (ly:music-property main 'elements)
 721       (list (make-music 'SlurEvent 'span-direction 1))))
 722      (make-sequential-music (list grace main))))
 723