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 % \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.17.11"
  93
  94 #(use-modules (srfi srfi-1))
  95 #(use-modules (srfi srfi-11))
  96 #(use-modules (ice-9 debug))
  97 #(use-modules (scm display-lily))
  98
  99 % PARAMETERS
 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))
 104
 105 % How much to compress notes marked staccatissimo.
 106 #(define ac:staccatissimoFactor '(1 . 4))
 107
 108 % And tenuto (if we ever implement time stealing, this should be >1.0)
 109 #(define ac:tenutoFactor '(1 . 1))
 110
 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))
 115
 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
 120
 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))
 124
 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)
 129
 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)
 135
 136
 137 % Internal variables, don't touch.
 138 % (should probably be part of a context somehow)
 139
 140 % Whether to slur, or not
 141 #(define ac:inSlur #f)
 142 #(define ac:inPhrasingSlur #f)
 143
 144 % Whether the current noteevent is in a trill spanner
 145 #(define ac:inTrill #f)
 146
 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
 150           'KeyChangeEvent
 151           'tonic
 152           (ly:make-pitch -1 0 0)
 153           'pitch-alist
 154           (list (cons 0 0)
 155                 (cons 1 0)
 156                 (cons 2 0)
 157                 (cons 3 0)
 158                 (cons 4 0)
 159                 (cons 5 0)
 160                 (cons 6 0))))
 161
 162
 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'
 165
 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))
 169
 170 % Amount of musical time (in whole notes) that we need to steal from the
 171 % next events seen.
 172 #(define ac:stealForward 0)
 173
 174 % List of events in the output so far, in reverse order, from which we can
 175 % steal time.
 176 #(define ac:eventsBackward '())
 177
 178 % Log events for the backward chain.
 179 #(define (ac:logEventsBackward music)
 180   (music-map
 181    (lambda (m)
 182     (case (ly:music-property m 'name)
 183      ((EventChord)
 184       (set! ac:eventsBackward (cons m ac:eventsBackward))
 185       m)
 186      ((BarCheck SkipMusic)
 187       (let ((wm (make-sequential-music (list m))))
 188        (set! ac:eventsBackward (cons wm ac:eventsBackward))
 189        wm))
 190      (else
 191       m)))
 192    music))
 193
 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)
 197   (if (<= tosteal 0)
 198    #t
 199    (if (null? ac:eventsBackward)
 200     (begin
 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)))
 203     (let*
 204      ((lastev (car ac:eventsBackward))
 205       (levlen (ly:moment-main (ly:music-length lastev))))
 206      (if (< tosteal levlen)
 207       (begin
 208        (ly:music-compress lastev (ly:make-moment (/ (- levlen tosteal) levlen)))
 209        #t)
 210       (begin
 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))))))))
 217
 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)
 221   (display text)
 222   (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
 223   m
 224 )
 225
 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)
 230   (case sym
 231    ((tempoWholesPerMinute)
 232     (set! ac:currentTempo (ly:music-property music 'value))
 233     (set! ac:lastTempo ac:currentTempo)
 234   )))
 235
 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)))
 245        )
 246    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 247
 248
 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)))
 258        )
 259    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 260 )
 261
 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))
 266    (let*
 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))
 271      (num (car fraction))
 272      (denom (cdr fraction)))
 273     (begin
 274      (set! ac:currentDuration dur)
 275      (set! (ly:music-property m 'duration)
 276       (ly:make-duration l d
 277        (* num (car factor))
 278        (* denom (cdr factor))))))
 279    m))
 280
 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)))
 285    (if
 286     (or
 287      (eq? eventtype 'NoteEvent)
 288      (eq? eventtype 'RestEvent)
 289      (eq? eventtype 'SkipEvent))
 290     (set! (ly:music-property music 'duration) duration))))
 291
 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)))))
 300                 m)
 301      music))
 302
 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)
 308
 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)) '())
 321                            lastm)))
 322  music))
 323
 324
 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))
 328
 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))
 332
 333
 334 % a moment that is ac:maxTwiddletime seconds at the current tempo.
 335 #(define (ac:targetTwiddleTime)
 336   (ac:abs->mom ac:maxTwiddleTime))
 337
 338
 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
 341 % in a trill)
 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)
 349                  '()))
 350          (t (ac:targetTwiddleTime)))
 351    (if (ly:moment? pre-t)
 352     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)))
 356       len)))))
 357
 358
 359
 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))
 368          (uppernote '())
 369          (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
 370          (c1 (ly:moment-div orig-len note_moment))
 371          (c2 (inexact->exact
 372               (round (/ (ly:moment-main-numerator c1)
 373                       (* 2 (ly:moment-main-denominator c1))))))
 374          (count (if (< c2 2) 2 c2)))
 375
 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))
 383     (filter
 384      (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 385      (ly:music-property uppernote 'elements)))
 386
 387    (let* ((trillMusicElements
 388           (let loop ((so_far (list uppernote music))
 389                      (c count))
 390            (if (> c 1)
 391             (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
 392             so_far)))
 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)))
 401 ;                   1024)))
 402 ;     (ac:accel trillMusic factor))
 403  )))
 404
 405 %
 406 % Generate a tempoChangeEvent and its associated property setting.
 407 %
 408 #(define (ac:tempoChange tempo)
 409   (make-sequential-music
 410    (list (make-music 'TempoChangeEvent
 411           'metronome-count
 412           tempo
 413           'tempo-unit
 414           (ly:make-duration 0 0 1/1))
 415     (context-spec-music
 416     (make-property-set 'tempoWholesPerMinute  tempo) 'Score))))
 417
 418 %
 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.
 426 %
 427 #(define (ac:unfoldMusic music)
 428   (music-map
 429    (lambda (m)
 430     (case (ly:music-property m 'name)
 431      ((UnfoldedRepeatedMusic)
 432       (let
 433        ((body (ly:music-property m 'element))
 434         (altl (ly:music-property m 'elements))
 435         (rc (ly:music-property m 'repeat-count)))
 436        (if (null? altl)
 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
 441           (apply append!
 442            (append!
 443             (list-tabulate
 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))))))))
 447      ((EventChord)
 448       (let-values
 449        (((trem evl)
 450          (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
 451           (ly:music-property m 'elements))))
 452        (if (null? trem)
 453         m
 454         (let*
 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)
 466            tremtype))
 467          (for-each
 468           (lambda (v)
 469            (or (null? (ly:music-property v 'duration))
 470             (set! (ly:music-property v 'duration) tremdur)))
 471           evl)
 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
 477        (list
 478         (make-music 'BarCheck)
 479         (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
 480         (make-music 'BarCheck))))
 481      (else
 482       m)))
 483    (unfold-repeats music)))
 484
 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?)
 489 %
 490 % Expect an EventChord.
 491 %
 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
 497 %               the EventChord.
 498 #(define (ac:getactions music)
 499   (let  loop ((factor ac:normalFactor)
 500               (newelements '())
 501               (es (ly:music-property music 'elements))
 502               (actions '()))
 503    (if (null? es)
 504     (begin
 505      (set! (ly:music-property music 'elements) (reverse newelements))
 506      (if
 507       (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
 508                 newelements))
 509       actions
 510       (append
 511        (let ((st ac:stealForward))
 512         (if (= st 0)
 513          '()
 514          (begin
 515           (set! ac:stealForward 0)
 516           (list 'steal st))))
 517        actions
 518        (cond
 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))))))
 523     ; else part
 524     (let ((e (car es))
 525           (tail (cdr es)))
 526      (case (ly:music-property e 'name)
 527
 528       ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
 529        (loop factor newelements tail actions))
 530
 531       ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
 532        (loop (cons 1 1) (cons e newelements) tail actions))
 533
 534       ((ArticulationEvent)
 535        (let ((articname (ly:music-property e 'articulation-type)))
 536         ; TODO: add more here
 537         (cond
 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)))))
 553
 554       ((TextScriptEvent)
 555        (let ((t (ly:music-property e 'text)))
 556         (if (not (string? t))
 557          (loop factor (cons e newelements) tail actions)
 558          (begin
 559           (cond
 560            ((or
 561              (string= t "rall")
 562              (string= t "Rall")
 563              (string= t "rit.")
 564              (string= t "rall."))
 565             (loop factor (cons e newelements) tail (cons 'rall actions)))
 566            ((or
 567              (string= t "accelerando")
 568              (string= t "accel")
 569              (string= t "accel."))
 570             (loop factor (cons e newelements) tail (cons 'accel actions)))
 571            ((or
 572              (string= t "poco accel."))
 573             (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
 574            ((or
 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)))))))
 582
 583       ((SlurEvent)
 584        (let ((direction (ly:music-property e 'span-direction)))
 585         (set! ac:inSlur (eq? direction -1))
 586         (loop factor newelements tail actions)))
 587
 588       ((TrillSpanEvent)
 589        (let ((direction (ly:music-property e 'span-direction)))
 590         (set! ac:inTrill (eq? direction -1))
 591         (if ac:inTrill
 592          (loop factor newelements tail (cons 'trill actions))
 593          (loop factor (cons e newelements) tail actions))))
 594
 595       ((PhrasingSlurEvent)
 596        (let ((direction (ly:music-property e 'span-direction)))
 597         (set! ac:inPhrasingSlur (eq? direction -1))
 598         (loop factor newelements tail actions)))
 599
 600       (else (loop factor (cons e newelements) tail actions)))))))
 601
 602
 603
 604 #(define (ac:articulate-chord music)
 605   (cond
 606    ((eq? 'EventChord (ly:music-property music 'name))
 607     (ac:logEventsBackward
 608      (let loop ((actions (ac:getactions music)))
 609       (if (null? actions)
 610         (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
 611          (ac:to128  music)
 612          music)
 613
 614       (case (car actions)
 615
 616        ((articulation)
 617         (map
 618          (lambda (x) (ac:articulate-one-note x (cadr actions)))
 619          (ly:music-property music 'elements))
 620         (let*
 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)))
 628
 629          (if (not (eq? num denom))
 630           (make-sequential-music
 631            (list (ac:to128 music)
 632            (make-music 'EventChord 'elements
 633             (list
 634              (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
 635           music)))
 636
 637        ((accel)
 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)))))))
 645
 646        ((pocoAccel)
 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)))))))
 654
 655        ((rall)
 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)))))))
 663
 664        ((pocoRall)
 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)))))))
 672
 673        ((aTempo)
 674         (set! ac:currentTempo ac:lastTempo)
 675
 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)))))))
 681
 682        ((trill)
 683          (ac:trill music))
 684
 685        ((prall)
 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.
 689         (let*
 690          ((totallength (ly:music-length music))
 691           (newlen (ly:moment-sub totallength (ly:make-moment 3/32)))
 692           (newdur (ly:make-duration
 693                    0 0
 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)))
 701         )
 702           (music-map (lambda (n)
 703            (if (eq? 'NoteEvent (ly:music-property n 'name))
 704             (set! (ly:music-property n 'duration) gracedur))
 705                       n)
 706            abovenote)
 707           (music-map (lambda (n)
 708            (if (eq? 'NoteEvent (ly:music-property n 'name))
 709             (set! (ly:music-property n 'duration) gracedur))
 710                       n)
 711            gracenote)
 712           (music-map (lambda (n)
 713            (if (eq? 'NoteEvent (ly:music-property n 'name))
 714             (set! (ly:music-property n 'duration) newdur))
 715                       n)
 716            mainnote)
 717
 718           (map (lambda (y) (ac:up y))
 719            (filter
 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))))
 723
 724        ((mordent)
 725         (let*
 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
 731                 0 0
 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)))
 738         )
 739          (begin
 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)))
 744                       n)
 745            mordent)
 746           (music-map (lambda (n)
 747            (if (eq? 'NoteEvent (ly:music-property n 'name))
 748             (set! (ly:music-property n 'duration) newdur))
 749                       n)
 750            mainnote)
 751           (map (lambda (y) (ac:down y))
 752            (filter
 753             (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 754             (ly:music-property belownote 'elements)))
 755           (make-sequential-music (list mordent mainnote)))))
 756        ((turn)
 757         (let*
 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))))
 763          (begin
 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))))
 769            (begin
 770             (map (lambda (y) (ac:down y))
 771              (filter
 772               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 773               (ly:music-property below 'elements)))
 774             (map (lambda (y) (ac:up y))
 775              (filter
 776               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 777               (ly:music-property above 'elements)))
 778             newmusic)))))
 779        ((steal)
 780         (let
 781          ((totallen (ly:moment-main (ly:music-length music)))
 782           (steallen (cadr actions)))
 783          (if (>= steallen totallen)
 784           (begin
 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 '()))
 790           (begin
 791            (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
 792            (loop (cddr actions))))))
 793      )))))
 794
 795    ((eq? 'GraceMusic (ly:music-property music 'name))
 796     (let
 797      ((first-ev
 798        (call-with-current-continuation
 799         (lambda (yield-fev)
 800          (music-map
 801           (lambda (m)
 802            (if (eq? 'EventChord (ly:music-property m 'name))
 803             (yield-fev m)
 804             m))
 805           music)
 806          #f))))
 807      (if first-ev
 808       (let ((fev-pos (find-tail (lambda (m) (eq? m first-ev)) ac:eventsBackward)))
 809        (if fev-pos
 810         (set! ac:eventsBackward (cdr fev-pos))
 811         (ly:warning (_ "articulation of grace notes has gone awry"))))))
 812     (let*
 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))))
 818      gmus))
 819
 820    ((memq (ly:music-property music 'name) '(BarCheck SkipMusic))
 821     (let ((totallen (ly:moment-main (ly:music-length music)))
 822           (steallen ac:stealForward))
 823      (cond
 824       ((= steallen 0)
 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)))))
 830       (else
 831        (set! ac:stealForward (- steallen totallen))
 832        (make-sequential-music '())))))
 833
 834    ((eq? 'KeyChangeEvent (ly:music-property music 'name))
 835     (set! ac:current-key music)
 836     music)
 837
 838    ((eq? 'PropertySet (ly:music-property music 'name))
 839     (ac:adjust-props (ly:music-property music 'symbol) music)
 840     music)
 841
 842    (else music)))
 843
 844
 845
 846 % At last ... here's the music function that applies all the above to a
 847 % score.
 848 articulate = #(define-music-function (parser location music)
 849                (ly:music?)
 850                "Adjust times of note to add tenuto, staccato and
 851                 normal articulations.
 852                 "
 853                (dynamic-wind
 854                 (lambda ()
 855                  (set! ac:stealForward 0)
 856                  (set! ac:eventsBackward '()))
 857                 (lambda ()
 858                  (music-map
 859                   ac:articulate-chord
 860                   (ac:unfoldMusic (event-chord-wrap! music parser))))
 861                 (lambda ()
 862                  (or (= ac:stealForward 0)
 863                   (begin
 864                    (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
 865                    (set! ac:stealForward 0)))
 866                  (set! ac:eventsBackward '()))))
 867
 868
 869 % Override \afterGrace to be in terms of audio, not spacing.
 870 % Special handling for a gruppetto after a trill.
 871 afterGrace =
 872 #(define-music-function
 873   (parser location main grace)
 874   (ly:music? ly:music?)
 875
 876   (set! main (event-chord-wrap! main parser))
 877   (set! grace (event-chord-wrap! grace parser))
 878   (let*
 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))
 885   )
 886    (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
 887          (filter (lambda (z)
 888                   (and
 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)))))
 894
 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.
 899 appoggiatura =
 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))
 913
 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))))
 921