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 % Trills, turns, mordents and pralls are expanded with rallentendo
  26 % and accelerando taken 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 % See: http://nicta.com.au/people/chubbp/articulate for additional
  32 % information about how the articulate function works.
  33
  34 %%% Supported items:
  35 % Articulations on a single note (staccato, staccatissimo, portato, tenuto).
  36 % Slurs and phrasing slurs.
  37 % Ornaments (i.e. mordents, trills, turns).
  38 % Rallentando, accelerando, ritard and 'a tempo'.
  39 %
  40 % Please refer to 'MIDI output' (Section 3.5) in the Notation Reference
  41 % Manual for a more detailed list of supported items.
  42
  43 %%% Technical Details:
  44 % * Any note not under a slur or phrasing slur, and not marked with an
  45 %   explicit articulation, is shortened by ac:normalFactor (default 7/8).
  46 %   (Shortening a note means replacing the note with a note of a smaller
  47 %   duration, and a rest to make up for the difference between the durations
  48 %   of the original and the shortened note.)
  49 % * Notes marked with articulations are shortened by factors specific to the
  50 %   articulation as follows:
  51 %     staccato       not under a slur: ac:staccatoFactor (default 1/2)
  52 %                    under a slur: ac:portatoFactor (default 3/4)
  53 %     staccatissimo  ac:staccatissimoFactor (default 1/4)
  54 %     portato        ac:portatoFactor (default 3/4)
  55 %     tenuto         ac:tenutoFactor (default 1/1 - by default, notes marked
  56 %                                     tenuto are not shortened)
  57 % * Appoggiaturas are made to take half the value of the note following,
  58 %   without taking dots into account (so in \appoggiatura c8 d2. the c
  59 %   will take the time of a crotchet).
  60 % * Trills and turns are expanded. The algorithm tries to choose notes
  61 %   within the time of the current tempo that lead to each twiddle being
  62 %   around 1/8 seconds; this can be adjusted with the ac:maxTwiddleTime
  63 %   variable.
  64 % * Rall, poco rall and a tempo are observed. It'd be fairly trivial to
  65 %   make accel. and stringendo and so on work too.
  66
  67 %
  68 %%%USAGE
  69 % In the \score section do:
  70 % \articulate <<
  71 %       all the rest of the score
  72 % >>
  73 % or use the lilywrap script.
  74 %
  75 % TO DO:
  76 %
  77 % * Dynamics.
  78 %   * Fix quantisation for dynamics on single note (replace note
  79 %     with tied 128th notes?) -- started, needs work.
  80 %   * Make \fp do the right thing (loud start, then quiet).
  81 %
  82 % * Inegalite.  Notes on-beat steal time from notes off-beat.
  83 %   Degree of stealing is a parameter: from 1.0 (straight)
  84 %   to 1.5 (extreme swing).  Also fix tenuto to use this.
  85 %
  86 % * add accel (to match rall), and molto rall. I've never seen
  87 %   molto accel but some composer somewhere has probably used it.
  88 %
  89 % * Fermata, and Fermata Lunga
  90 % * Add more synonyms for accel and rall: rit ritard stringendo
  91 %
  92 % * Phrasing.
  93 %   * Rall at end of piece
  94 %   * Very slight accel into a phrase, rall out of it.
  95 %   * Dynamics during a phrase????  unclear how these should be in
  96 %     the general case
  97 %
  98 % * Trill algorithm needs work.
  99 %
 100 % * Cope with more ornaments/articulations.
 101 %    inverted-turns, etc.
 102 %   -- accent needs better control of dynamics.
 103 %   -- Handling of generic ornaments (in lily, `\stopped'; in
 104 %               most early music:  ornament this note (trill, turn
 105 %               or mordent as the player wishes))
 106
 107 % * Automatic gruppetto at end of trill; better handling of
 108 %      initial/final grace notes on trill
 109
 110 % * Automatic ornaments.
 111 %   * Spot cadences and ornament
 112 %   * Look for quaver-dotted note for trills, for example.
 113 %   * Fill in steps. (Needs lookahead/lookbehind.)
 114 % * `afterturn' -- a turn after the start of a note.
 115 % * accidentals for trills and turns
 116
 117 % CHANGELOG
 118 %  * Heikki Tauriainen: handle also the \portato articulation (both as an
 119 %    explicit articulation, and as the articulation to use for slurred
 120 %    notes marked \staccato).
 121 %  * David Kastrup: remove redefinitions of \afterGrace and \appoggiatura
 122 %    and let their actions be performed when \articulate is called by
 123 %    recognizing and replacing LilyPond's default code for these constructs.
 124 %    Cf issue 4517 in LilyPond's tracker.
 125 %  * David Kastrup: basic 2.15.28 compatibility by using event-chord-wrap!
 126 %    This should really be done by rewriting the code more thoroughly.
 127 %  * From Iain Nicol: appoggiatura timings were out; add staccatissimo; fix
 128 %    trillSpanner endpoints.
 129 %  * Also handle Breathing events (by throwing them away).  This isn't ideal;
 130 %    one should really shorten the note before a little.  But I don't know
 131 %    how to do lookahead in scheme.
 132 %  * Also ignore explicit line breaks.
 133 %  * Add Mordents (reported by Patrick Karl)
 134 %  * Thomas Morley: extend unfold-repeats to reflect the possibility to
 135 %    customize its effect to user-settable repeat-types. Here the most general
 136 %    setting is hard-coded, resulting in unchanged behaviour.
 137
 138 \version "2.19.22"
 139
 140 #(use-modules (srfi srfi-1))
 141 #(use-modules (srfi srfi-11))
 142 #(use-modules (ice-9 debug))
 143 #(use-modules (scm display-lily))
 144
 145 % PARAMETERS
 146 % How much to compress notes marked Staccato.  CPE Bach says `as short as
 147 % may conveniently be played, as if the keys were too hot to touch'.
 148 % Most modern sources say 1/2 the notated length of a note.
 149 #(define ac:staccatoFactor '(1 . 2))
 150
 151 % How much to compress notes marked staccatissimo.
 152 #(define ac:staccatissimoFactor '(1 . 4))
 153
 154 % Shortening factor for notes marked portato (or slurred notes marked
 155 % staccato).
 156 #(define ac:portatoFactor '(3 . 4))
 157
 158 % And tenuto (if we ever implement time stealing, this should be >1.0)
 159 #(define ac:tenutoFactor '(1 . 1))
 160
 161 % How much to articulate normal notes.  CPE Bach says 1/2 (and
 162 % staccato should be `as short as may conveniently be played') but this
 163 % sounds too short for modern music.  7/8 sounds about right.
 164 #(define ac:normalFactor '(7 . 8))
 165
 166 % How much to slow down for a rall. or a poco rall.
 167 % (or speed up for accel or poco accel)
 168 #(define ac:rallFactor (ly:make-moment 60/100)) % 40% slowdown
 169 #(define ac:pocoRallFactor (ly:make-moment 90/100)) % 10% slowdown
 170
 171 % The absolute time for a twiddle in a trill, in minutes.
 172 % Start with 1/4 seconds == 1/240 minutes
 173 #(define ac:maxTwiddleTime (ly:make-moment 1/240))
 174
 175 % How long ordinary grace notes should be relative to their notated
 176 % duration.  9/40 is LilyPond's built-in behaviour for MIDI output
 177 % (though the notation reference says 1/4).
 178 #(define ac:defaultGraceFactor 9/40)
 179
 180 % What proportion of an ordinary grace note's time should be stolen
 181 % from preceding notes (as opposed to stealing from the principal note).
 182 % Composers' intentions for this vary.  Taking all from the preceding
 183 % notes is LilyPond's built-in behaviour for MIDI output.
 184 #(define ac:defaultGraceBackwardness 1)
 185
 186
 187 % Internal variables, don't touch.
 188 % (should probably be part of a context somehow)
 189
 190 % Whether to slur, or not
 191 #(define ac:inSlur #f)
 192 #(define ac:inPhrasingSlur #f)
 193
 194 % Whether the current noteevent is in a trill spanner
 195 #(define ac:inTrill #f)
 196
 197 % assume start in C major.  Key change events override this.
 198 % Could get from context, but don't know how.
 199 #(define ac:current-key (make-music
 200           'KeyChangeEvent
 201           'tonic
 202           (ly:make-pitch -1 0 0)
 203           'pitch-alist
 204           (list (cons 0 0)
 205                 (cons 1 0)
 206                 (cons 2 0)
 207                 (cons 3 0)
 208                 (cons 4 0)
 209                 (cons 5 0)
 210                 (cons 6 0))))
 211
 212
 213 #(define ac:currentTempo (ly:make-moment 15/1)) % 4 = 60, measured wholes per minute
 214 #(define ac:lastTempo ac:currentTempo) % for 'a tempo' or 'tempo I'
 215
 216 % The duration of the current note.  Start at a crotchet
 217 % for no good reason.
 218 #(define ac:currentDuration (ly:make-duration 2 0 1/1))
 219
 220 % Amount of musical time (in whole notes) that we need to steal from the
 221 % next events seen.
 222 #(define ac:stealForward 0)
 223
 224 % List of events in the output so far, in reverse order, from which we can
 225 % steal time.
 226 #(define ac:eventsBackward '())
 227
 228 % Log events for the backward chain.
 229 #(define (ac:logEventsBackward music)
 230   (music-map
 231    (lambda (m)
 232     (case (ly:music-property m 'name)
 233      ((EventChord)
 234       (set! ac:eventsBackward (cons m ac:eventsBackward))
 235       m)
 236      ((BarCheck SkipMusic)
 237       (let ((wm (make-sequential-music (list m))))
 238        (set! ac:eventsBackward (cons wm ac:eventsBackward))
 239        wm))
 240      (else
 241       m)))
 242    music))
 243
 244 % Steal time from the backward chain.  Adds to ac:stealForward (with a
 245 % warning) if it couldn't backward-steal all that was desired.
 246 #(define (ac:stealTimeBackward tosteal)
 247   (if (<= tosteal 0)
 248    #t
 249    (if (null? ac:eventsBackward)
 250     (begin
 251      (ly:warning (_ "articulation failed to steal ~a note backward at beginning of music; stealing forward instead") tosteal)
 252      (set! ac:stealForward (+ ac:stealForward tosteal)))
 253     (let*
 254      ((lastev (car ac:eventsBackward))
 255       (levlen (ly:moment-main (ly:music-length lastev))))
 256      (if (< tosteal levlen)
 257       (begin
 258        (ly:music-compress lastev (ly:make-moment (/ (- levlen tosteal) levlen)))
 259        #t)
 260       (begin
 261        (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 262                 (ly:music-property lastev 'elements))
 263         (ly:warning (_ "stealing the entirety of a note's time")))
 264        (set! (ly:music-property lastev 'elements) '())
 265        (set! ac:eventsBackward (cdr ac:eventsBackward))
 266        (ac:stealTimeBackward (- tosteal levlen))))))))
 267
 268 % Debugging: display a moment plus some text.
 269 % Returns its moment argument so can be used in-line.
 270 #(define (display-moment  text m)
 271   (display text)
 272   (display (list (ly:moment-main-numerator m) "/" (ly:moment-main-denominator m)))
 273   m
 274 )
 275
 276 % Track tempo (and maybe later, other context properties)
 277 % as they change.  Needs to better cope with saving only Tempo I,
 278 % otherwise "a tempo" goes back to the tempo before the last change.
 279 #(define (ac:adjust-props sym music)
 280   (case sym
 281    ((tempoWholesPerMinute)
 282     (set! ac:currentTempo (ly:music-property music 'value))
 283     (set! ac:lastTempo ac:currentTempo)
 284   )))
 285
 286 % Raise note one step in the current diatonic scale.
 287 #(define (ac:up note)
 288   (let* ((pitch (ly:music-property note 'pitch))
 289          (notename (ly:pitch-notename pitch))
 290          (new-notename (if (eqv? notename 6) 0 (+ 1 notename)))
 291          (alterations (ly:music-property ac:current-key 'pitch-alist))
 292          (new-alteration (cdr (assq new-notename alterations)))
 293          (new-octave (if (eqv? new-notename 0) (+ 1 (ly:pitch-octave pitch))
 294                       (ly:pitch-octave pitch)))
 295        )
 296    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 297
 298
 299 % Lower note one step in the current diatonic scale.
 300 #(define (ac:down note)
 301   (begin  (let* ((pitch (ly:music-property note 'pitch))
 302          (notename (ly:pitch-notename pitch))
 303          (new-notename (if (eqv? notename 0) 6 (- notename 1)))
 304          (alterations (ly:music-property ac:current-key 'pitch-alist))
 305          (new-alteration (cdr (assq new-notename alterations)))
 306          (new-octave (if (eqv? new-notename 6) (- (ly:pitch-octave pitch) 1)
 307                       (ly:pitch-octave pitch)))
 308        )
 309    (set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
 310 )
 311
 312 % Shorten a note, and save the note's original duration in ac:currentDuration
 313 #(define (ac:articulate-one-note m fraction)
 314   "Replace m with m*fraction"
 315   (if  (eq? 'NoteEvent (ly:music-property m 'name))
 316    (let*
 317     ((dur (ly:music-property m 'duration))
 318      (l (ly:duration-log dur))
 319      (d (ly:duration-dot-count dur))
 320      (factor (ly:duration-factor dur))
 321      (num (car fraction))
 322      (denom (cdr fraction)))
 323     (begin
 324      (set! ac:currentDuration dur)
 325      (set! (ly:music-property m 'duration)
 326       (ly:make-duration l d
 327        (* num (car factor))
 328        (* denom (cdr factor))))))
 329    m))
 330
 331 % helper routine to set duration.
 332 #(define (ac:setduration music duration)
 333   "Set a note's duration."
 334   (let ((eventtype (ly:music-property music 'name)))
 335    (if
 336     (or
 337      (eq? eventtype 'NoteEvent)
 338      (eq? eventtype 'RestEvent)
 339      (eq? eventtype 'SkipEvent))
 340     (set! (ly:music-property music 'duration) duration))))
 341
 342 % Add an articulation event to a note.
 343 % Used in afterGrace to mark all notes as tenuto, so they're not shortened
 344 #(define (ac:add-articulation type music)
 345     (music-map (lambda (m)
 346                 (if (eq? 'EventChord (ly:music-property m 'name))
 347                  (set! (ly:music-property m 'elements)
 348                   (append (ly:music-property m 'elements)
 349                    (list (make-music 'ArticulationEvent 'articulation-type type)))))
 350                 m)
 351      music))
 352
 353 % Convert a long note to an equivalent set of short notes, tied together.
 354 % This is needed to get smooth dynamics changes.
 355 % Need to deal properly with stuff other than the notes (dynamics, markup etc)
 356 % Still experimental, so disabled for now.
 357 #(define (ac:to128 music) music)
 358
 359 #(define (ac:to128_disabled music)
 360   (if (or (eq? 'SkipEvent (ly:music-property music 'name))
 361         (eq? 'NoteEvent (ly:music-property music 'name)))
 362    (let* ((dur (ly:music-property music 'duration))
 363           (log2 (ly:duration-log dur))
 364          (shiftcount (- 6 log2))
 365          (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
 366    (set! (ly:music-property music 'elements)
 367     (cons (make-music 'TieEvent) (ly:music-property music 'elements)))
 368    (make-sequential-music (list
 369                            (make-repeat "unfold" (1- (expt 2 shiftcount))
 370                             (make-sequential-music (list music)) '())
 371                            lastm)))
 372  music))
 373
 374
 375 % absolute time in minutes of a length of music, as a rational number (moment)
 376 #(define (ac:abstime music)
 377   (ly:moment-div (ly:music-length music) ac:currentTempo))
 378
 379 % convert absolute time (in minutes) to a moment in the current tempo
 380 #(define (ac:abs->mom m)
 381   (ly:moment-mul m ac:currentTempo))
 382
 383
 384 % a moment that is ac:maxTwiddletime seconds at the current tempo.
 385 #(define (ac:targetTwiddleTime)
 386   (ac:abs->mom ac:maxTwiddleTime))
 387
 388
 389 % Nearest twiddletime (in minutes) achievable with power-of-2 divisions of
 390 % the original music.  (twiddletime is the time for one pair of notes
 391 % in a trill)
 392 % If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
 393 #(define (ac:twiddletime music)
 394   (let* ((tr (filter (lambda (x)
 395                      (and (eq? 'ArticulationEvent (ly:music-property x 'name))
 396                       (string= "trill" (ly:music-property x 'articulation-type))))
 397               (ly:music-property music 'elements)))
 398          (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
 399                  '()))
 400          (hemisemimom (ly:make-moment 1/64))
 401          (t (ac:targetTwiddleTime)))
 402    (if (ly:moment? pre-t)
 403     pre-t
 404     hemisemimom)))
 405
 406
 407
 408 % Note: I'm assuming early music practice of starting on the auxiliary note.
 409 % Needs to add gruppetto if it's a long trill (TODO)
 410 #(define (ac:trill music)
 411   " Replace music with time-compressed repeats of the music,
 412     maybe accelerating if the length is longer than a crotchet "
 413   (let* ((hemisemidur (ly:make-duration 5 0 1/1))
 414          (orig-len  (ly:music-length music))
 415          (t (ac:twiddletime music))
 416          (uppernote '())
 417          (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
 418          (c1 (ly:moment-div orig-len t))
 419          (c2 (inexact->exact
 420               (round (/ (ly:moment-main-numerator c1)
 421                       (* 2 (ly:moment-main-denominator c1))))))
 422          (count (if (< c2 2) 2 c2)))
 423
 424    (set! (ly:music-property music 'elements)
 425     (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
 426      (ly:music-property music 'elements)))
 427    (map (lambda (y) (ac:setduration y hemisemidur))
 428     (ly:music-property music 'elements))
 429    (set! uppernote (ly:music-deep-copy music))
 430    (map ac:up
 431     (filter
 432      (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 433      (ly:music-property uppernote 'elements)))
 434
 435    (let* ((trillMusicElements
 436           (let loop ((so_far (list uppernote music))
 437                      (c count))
 438            (if (> c 1)
 439             (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
 440             so_far)))
 441           (trillMusic (make-sequential-music trillMusicElements))
 442           (newlen (ly:music-length trillMusic))
 443           (factor (ly:moment-div  orig-len newlen)))
 444     (ly:music-compress trillMusic factor)
 445 ; accelerating the music seems to put lily into an infinite loop in
 446 ; its layout and midi engines.
 447 ;    (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
 448 ;          (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
 449 ;                   1024)))
 450 ;     (ac:accel trillMusic factor))
 451  )))
 452
 453
 454 % Copy music and strip articulations, ties, etc., for generating
 455 % mordents etc.
 456 #(define (ac:note-copy music)
 457   "return a copy of music that is only notes, no articulations, ties, slurs etc"
 458   (let ((new-music (ly:music-deep-copy music)))
 459    (set! (ly:music-property new-music 'articulations) '())
 460    (set! (ly:music-property new-music 'elements)
 461     (filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
 462      (ly:music-property new-music 'elements)))
 463    new-music))
 464
 465 %
 466 % Generate a tempoChangeEvent and its associated property setting.
 467 %
 468 #(define (ac:tempoChange tempo)
 469   (make-sequential-music
 470    (list (make-music 'TempoChangeEvent
 471           'metronome-count
 472           tempo
 473           'tempo-unit
 474           (ly:make-duration 0 0 1/1))
 475     (context-spec-music
 476     (make-property-set 'tempoWholesPerMinute  tempo) 'Score))))
 477
 478 %
 479 % Totally unfold repeats, so that the non-obvious sequencing doesn't
 480 % confuse us.  This is necessary for time stealing to work, because
 481 % that relies on the sequence in which we see events matching their
 482 % audible sequence.  Also unfold multi-measure rests to equivalent
 483 % skips, with preceding and following bar checks, so that time stealing
 484 % can change the length of the pause without falling foul of the
 485 % implicit bar checks.
 486 %
 487 #(define (ac:unfoldMusic music)
 488   (music-map
 489    (lambda (m)
 490     (case (ly:music-property m 'name)
 491      ((UnfoldedRepeatedMusic)
 492       (let
 493        ((body (ly:music-property m 'element))
 494         (altl (ly:music-property m 'elements))
 495         (rc (ly:music-property m 'repeat-count)))
 496        (if (null? altl)
 497         (make-sequential-music
 498          (list-tabulate rc (lambda (i) (ly:music-deep-copy body))))
 499         (let ((ealtl (if (> (length altl) rc) (take altl rc) altl)))
 500          (make-sequential-music
 501           (apply append!
 502            (append!
 503             (list-tabulate
 504              (- rc (length ealtl))
 505              (lambda (i) (list (ly:music-deep-copy body) (ly:music-deep-copy (car ealtl)))))
 506             (map (lambda (alt) (list (ly:music-deep-copy body) alt)) ealtl))))))))
 507      ((EventChord)
 508       (let-values
 509        (((trem evl)
 510          (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
 511           (ly:music-property m 'elements))))
 512        (if (null? trem)
 513         m
 514         (let*
 515          ((tremtype (ly:music-property (car trem) 'tremolo-type))
 516           (tremtype-log (1- (integer-length tremtype)))
 517           (durev (find (lambda (v) (not (null? (ly:music-property v 'duration)))) evl))
 518           (totaldur (if durev (ly:music-property durev 'duration) (ly:make-duration tremtype-log 0 1)))
 519           (tgt-nrep (/ (duration-visual-length totaldur) (duration-log-factor tremtype-log)))
 520           (eff-nrep (max (truncate tgt-nrep) 1))
 521           (tremdur (ly:make-duration tremtype-log 0
 522                     (* (/ tgt-nrep eff-nrep) (ly:duration-scale totaldur)))))
 523          (or (and (= eff-nrep tgt-nrep) (= (ash 1 tremtype-log) tremtype))
 524           (ly:warning (_ "non-integer tremolo ~a:~a")
 525            (duration->lily-string (duration-visual totaldur) #:force-duration #t #:time-scale 1)
 526            tremtype))
 527          (for-each
 528           (lambda (v)
 529            (or (null? (ly:music-property v 'duration))
 530             (set! (ly:music-property v 'duration) tremdur)))
 531           evl)
 532          (set! (ly:music-property m 'elements) evl)
 533          (make-sequential-music
 534           (list-tabulate eff-nrep (lambda (i) (ly:music-deep-copy m))))))))
 535      ((MultiMeasureRestMusic)
 536       (make-sequential-music
 537        (list
 538         (make-music 'BarCheck)
 539         (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
 540         (make-music 'BarCheck))))
 541      (else
 542       m)))
 543    (unfold-repeats '() music)))
 544
 545 % If there's an articulation, use it.
 546 % If in a slur, use (1 . 1) instead (unless the note is marked staccato,
 547 % in which case use ac:portatoFactor).
 548 % Treat phrasing slurs as slurs, but allow explicit articulation.
 549 %
 550 % Expect an EventChord.
 551 %
 552 % trills, turns, ornaments etc.  are also treated as Articulations.
 553 % Split into two functions:
 554 %  ac:getactions traverses the elements in the EventChord
 555 %               and calculates the parameters.
 556 %  ac:articulate-chord applies the actions to each NoteEvent in
 557 %               the EventChord.
 558 #(define (ac:getactions music)
 559   (let ((at-end-of-slur #f))
 560    (let  loop ((factor ac:normalFactor)
 561                (newelements '())
 562                (es (ly:music-property music 'elements))
 563                (actions '()))
 564     (if (null? es)
 565      (begin
 566       (set! (ly:music-property music 'elements) (reverse newelements))
 567       (if
 568        (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
 569                  newelements))
 570        actions
 571        (append
 572         (let ((st ac:stealForward))
 573          (if (= st 0)
 574           '()
 575           (begin
 576            (set! ac:stealForward 0)
 577            (list 'steal st))))
 578         actions
 579         (cond
 580          (ac:inTrill '(trill))
 581          ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
 582           (list 'articulation  '(1 . 1)))
 583          ((and (eq? factor ac:staccatoFactor) (or ac:inSlur at-end-of-slur))
 584           (list 'articulation ac:portatoFactor))
 585          (else (list 'articulation  factor))))))
 586      ; else part
 587      (let ((e (car es))
 588            (tail (cdr es)))
 589       (case (ly:music-property e 'name)
 590
 591        ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
 592         (loop factor newelements tail actions))
 593
 594        ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
 595         (loop (cons 1 1) (cons e newelements) tail actions))
 596
 597        ((ArticulationEvent)
 598         (let ((articname (ly:music-property e 'articulation-type)))
 599          ; TODO: add more here
 600          (cond
 601           ((string= articname "staccato")
 602            (loop ac:staccatoFactor newelements tail actions))
 603           ((string= articname "staccatissimo")
 604            (loop ac:staccatissimoFactor newelements tail actions))
 605           ((string= articname "portato")
 606            (loop ac:portatoFactor newelements tail actions))
 607           ((string= articname "tenuto")
 608            (loop ac:tenutoFactor newelements tail actions))
 609           ((string= articname "mordent")
 610            (loop (cons 1 1) newelements tail (cons 'mordent actions)))
 611           ((string= articname "prall")
 612            (loop (cons 1 1) newelements tail (cons 'prall actions)))
 613           ((string= articname "trill")
 614            (loop (cons 1 1) newelements tail (cons 'trill actions)))
 615           ((string= articname "turn")
 616            (loop (cons 1 1) newelements tail (cons 'turn actions)))
 617           (else (loop factor (cons e newelements) tail actions)))))
 618
 619        ((TextScriptEvent)
 620         (let ((t (ly:music-property e 'text)))
 621          (if (not (string? t))
 622           (loop factor (cons e newelements) tail actions)
 623           (begin
 624            (cond
 625             ((or
 626               (string= t "rall")
 627               (string= t "Rall")
 628               (string= t "rit.")
 629               (string= t "rall."))
 630              (loop factor (cons e newelements) tail (cons 'rall actions)))
 631             ((or
 632               (string= t "accelerando")
 633               (string= t "accel")
 634               (string= t "accel."))
 635              (loop factor (cons e newelements) tail (cons 'accel actions)))
 636             ((or
 637               (string= t "poco accel."))
 638              (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
 639             ((or
 640               (string= t "poco rall.")
 641               (string= t "poco rit."))
 642              (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
 643             ((or (string= t "a tempo")
 644               (string= t "tempo I"))
 645            (loop factor (cons e newelements) tail (cons 'aTempo actions)))
 646             (else (loop factor (cons e newelements) tail actions)))))))
 647
 648        ((SlurEvent)
 649         (let ((direction (ly:music-property e 'span-direction)))
 650          (set! ac:inSlur (eqv? direction -1))
 651          (set! at-end-of-slur (eqv? direction 1))
 652          (loop factor newelements tail actions)))
 653
 654        ((TrillSpanEvent)
 655         (let ((direction (ly:music-property e 'span-direction)))
 656          (set! ac:inTrill (eqv? direction -1))
 657          (if ac:inTrill
 658           (loop factor newelements tail (cons 'trill actions))
 659           (loop factor (cons e newelements) tail actions))))
 660
 661        ((PhrasingSlurEvent)
 662         (let ((direction (ly:music-property e 'span-direction)))
 663          (set! ac:inPhrasingSlur (eqv? direction -1))
 664          (loop factor newelements tail actions)))
 665
 666        (else (loop factor (cons e newelements) tail actions))))))))
 667
 668
 669
 670 #(define (ac:articulate-chord music)
 671   (cond
 672    ((eq? 'EventChord (ly:music-property music 'name))
 673     (ac:logEventsBackward
 674      (let loop ((actions (ac:getactions music)))
 675       (if (null? actions)
 676         (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
 677          (ac:to128  music)
 678          music)
 679
 680       (case (car actions)
 681
 682        ((articulation)
 683         (map
 684          (lambda (x) (ac:articulate-one-note x (cadr actions)))
 685          (ly:music-property music 'elements))
 686         (let*
 687          ((num (caadr actions))
 688           (denom (cdadr actions))
 689           (mult (ly:duration-factor ac:currentDuration))
 690           (newnum (* (- denom num) (car mult)))
 691           (newdenom (* (cdr mult) denom))
 692           (len (ly:duration-log ac:currentDuration))
 693           (dots (ly:duration-dot-count ac:currentDuration)))
 694
 695          (if (not (eqv? num denom))
 696           (make-sequential-music
 697            (list (ac:to128 music)
 698            (make-music 'EventChord 'elements
 699             (list
 700              (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
 701           music)))
 702
 703        ((accel)
 704         (set! ac:lastTempo ac:currentTempo)
 705         (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
 706         (let ((pset (ac:tempoChange ac:currentTempo)))
 707          (if (null? (cdr actions))
 708           (make-sequential-music (list pset music))
 709           (make-sequential-music
 710            (list pset (loop (cdr actions)))))))
 711
 712        ((pocoAccel)
 713         (set! ac:lastTempo ac:currentTempo)
 714         (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
 715         (let ((pset (ac:tempoChange ac:currentTempo)))
 716          (if (null? (cdr actions))
 717           (make-sequential-music (list pset music))
 718           (make-sequential-music
 719            (list pset (loop (cdr actions)))))))
 720
 721        ((rall)
 722         (set! ac:lastTempo ac:currentTempo)
 723         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
 724         (let ((pset (ac:tempoChange ac:currentTempo)))
 725          (if (null? (cdr actions))
 726           (make-sequential-music (list pset music))
 727           (make-sequential-music
 728            (list pset (loop (cdr actions)))))))
 729
 730        ((pocoRall)
 731         (set! ac:lastTempo ac:currentTempo)
 732         (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
 733         (let ((pset (ac:tempoChange ac:currentTempo)))
 734          (if (null? (cdr actions))
 735           (make-sequential-music (list pset music))
 736           (make-sequential-music
 737            (list pset (loop (cdr actions)))))))
 738
 739        ((aTempo)
 740         (set! ac:currentTempo ac:lastTempo)
 741
 742         (let ((pset (ac:tempoChange ac:currentTempo)))
 743          (if (null? (cdr actions))
 744           (make-sequential-music (list pset music))
 745           (make-sequential-music
 746            (list pset (loop (cdr actions)))))))
 747
 748        ((trill)
 749          (ac:trill music))
 750
 751        ((prall)
 752         ; A pralltriller symbol can either mean an inverted mordent
 753         ; or a half-shake -- a short, two twiddle trill.
 754         ; We implement as a half-shake.
 755         (let*
 756          ((origlength (ly:music-length music))
 757           (gracedur (ly:make-duration 5 0 1/1))
 758           (gracenote (ac:note-copy music))
 759           (abovenote (ac:note-copy music))
 760           (abovenoteTwo (ac:note-copy music))
 761           (mainnote (ly:music-deep-copy music)))
 762
 763          (map (lambda (y) (ac:setduration y gracedur))
 764           (ly:music-property gracenote 'elements))
 765          (map (lambda (y) (ac:setduration y gracedur))
 766           (ly:music-property abovenote 'elements))
 767          (map (lambda (y) (ac:setduration y gracedur))
 768           (ly:music-property abovenoteTwo 'elements))
 769          (map ac:up
 770           (filter
 771            (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 772            (ly:music-property abovenote 'elements)))
 773          (map ac:up
 774           (filter
 775            (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 776            (ly:music-property abovenoteTwo 'elements)))
 777          (let* ((prallMusic (make-sequential-music
 778                               (list abovenote gracenote abovenoteTwo mainnote)))
 779                  (newlen (ly:music-length prallMusic))
 780                  (factor (ly:moment-div origlength newlen)))
 781            (ly:music-compress prallMusic factor))))
 782
 783        ((mordent)
 784         (let*
 785          ((origlength (ly:music-length music))
 786           (gracedur (ly:make-duration 5 0 1/1))
 787           (gracenote (ac:note-copy music))
 788           (belownote (ac:note-copy music)))
 789          (map (lambda (y) (ac:setduration y gracedur))
 790           (ly:music-property gracenote 'elements))
 791          (map (lambda (y) (ac:setduration y gracedur))
 792                (ly:music-property belownote 'elements))
 793          (map ac:down
 794           (filter
 795            (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 796            (ly:music-property belownote 'elements)))
 797
 798          (let* ((mordentMusic (make-sequential-music (list gracenote belownote music)))
 799                 (newlen (ly:music-length mordentMusic))
 800                 (factor (ly:moment-div origlength newlen)))
 801           (ly:music-compress mordentMusic factor))))
 802
 803        ((turn)
 804         (let*
 805          ((dur (ly:music-property
 806                 (car (ly:music-property music 'elements)) 'duration))
 807           (factor (ly:duration-factor dur))
 808           (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
 809                    (ly:duration-dot-count dur) (car factor)(cdr factor))))
 810          (begin
 811           (map (lambda (y) (ac:setduration y newdur))
 812            (ly:music-property music 'elements))
 813           (let* ((above (ly:music-deep-copy music))
 814                  (below (ly:music-deep-copy music))
 815                  (newmusic (make-sequential-music (list above music below music))))
 816            (begin
 817             (map ac:down
 818              (filter
 819               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 820               (ly:music-property below 'elements)))
 821             (map ac:up
 822              (filter
 823               (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 824               (ly:music-property above 'elements)))
 825             newmusic)))))
 826        ((steal)
 827         (let
 828          ((totallen (ly:moment-main (ly:music-length music)))
 829           (steallen (cadr actions)))
 830          (if (>= steallen totallen)
 831           (begin
 832            (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
 833                     (ly:music-property music 'elements))
 834             (ly:warning (_ "stealing the entirety of a note's time")))
 835            (set! ac:stealForward (- steallen totallen))
 836            (make-sequential-music '()))
 837           (begin
 838            (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
 839            (loop (cddr actions))))))
 840      )))))
 841
 842    ((eq? 'GraceMusic (ly:music-property music 'name))
 843     (let
 844      ((first-ev
 845        (call-with-current-continuation
 846         (lambda (yield-fev)
 847          (music-map
 848           (lambda (m)
 849            (if (eq? 'EventChord (ly:music-property m 'name))
 850             (yield-fev m)
 851             m))
 852           music)
 853          #f))))
 854      (if first-ev
 855       (let ((fev-pos (find-tail (lambda (m) (eq? m first-ev)) ac:eventsBackward)))
 856        (if fev-pos
 857         (set! ac:eventsBackward (cdr fev-pos))
 858         (ly:warning (_ "articulation of grace notes has gone awry"))))))
 859     (let*
 860      ((gmus (ly:music-compress (ly:music-property music 'element)
 861                                (ly:make-moment ac:defaultGraceFactor)))
 862       (glen (ly:moment-main (ly:music-length gmus))))
 863      (ac:stealTimeBackward (* glen ac:defaultGraceBackwardness))
 864      (set! ac:stealForward (+ ac:stealForward (* glen (- 1 ac:defaultGraceBackwardness))))
 865      gmus))
 866
 867    ((memq (ly:music-property music 'name) '(BarCheck SkipMusic))
 868     (let ((totallen (ly:moment-main (ly:music-length music)))
 869           (steallen ac:stealForward))
 870      (cond
 871       ((= steallen 0)
 872        (ac:logEventsBackward music))
 873       ((< steallen totallen)
 874        (set! ac:stealForward 0)
 875        (ac:logEventsBackward
 876         (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))))
 877       (else
 878        (set! ac:stealForward (- steallen totallen))
 879        (make-sequential-music '())))))
 880
 881    ((eq? 'KeyChangeEvent (ly:music-property music 'name))
 882     (set! ac:current-key music)
 883     music)
 884
 885    ((eq? 'PropertySet (ly:music-property music 'name))
 886     (ac:adjust-props (ly:music-property music 'symbol) music)
 887     music)
 888
 889    (else music)))
 890
 891
 892
 893 % At last ... here's the music function that applies all the above to a
 894 % score.
 895 articulate = #(define-music-function (music)
 896                (ly:music?)
 897                "Adjust times of note to add tenuto, staccato and
 898                 normal articulations.
 899                 "
 900                (dynamic-wind
 901                 (lambda ()
 902                  (set! ac:stealForward 0)
 903                  (set! ac:eventsBackward '()))
 904                 (lambda ()
 905                  (music-map
 906                   ac:articulate-chord
 907                   (ac:startup-replacements music)))
 908                 (lambda ()
 909                  (or (= ac:stealForward 0)
 910                   (begin
 911                    (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
 912                    (set! ac:stealForward 0)))
 913                  (set! ac:eventsBackward '()))))
 914
 915 #(define (ac:startup-replacements music)
 916    (fold (lambda (f m) (f m))
 917          music
 918          (list
 919           event-chord-wrap!
 920           ac:replace-aftergrace
 921           ac:replace-appoggiatura
 922           ac:unfoldMusic)))
 923
 924 #(define (ac:replace-aftergrace music)
 925    (map-some-music
 926     (lambda (expr)
 927       (with-music-match
 928        (expr (music 'SimultaneousMusic
 929                     elements (?before-grace
 930                               (music 'SequentialMusic
 931                                      elements ((music 'SkipMusic)
 932                                                (music 'GraceMusic
 933                                                       element ?grace))))))
 934        (ac:aftergrace ?before-grace ?grace)))
 935     music))
 936
 937 #(define (ac:replace-appoggiatura music)
 938    ;; appoggiature are ugly to deal with since they require a main
 939    ;; note following them.  We only try dealing with this followership
 940    ;; in sequential music
 941    (map-some-music
 942     (lambda (m)
 943       (if (eq? 'SequentialMusic (ly:music-property m 'name))
 944           (pair-for-each
 945            (lambda (elts)
 946              (let ((expr (car elts))
 947                    (main (and (pair? (cdr elts)) (cadr elts))))
 948                (and main
 949                     ;;stolen from define-music-display-methods
 950                     (with-music-match
 951                      (expr (music
 952                             'GraceMusic
 953                             element (music
 954                                      'SequentialMusic
 955                                      elements (?start
 956                                                ?music
 957                                                ?stop))))
 958                      ;; we check whether ?start and ?stop look like
 959                      ;; startAppoggiaturaMusic stopAppoggiaturaMusic
 960                      (and (with-music-match (?start (music
 961                                                      'SequentialMusic
 962                                                      elements ((music
 963                                                                 'EventChord
 964                                                                 elements
 965                                                                 ((music
 966                                                                   'SlurEvent
 967                                                                   span-direction START))))))
 968                                             #t)
 969                           (with-music-match (?stop (music
 970                                                     'SequentialMusic
 971                                                     elements ((music
 972                                                                'EventChord
 973                                                                elements
 974                                                                ((music
 975                                                                  'SlurEvent
 976                                                                  span-direction STOP))))))
 977                                             #t)
 978                           (let* ((app (ac:appoggiatura ?music main))
 979                                  (apps (ly:music-property app 'elements)))
 980                             (set-car! elts (car apps))
 981                             (set-car! (cdr elts) (cadr apps))
 982                             #f))))))
 983            (ly:music-property m 'elements)))
 984       #f)
 985     music))
 986
 987 % Override \afterGrace to be in terms of audio, not spacing.
 988 % Special handling for a gruppetto after a trill.
 989 #(define (ac:aftergrace main grace)
 990   (let*
 991    ((main-length (ly:music-length main))
 992     (grace-orig-length (ly:music-length grace))
 993     (gracelen (ac:twiddletime main))
 994     (grace-factor (ly:moment-div gracelen grace-orig-length))
 995     (new-main-length (ly:moment-sub main-length gracelen))
 996     (factor (ly:moment-div new-main-length main-length))
 997   )
 998    (map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
 999          (filter (lambda (z)
1000                   (and
1001                    (eq? 'ArticulationEvent (ly:music-property z 'name))
1002                    (string= "trill" (ly:music-property z 'articulation-type))))
1003           (ly:music-property main 'elements)))
1004    (ac:add-articulation "tenuto" grace)
1005    (make-sequential-music  (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
1006
1007 % An appoggiatura takes half the duration of the main note,
1008 % or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
1009 % Somewhere around the end of the 19th, start of 20th century the rules
1010 % changed, but my main interest is early music.
1011 #(define (ac:appoggiatura grace main)
1012   (let* ((maindur (ly:music-length main))
1013          (grace-orig-len (ly:music-length grace))
1014          (main-orig-len (ly:music-length main))
1015          (numerator (ly:moment-main-numerator maindur))
1016          (factor (if (eqv? (remainder numerator 3) 0)
1017                   (ly:make-moment 1/3) (ly:make-moment 1/2))))
1018    (ly:music-compress grace
1019     (ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
1020    (ly:music-compress main (ly:moment-sub (ly:make-moment 1/1) factor))
1021
1022     (set! (ly:music-property grace 'elements)
1023      (append (ly:music-property grace 'elements)
1024       (list (make-music 'SlurEvent 'span-direction -1))))
1025     (set! (ly:music-property main 'elements)
1026      (append (ly:music-property main 'elements)
1027       (list (make-music 'SlurEvent 'span-direction 1))))
1028      (make-sequential-music (list grace main))))