% replacing notes with sequential music of suitably time-scaled note plus
% skip.
%
-% It also tries to unfold trills turns etc., and take rallentendo
-% and accelerando into account.
+% Trills, turns, mordents and pralls are expanded with rallentendo
+% and accelerando taken into account.
%
% As my scheme knowledge is poor (I was teaching myself as I went), there
% is much scope for improvement.
+% See: http://nicta.com.au/people/chubbp/articulate for additional
+% information about how the articulate function works.
+
+%%% Supported items:
+% Articulations on a single note (staccato, staccatissimo, portato, tenuto).
+% Slurs and phrasing slurs.
+% Ornaments (i.e. mordents, trills, turns).
+% Rallentando, accelerando, ritard and 'a tempo'.
+%
+% Please refer to 'MIDI output' (Section 3.5) in the Notation Reference
+% Manual for a more detailed list of supported items.
+
+%%% Technical Details:
+% * Any note not under a slur or phrasing slur, and not marked with an
+% explicit articulation, is shortened by ac:normalFactor (default 7/8).
+% (Shortening a note means replacing the note with a note of a smaller
+% duration, and a rest to make up for the difference between the durations
+% of the original and the shortened note.)
+% * Notes marked with articulations are shortened by factors specific to the
+% articulation as follows:
+% staccato not under a slur: ac:staccatoFactor (default 1/2)
+% under a slur: ac:portatoFactor (default 3/4)
+% staccatissimo ac:staccatissimoFactor (default 1/4)
+% portato ac:portatoFactor (default 3/4)
+% tenuto ac:tenutoFactor (default 1/1 - by default, notes marked
+% tenuto are not shortened)
+% * Appogiaturas are made to take half the value of the note following,
+% without taking dots into account (so in \appoggiatura c8 d2. the c
+% will take the time of a crotchet).
+% * Trills and turns are expanded. The algorithm tries to choose notes
+% within the time of the current tempo that lead to each twiddle being
+% around 1/8 seconds; this can be adjusted with the ac:maxTwiddleTime
+% variable.
+% * Rall, poco rall and a tempo are observed. It'd be fairly trivial to
+% make accel. and stringendo and so on work too.
+
%
%%%USAGE
% In the \score section do:
% \articulate <<
-% all the rest of the score
+% all the rest of the score
% >>
% or use the lilywrap script.
%
-% TO DO (prioritised, the ones that'll make the most difference first)
+% TO DO:
%
% * Dynamics.
% * Fix quantisation for dynamics on single note (replace note
% * Cope with more ornaments/articulations.
% inverted-turns, etc.
% -- accent needs better control of dynamics.
-% -- Articulations: mezzo-staccato, portato.
% -- Handling of generic ornaments (in lily, `\stopped'; in
-% most early music: ornament this note (trill, turn
-% or mordent as the player wishes))
+% most early music: ornament this note (trill, turn
+% or mordent as the player wishes))
+
% * Automatic gruppetto at end of trill; better handling of
% initial/final grace notes on trill
+
% * Automatic ornaments.
% * Spot cadences and ornament
% * Look for quaver-dotted note for trills, for example.
% * accidentals for trills and turns
% CHANGELOG
+% * Heikki Tauriainen: handle also the \portato articulation (both as an
+% explicit articulation, and as the articulation to use for slurred
+% notes marked \staccato).
+% * David Kastrup: remove redefinitions of \afterGrace and \appoggiatura
+% and let their actions be performed when \articulate is called by
+% recognizing and replacing LilyPond's default code for these constructs.
+% Cf issue 4517 in LilyPond's tracker.
% * David Kastrup: basic 2.15.28 compatibility by using event-chord-wrap!
% This should really be done by rewriting the code more thoroughly.
% * From Iain Nicol: appoggiatura timings were out; add staccatissimo; fix
% * Add Mordents (reported by Patrick Karl)
%
-\version "2.17.11"
+\version "2.19.22"
#(use-modules (srfi srfi-1))
#(use-modules (srfi srfi-11))
% How much to compress notes marked staccatissimo.
#(define ac:staccatissimoFactor '(1 . 4))
+% Shortening factor for notes marked portato (or slurred notes marked
+% staccato).
+#(define ac:portatoFactor '(3 . 4))
+
% And tenuto (if we ever implement time stealing, this should be >1.0)
#(define ac:tenutoFactor '(1 . 1))
#t)
(begin
(if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property lastev 'elements))
- (ly:warning (_ "stealing the entirety of a note's time")))
+ (ly:music-property lastev 'elements))
+ (ly:warning (_ "stealing the entirety of a note's time")))
(set! (ly:music-property lastev 'elements) '())
(set! ac:eventsBackward (cdr ac:eventsBackward))
(ac:stealTimeBackward (- tosteal levlen))))))))
% Raise note one step in the current diatonic scale.
#(define (ac:up note)
(let* ((pitch (ly:music-property note 'pitch))
- (notename (ly:pitch-notename pitch))
- (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
- (alterations (ly:music-property ac:current-key 'pitch-alist))
- (new-alteration (cdr (assq new-notename alterations)))
- (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
- (ly:pitch-octave pitch)))
+ (notename (ly:pitch-notename pitch))
+ (new-notename (if (eq? notename 6) 0 (+ 1 notename)))
+ (alterations (ly:music-property ac:current-key 'pitch-alist))
+ (new-alteration (cdr (assq new-notename alterations)))
+ (new-octave (if (eq? new-notename 0) (+ 1 (ly:pitch-octave pitch))
+ (ly:pitch-octave pitch)))
)
(set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
% Lower note one step in the current diatonic scale.
#(define (ac:down note)
(begin (let* ((pitch (ly:music-property note 'pitch))
- (notename (ly:pitch-notename pitch))
- (new-notename (if (eq? notename 0) 6 (- notename 1)))
- (alterations (ly:music-property ac:current-key 'pitch-alist))
- (new-alteration (cdr (assq new-notename alterations)))
- (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
- (ly:pitch-octave pitch)))
+ (notename (ly:pitch-notename pitch))
+ (new-notename (if (eq? notename 0) 6 (- notename 1)))
+ (alterations (ly:music-property ac:current-key 'pitch-alist))
+ (new-alteration (cdr (assq new-notename alterations)))
+ (new-octave (if (eq? new-notename 6) (- (ly:pitch-octave pitch) 1)
+ (ly:pitch-octave pitch)))
)
(set! (ly:music-property note 'pitch)(ly:make-pitch new-octave new-notename new-alteration))))
)
% Used in afterGrace to mark all notes as tenuto, so they're not shortened
#(define (ac:add-articulation type music)
(music-map (lambda (m)
- (if (eq? 'EventChord (ly:music-property m 'name))
- (set! (ly:music-property m 'elements)
- (append (ly:music-property m 'elements)
- (list (make-music 'ArticulationEvent 'articulation-type type)))))
- m)
+ (if (eq? 'EventChord (ly:music-property m 'name))
+ (set! (ly:music-property m 'elements)
+ (append (ly:music-property m 'elements)
+ (list (make-music 'ArticulationEvent 'articulation-type type)))))
+ m)
music))
% Convert a long note to an equivalent set of short notes, tied together.
#(define (ac:to128_disabled music)
(if (or (eq? 'SkipEvent (ly:music-property music 'name))
- (eq? 'NoteEvent (ly:music-property music 'name)))
+ (eq? 'NoteEvent (ly:music-property music 'name)))
(let* ((dur (ly:music-property music 'duration))
- (log2 (ly:duration-log dur))
- (shiftcount (- 6 log2))
- (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
+ (log2 (ly:duration-log dur))
+ (shiftcount (- 6 log2))
+ (lastm (ly:music-deep-copy (shift-duration-log music shiftcount 0))))
(set! (ly:music-property music 'elements)
(cons (make-music 'TieEvent) (ly:music-property music 'elements)))
(make-sequential-music (list
- (make-repeat "unfold" (1- (expt 2 shiftcount))
- (make-sequential-music (list music)) '())
- lastm)))
+ (make-repeat "unfold" (1- (expt 2 shiftcount))
+ (make-sequential-music (list music)) '())
+ lastm)))
music))
% If the music has a precomputed twiddletime (e.g., from \afterGrace) use that.
#(define (ac:twiddletime music)
(let* ((tr (filter (lambda (x)
- (and (eq? 'ArticulationEvent (ly:music-property x 'name))
- (string= "trill" (ly:music-property x 'articulation-type))))
- (ly:music-property music 'elements)))
- (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
- '()))
- (hemisemidur (ly:make-duration 5 0 1/1))
- (t (ac:targetTwiddleTime)))
+ (and (eq? 'ArticulationEvent (ly:music-property x 'name))
+ (string= "trill" (ly:music-property x 'articulation-type))))
+ (ly:music-property music 'elements)))
+ (pre-t (if (pair? tr) (ly:music-property (car tr) 'twiddle)
+ '()))
+ (hemisemimom (ly:make-moment 1/64))
+ (t (ac:targetTwiddleTime)))
(if (ly:moment? pre-t)
pre-t
- hemisemidur)))
+ hemisemimom)))
" Replace music with time-compressed repeats of the music,
maybe accelerating if the length is longer than a crotchet "
(let* ((hemisemidur (ly:make-duration 5 0 1/1))
- (orig-len (ly:music-length music))
- (t (ac:twiddletime music))
- (uppernote '())
- (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
- (c1 (ly:moment-div orig-len t))
- (c2 (inexact->exact
- (round (/ (ly:moment-main-numerator c1)
- (* 2 (ly:moment-main-denominator c1))))))
- (count (if (< c2 2) 2 c2)))
+ (orig-len (ly:music-length music))
+ (t (ac:twiddletime music))
+ (uppernote '())
+ (note_moment (ly:moment-mul t (ly:make-moment 1/2)))
+ (c1 (ly:moment-div orig-len t))
+ (c2 (inexact->exact
+ (round (/ (ly:moment-main-numerator c1)
+ (* 2 (ly:moment-main-denominator c1))))))
+ (count (if (< c2 2) 2 c2)))
(set! (ly:music-property music 'elements)
(filter (lambda (y) (eq? 'NoteEvent (ly:music-property y 'name)))
(ly:music-property uppernote 'elements)))
(let* ((trillMusicElements
- (let loop ((so_far (list uppernote music))
- (c count))
- (if (> c 1)
- (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
- so_far)))
- (trillMusic (make-sequential-music trillMusicElements))
- (newlen (ly:music-length trillMusic))
- (factor (ly:moment-div orig-len newlen)))
+ (let loop ((so_far (list uppernote music))
+ (c count))
+ (if (> c 1)
+ (loop (append (list (ly:music-deep-copy uppernote) (ly:music-deep-copy music)) so_far) (1- c))
+ so_far)))
+ (trillMusic (make-sequential-music trillMusicElements))
+ (newlen (ly:music-length trillMusic))
+ (factor (ly:moment-div orig-len newlen)))
(ly:music-compress trillMusic factor)
; accelerating the music seems to put lily into an infinite loop in
; its layout and midi engines.
; (let* ((realfactor (exp (* (/ 1.0 count) (log 0.75))))
-; (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
-; 1024)))
+; (factor (ly:make-moment (inexact->exact (round (* 1024 realfactor)))
+; 1024)))
; (ac:accel trillMusic factor))
)))
#(define (ac:tempoChange tempo)
(make-sequential-music
(list (make-music 'TempoChangeEvent
- 'metronome-count
- tempo
- 'tempo-unit
- (ly:make-duration 0 0 1/1))
+ 'metronome-count
+ tempo
+ 'tempo-unit
+ (ly:make-duration 0 0 1/1))
(context-spec-music
(make-property-set 'tempoWholesPerMinute tempo) 'Score))))
((UnfoldedRepeatedMusic)
(let
((body (ly:music-property m 'element))
- (altl (ly:music-property m 'elements))
- (rc (ly:music-property m 'repeat-count)))
+ (altl (ly:music-property m 'elements))
+ (rc (ly:music-property m 'repeat-count)))
(if (null? altl)
- (make-sequential-music
- (list-tabulate rc (lambda (i) (ly:music-deep-copy body))))
- (let ((ealtl (if (> (length altl) rc) (take altl rc) altl)))
- (make-sequential-music
- (apply append!
- (append!
- (list-tabulate
- (- rc (length ealtl))
- (lambda (i) (list (ly:music-deep-copy body) (ly:music-deep-copy (car ealtl)))))
- (map (lambda (alt) (list (ly:music-deep-copy body) alt)) ealtl))))))))
+ (make-sequential-music
+ (list-tabulate rc (lambda (i) (ly:music-deep-copy body))))
+ (let ((ealtl (if (> (length altl) rc) (take altl rc) altl)))
+ (make-sequential-music
+ (apply append!
+ (append!
+ (list-tabulate
+ (- rc (length ealtl))
+ (lambda (i) (list (ly:music-deep-copy body) (ly:music-deep-copy (car ealtl)))))
+ (map (lambda (alt) (list (ly:music-deep-copy body) alt)) ealtl))))))))
((EventChord)
(let-values
(((trem evl)
- (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
- (ly:music-property m 'elements))))
+ (partition (lambda (v) (eq? (ly:music-property v 'name) 'TremoloEvent))
+ (ly:music-property m 'elements))))
(if (null? trem)
- m
- (let*
- ((tremtype (ly:music-property (car trem) 'tremolo-type))
- (tremtype-log (1- (integer-length tremtype)))
- (durev (find (lambda (v) (not (null? (ly:music-property v 'duration)))) evl))
- (totaldur (if durev (ly:music-property durev 'duration) (ly:make-duration tremtype-log 0 1)))
- (tgt-nrep (/ (duration-visual-length totaldur) (duration-log-factor tremtype-log)))
- (eff-nrep (max (truncate tgt-nrep) 1))
- (tremdur (ly:make-duration tremtype-log 0
- (* (/ tgt-nrep eff-nrep) (ly:duration-scale totaldur)))))
- (or (and (= eff-nrep tgt-nrep) (= (ash 1 tremtype-log) tremtype))
- (ly:warning (_ "non-integer tremolo ~a:~a")
- (duration->lily-string (duration-visual totaldur) #:force-duration #t #:time-scale 1)
- tremtype))
- (for-each
- (lambda (v)
- (or (null? (ly:music-property v 'duration))
- (set! (ly:music-property v 'duration) tremdur)))
- evl)
- (set! (ly:music-property m 'elements) evl)
- (make-sequential-music
- (list-tabulate eff-nrep (lambda (i) (ly:music-deep-copy m))))))))
+ m
+ (let*
+ ((tremtype (ly:music-property (car trem) 'tremolo-type))
+ (tremtype-log (1- (integer-length tremtype)))
+ (durev (find (lambda (v) (not (null? (ly:music-property v 'duration)))) evl))
+ (totaldur (if durev (ly:music-property durev 'duration) (ly:make-duration tremtype-log 0 1)))
+ (tgt-nrep (/ (duration-visual-length totaldur) (duration-log-factor tremtype-log)))
+ (eff-nrep (max (truncate tgt-nrep) 1))
+ (tremdur (ly:make-duration tremtype-log 0
+ (* (/ tgt-nrep eff-nrep) (ly:duration-scale totaldur)))))
+ (or (and (= eff-nrep tgt-nrep) (= (ash 1 tremtype-log) tremtype))
+ (ly:warning (_ "non-integer tremolo ~a:~a")
+ (duration->lily-string (duration-visual totaldur) #:force-duration #t #:time-scale 1)
+ tremtype))
+ (for-each
+ (lambda (v)
+ (or (null? (ly:music-property v 'duration))
+ (set! (ly:music-property v 'duration) tremdur)))
+ evl)
+ (set! (ly:music-property m 'elements) evl)
+ (make-sequential-music
+ (list-tabulate eff-nrep (lambda (i) (ly:music-deep-copy m))))))))
((MultiMeasureRestMusic)
(make-sequential-music
(list
- (make-music 'BarCheck)
- (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
- (make-music 'BarCheck))))
+ (make-music 'BarCheck)
+ (make-music 'SkipMusic 'duration (ly:music-property m 'duration))
+ (make-music 'BarCheck))))
(else
m)))
(unfold-repeats music)))
% If there's an articulation, use it.
-% If in a slur, use (1 . 1) instead.
+% If in a slur, use (1 . 1) instead (unless the note is marked staccato,
+% in which case use ac:portatoFactor).
% Treat phrasing slurs as slurs, but allow explicit articulation.
-% (Maybe should treat staccato under a phrasing slur as mezzo-staccato?)
%
% Expect an EventChord.
%
% trills, turns, ornaments etc. are also treated as Articulations.
% Split into two functions:
% ac:getactions traverses the elements in the EventChord
-% and calculates the parameters.
+% and calculates the parameters.
% ac:articulate-chord applies the actions to each NoteEvent in
-% the EventChord.
+% the EventChord.
#(define (ac:getactions music)
- (let loop ((factor ac:normalFactor)
- (newelements '())
- (es (ly:music-property music 'elements))
- (actions '()))
- (if (null? es)
- (begin
- (set! (ly:music-property music 'elements) (reverse newelements))
- (if
- (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
- newelements))
- actions
- (append
- (let ((st ac:stealForward))
- (if (= st 0)
- '()
- (begin
- (set! ac:stealForward 0)
- (list 'steal st))))
+ (let ((at-end-of-slur #f))
+ (let loop ((factor ac:normalFactor)
+ (newelements '())
+ (es (ly:music-property music 'elements))
+ (actions '()))
+ (if (null? es)
+ (begin
+ (set! (ly:music-property music 'elements) (reverse newelements))
+ (if
+ (not (any (lambda (m) (music-is-of-type? m 'rhythmic-event))
+ newelements))
actions
- (cond
- (ac:inTrill '(trill))
- ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
- (list 'articulation '(1 . 1)))
- (else (list 'articulation factor))))))
- ; else part
- (let ((e (car es))
- (tail (cdr es)))
- (case (ly:music-property e 'name)
-
- ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
- (loop factor newelements tail actions))
-
- ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
- (loop (cons 1 1) (cons e newelements) tail actions))
-
- ((ArticulationEvent)
- (let ((articname (ly:music-property e 'articulation-type)))
- ; TODO: add more here
- (cond
- ((string= articname "staccato")
- (loop ac:staccatoFactor newelements tail actions))
- ((string= articname "staccatissimo")
- (loop ac:staccatissimoFactor newelements tail actions))
- ((string= articname "tenuto")
- (loop ac:tenutoFactor newelements tail actions))
- ((string= articname "mordent")
- (loop (cons 1 1) newelements tail (cons 'mordent actions)))
- ((string= articname "prall")
- (loop (cons 1 1) newelements tail (cons 'prall actions)))
- ((string= articname "trill")
- (loop (cons 1 1) newelements tail (cons 'trill actions)))
- ((string= articname "turn")
- (loop (cons 1 1) newelements tail (cons 'turn actions)))
- (else (loop factor (cons e newelements) tail actions)))))
-
- ((TextScriptEvent)
- (let ((t (ly:music-property e 'text)))
- (if (not (string? t))
- (loop factor (cons e newelements) tail actions)
- (begin
- (cond
- ((or
- (string= t "rall")
- (string= t "Rall")
- (string= t "rit.")
- (string= t "rall."))
- (loop factor (cons e newelements) tail (cons 'rall actions)))
- ((or
- (string= t "accelerando")
- (string= t "accel")
- (string= t "accel."))
- (loop factor (cons e newelements) tail (cons 'accel actions)))
- ((or
- (string= t "poco accel."))
- (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
- ((or
- (string= t "poco rall.")
- (string= t "poco rit."))
- (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
- ((or (string= t "a tempo")
- (string= t "tempo I"))
- (loop factor (cons e newelements) tail (cons 'aTempo actions)))
- (else (loop factor (cons e newelements) tail actions)))))))
-
- ((SlurEvent)
- (let ((direction (ly:music-property e 'span-direction)))
- (set! ac:inSlur (eq? direction -1))
- (loop factor newelements tail actions)))
-
- ((TrillSpanEvent)
- (let ((direction (ly:music-property e 'span-direction)))
- (set! ac:inTrill (eq? direction -1))
- (if ac:inTrill
- (loop factor newelements tail (cons 'trill actions))
- (loop factor (cons e newelements) tail actions))))
-
- ((PhrasingSlurEvent)
- (let ((direction (ly:music-property e 'span-direction)))
- (set! ac:inPhrasingSlur (eq? direction -1))
- (loop factor newelements tail actions)))
-
- (else (loop factor (cons e newelements) tail actions)))))))
+ (append
+ (let ((st ac:stealForward))
+ (if (= st 0)
+ '()
+ (begin
+ (set! ac:stealForward 0)
+ (list 'steal st))))
+ actions
+ (cond
+ (ac:inTrill '(trill))
+ ((and (eq? factor ac:normalFactor) (or ac:inSlur ac:inPhrasingSlur))
+ (list 'articulation '(1 . 1)))
+ ((and (eq? factor ac:staccatoFactor) (or ac:inSlur at-end-of-slur))
+ (list 'articulation ac:portatoFactor))
+ (else (list 'articulation factor))))))
+ ; else part
+ (let ((e (car es))
+ (tail (cdr es)))
+ (case (ly:music-property e 'name)
+
+ ((BeamEvent) ; throw away beam events, or they'll be duplicated by turn or trill
+ (loop factor newelements tail actions))
+
+ ((LineBreakEvent FingeringEvent MarkEvent BreathingEvent TieEvent SkipEvent RestEvent) ; pass through some events.
+ (loop (cons 1 1) (cons e newelements) tail actions))
+
+ ((ArticulationEvent)
+ (let ((articname (ly:music-property e 'articulation-type)))
+ ; TODO: add more here
+ (cond
+ ((string= articname "staccato")
+ (loop ac:staccatoFactor newelements tail actions))
+ ((string= articname "staccatissimo")
+ (loop ac:staccatissimoFactor newelements tail actions))
+ ((string= articname "portato")
+ (loop ac:portatoFactor newelements tail actions))
+ ((string= articname "tenuto")
+ (loop ac:tenutoFactor newelements tail actions))
+ ((string= articname "mordent")
+ (loop (cons 1 1) newelements tail (cons 'mordent actions)))
+ ((string= articname "prall")
+ (loop (cons 1 1) newelements tail (cons 'prall actions)))
+ ((string= articname "trill")
+ (loop (cons 1 1) newelements tail (cons 'trill actions)))
+ ((string= articname "turn")
+ (loop (cons 1 1) newelements tail (cons 'turn actions)))
+ (else (loop factor (cons e newelements) tail actions)))))
+
+ ((TextScriptEvent)
+ (let ((t (ly:music-property e 'text)))
+ (if (not (string? t))
+ (loop factor (cons e newelements) tail actions)
+ (begin
+ (cond
+ ((or
+ (string= t "rall")
+ (string= t "Rall")
+ (string= t "rit.")
+ (string= t "rall."))
+ (loop factor (cons e newelements) tail (cons 'rall actions)))
+ ((or
+ (string= t "accelerando")
+ (string= t "accel")
+ (string= t "accel."))
+ (loop factor (cons e newelements) tail (cons 'accel actions)))
+ ((or
+ (string= t "poco accel."))
+ (loop factor (cons e newelements) tail (cons 'pocoAccel actions)))
+ ((or
+ (string= t "poco rall.")
+ (string= t "poco rit."))
+ (loop factor (cons e newelements) tail (cons 'pocoRall actions)))
+ ((or (string= t "a tempo")
+ (string= t "tempo I"))
+ (loop factor (cons e newelements) tail (cons 'aTempo actions)))
+ (else (loop factor (cons e newelements) tail actions)))))))
+
+ ((SlurEvent)
+ (let ((direction (ly:music-property e 'span-direction)))
+ (set! ac:inSlur (eq? direction -1))
+ (set! at-end-of-slur (eq? direction 1))
+ (loop factor newelements tail actions)))
+
+ ((TrillSpanEvent)
+ (let ((direction (ly:music-property e 'span-direction)))
+ (set! ac:inTrill (eq? direction -1))
+ (if ac:inTrill
+ (loop factor newelements tail (cons 'trill actions))
+ (loop factor (cons e newelements) tail actions))))
+
+ ((PhrasingSlurEvent)
+ (let ((direction (ly:music-property e 'span-direction)))
+ (set! ac:inPhrasingSlur (eq? direction -1))
+ (loop factor newelements tail actions)))
+
+ (else (loop factor (cons e newelements) tail actions))))))))
(ac:logEventsBackward
(let loop ((actions (ac:getactions music)))
(if (null? actions)
- (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
- (ac:to128 music)
- music)
+ (if (ly:moment<? (ly:make-moment 1/4) (ly:music-length music))
+ (ac:to128 music)
+ music)
(case (car actions)
((articulation)
- (map
- (lambda (x) (ac:articulate-one-note x (cadr actions)))
- (ly:music-property music 'elements))
- (let*
- ((num (caadr actions))
- (denom (cdadr actions))
- (mult (ly:duration-factor ac:currentDuration))
- (newnum (* (- denom num) (car mult)))
- (newdenom (* (cdr mult) denom))
- (len (ly:duration-log ac:currentDuration))
- (dots (ly:duration-dot-count ac:currentDuration)))
-
- (if (not (eq? num denom))
- (make-sequential-music
- (list (ac:to128 music)
- (make-music 'EventChord 'elements
- (list
- (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
- music)))
+ (map
+ (lambda (x) (ac:articulate-one-note x (cadr actions)))
+ (ly:music-property music 'elements))
+ (let*
+ ((num (caadr actions))
+ (denom (cdadr actions))
+ (mult (ly:duration-factor ac:currentDuration))
+ (newnum (* (- denom num) (car mult)))
+ (newdenom (* (cdr mult) denom))
+ (len (ly:duration-log ac:currentDuration))
+ (dots (ly:duration-dot-count ac:currentDuration)))
+
+ (if (not (eq? num denom))
+ (make-sequential-music
+ (list (ac:to128 music)
+ (make-music 'EventChord 'elements
+ (list
+ (make-music 'RestEvent 'duration (ly:make-duration len dots newnum newdenom))))))
+ music)))
((accel)
- (set! ac:lastTempo ac:currentTempo)
- (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
- (let ((pset (ac:tempoChange ac:currentTempo)))
- (if (null? (cdr actions))
- (make-sequential-music (list pset music))
- (make-sequential-music
- (list pset (loop (cdr actions)))))))
+ (set! ac:lastTempo ac:currentTempo)
+ (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:rallFactor))
+ (let ((pset (ac:tempoChange ac:currentTempo)))
+ (if (null? (cdr actions))
+ (make-sequential-music (list pset music))
+ (make-sequential-music
+ (list pset (loop (cdr actions)))))))
((pocoAccel)
- (set! ac:lastTempo ac:currentTempo)
- (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
- (let ((pset (ac:tempoChange ac:currentTempo)))
- (if (null? (cdr actions))
- (make-sequential-music (list pset music))
- (make-sequential-music
- (list pset (loop (cdr actions)))))))
+ (set! ac:lastTempo ac:currentTempo)
+ (set! ac:currentTempo (ly:moment-div ac:currentTempo ac:pocoRallFactor))
+ (let ((pset (ac:tempoChange ac:currentTempo)))
+ (if (null? (cdr actions))
+ (make-sequential-music (list pset music))
+ (make-sequential-music
+ (list pset (loop (cdr actions)))))))
((rall)
- (set! ac:lastTempo ac:currentTempo)
- (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
- (let ((pset (ac:tempoChange ac:currentTempo)))
- (if (null? (cdr actions))
- (make-sequential-music (list pset music))
- (make-sequential-music
- (list pset (loop (cdr actions)))))))
+ (set! ac:lastTempo ac:currentTempo)
+ (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:rallFactor))
+ (let ((pset (ac:tempoChange ac:currentTempo)))
+ (if (null? (cdr actions))
+ (make-sequential-music (list pset music))
+ (make-sequential-music
+ (list pset (loop (cdr actions)))))))
((pocoRall)
- (set! ac:lastTempo ac:currentTempo)
- (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
- (let ((pset (ac:tempoChange ac:currentTempo)))
- (if (null? (cdr actions))
- (make-sequential-music (list pset music))
- (make-sequential-music
- (list pset (loop (cdr actions)))))))
+ (set! ac:lastTempo ac:currentTempo)
+ (set! ac:currentTempo (ly:moment-mul ac:currentTempo ac:pocoRallFactor))
+ (let ((pset (ac:tempoChange ac:currentTempo)))
+ (if (null? (cdr actions))
+ (make-sequential-music (list pset music))
+ (make-sequential-music
+ (list pset (loop (cdr actions)))))))
((aTempo)
- (set! ac:currentTempo ac:lastTempo)
+ (set! ac:currentTempo ac:lastTempo)
- (let ((pset (ac:tempoChange ac:currentTempo)))
- (if (null? (cdr actions))
- (make-sequential-music (list pset music))
- (make-sequential-music
- (list pset (loop (cdr actions)))))))
+ (let ((pset (ac:tempoChange ac:currentTempo)))
+ (if (null? (cdr actions))
+ (make-sequential-music (list pset music))
+ (make-sequential-music
+ (list pset (loop (cdr actions)))))))
((trill)
- (ac:trill music))
+ (ac:trill music))
((prall)
- ; A pralltriller symbol can either mean an inverted mordent
- ; or a half-shake -- a short, two twiddle trill.
- ; We implement as a half-shake.
- (let*
- ((origlength (ly:music-length music))
- (gracedur (ly:make-duration 5 0 1/1))
- (gracenote (ac:note-copy music))
- (abovenote (ac:note-copy music))
- (abovenoteTwo (ac:note-copy music))
- (mainnote (ly:music-deep-copy music)))
-
- (map (lambda (y) (ac:setduration y gracedur))
- (ly:music-property gracenote 'elements))
- (map (lambda (y) (ac:setduration y gracedur))
- (ly:music-property abovenote 'elements))
- (map (lambda (y) (ac:setduration y gracedur))
- (ly:music-property abovenoteTwo 'elements))
- (map (lambda (y) (ac:up y))
- (filter
- (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property abovenote 'elements)))
- (map (lambda (y) (ac:up y))
- (filter
- (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property abovenoteTwo 'elements)))
- (let* ((prallMusic (make-sequential-music
+ ; A pralltriller symbol can either mean an inverted mordent
+ ; or a half-shake -- a short, two twiddle trill.
+ ; We implement as a half-shake.
+ (let*
+ ((origlength (ly:music-length music))
+ (gracedur (ly:make-duration 5 0 1/1))
+ (gracenote (ac:note-copy music))
+ (abovenote (ac:note-copy music))
+ (abovenoteTwo (ac:note-copy music))
+ (mainnote (ly:music-deep-copy music)))
+
+ (map (lambda (y) (ac:setduration y gracedur))
+ (ly:music-property gracenote 'elements))
+ (map (lambda (y) (ac:setduration y gracedur))
+ (ly:music-property abovenote 'elements))
+ (map (lambda (y) (ac:setduration y gracedur))
+ (ly:music-property abovenoteTwo 'elements))
+ (map (lambda (y) (ac:up y))
+ (filter
+ (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property abovenote 'elements)))
+ (map (lambda (y) (ac:up y))
+ (filter
+ (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property abovenoteTwo 'elements)))
+ (let* ((prallMusic (make-sequential-music
(list abovenote gracenote abovenoteTwo mainnote)))
(newlen (ly:music-length prallMusic))
(factor (ly:moment-div origlength newlen)))
- (ly:music-compress prallMusic factor))))
+ (ly:music-compress prallMusic factor))))
((mordent)
- (let*
- ((origlength (ly:music-length music))
- (gracedur (ly:make-duration 5 0 1/1))
- (gracenote (ac:note-copy music))
- (belownote (ac:note-copy music)))
- (map (lambda (y) (ac:setduration y gracedur))
- (ly:music-property gracenote 'elements))
- (map (lambda (y) (ac:setduration y gracedur))
+ (let*
+ ((origlength (ly:music-length music))
+ (gracedur (ly:make-duration 5 0 1/1))
+ (gracenote (ac:note-copy music))
+ (belownote (ac:note-copy music)))
+ (map (lambda (y) (ac:setduration y gracedur))
+ (ly:music-property gracenote 'elements))
+ (map (lambda (y) (ac:setduration y gracedur))
(ly:music-property belownote 'elements))
- (map (lambda (y) (ac:down y))
- (filter
- (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property belownote 'elements)))
- (display belownote)
+ (map (lambda (y) (ac:down y))
+ (filter
+ (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property belownote 'elements)))
- (let* ((mordentMusic (make-sequential-music (list gracenote belownote music)))
- (newlen (ly:music-length mordentMusic))
- (factor (ly:moment-div origlength newlen)))
- (ly:music-compress mordentMusic factor))))
+ (let* ((mordentMusic (make-sequential-music (list gracenote belownote music)))
+ (newlen (ly:music-length mordentMusic))
+ (factor (ly:moment-div origlength newlen)))
+ (ly:music-compress mordentMusic factor))))
((turn)
- (let*
- ((dur (ly:music-property
- (car (ly:music-property music 'elements)) 'duration))
- (factor (ly:duration-factor dur))
- (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
- (ly:duration-dot-count dur) (car factor)(cdr factor))))
- (begin
- (map (lambda (y) (ac:setduration y newdur))
- (ly:music-property music 'elements))
- (let* ((above (ly:music-deep-copy music))
- (below (ly:music-deep-copy music))
- (newmusic (make-sequential-music (list above music below music))))
- (begin
- (map (lambda (y) (ac:down y))
- (filter
- (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property below 'elements)))
- (map (lambda (y) (ac:up y))
- (filter
- (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property above 'elements)))
- newmusic)))))
+ (let*
+ ((dur (ly:music-property
+ (car (ly:music-property music 'elements)) 'duration))
+ (factor (ly:duration-factor dur))
+ (newdur (ly:make-duration (+ (ly:duration-log dur) 2)
+ (ly:duration-dot-count dur) (car factor)(cdr factor))))
+ (begin
+ (map (lambda (y) (ac:setduration y newdur))
+ (ly:music-property music 'elements))
+ (let* ((above (ly:music-deep-copy music))
+ (below (ly:music-deep-copy music))
+ (newmusic (make-sequential-music (list above music below music))))
+ (begin
+ (map (lambda (y) (ac:down y))
+ (filter
+ (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property below 'elements)))
+ (map (lambda (y) (ac:up y))
+ (filter
+ (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property above 'elements)))
+ newmusic)))))
((steal)
- (let
- ((totallen (ly:moment-main (ly:music-length music)))
- (steallen (cadr actions)))
- (if (>= steallen totallen)
- (begin
- (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
- (ly:music-property music 'elements))
- (ly:warning (_ "stealing the entirety of a note's time")))
- (set! ac:stealForward (- steallen totallen))
- (make-sequential-music '()))
- (begin
- (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
- (loop (cddr actions))))))
+ (let
+ ((totallen (ly:moment-main (ly:music-length music)))
+ (steallen (cadr actions)))
+ (if (>= steallen totallen)
+ (begin
+ (if (any (lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
+ (ly:music-property music 'elements))
+ (ly:warning (_ "stealing the entirety of a note's time")))
+ (set! ac:stealForward (- steallen totallen))
+ (make-sequential-music '()))
+ (begin
+ (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))
+ (loop (cddr actions))))))
)))))
((eq? 'GraceMusic (ly:music-property music 'name))
(let
((first-ev
(call-with-current-continuation
- (lambda (yield-fev)
- (music-map
- (lambda (m)
- (if (eq? 'EventChord (ly:music-property m 'name))
- (yield-fev m)
- m))
- music)
- #f))))
+ (lambda (yield-fev)
+ (music-map
+ (lambda (m)
+ (if (eq? 'EventChord (ly:music-property m 'name))
+ (yield-fev m)
+ m))
+ music)
+ #f))))
(if first-ev
(let ((fev-pos (find-tail (lambda (m) (eq? m first-ev)) ac:eventsBackward)))
(if fev-pos
- (set! ac:eventsBackward (cdr fev-pos))
- (ly:warning (_ "articulation of grace notes has gone awry"))))))
+ (set! ac:eventsBackward (cdr fev-pos))
+ (ly:warning (_ "articulation of grace notes has gone awry"))))))
(let*
((gmus (ly:music-compress (ly:music-property music 'element)
- (ly:make-moment ac:defaultGraceFactor)))
+ (ly:make-moment ac:defaultGraceFactor)))
(glen (ly:moment-main (ly:music-length gmus))))
(ac:stealTimeBackward (* glen ac:defaultGraceBackwardness))
(set! ac:stealForward (+ ac:stealForward (* glen (- 1 ac:defaultGraceBackwardness))))
((memq (ly:music-property music 'name) '(BarCheck SkipMusic))
(let ((totallen (ly:moment-main (ly:music-length music)))
- (steallen ac:stealForward))
+ (steallen ac:stealForward))
(cond
((= steallen 0)
(ac:logEventsBackward music))
((< steallen totallen)
(set! ac:stealForward 0)
(ac:logEventsBackward
- (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))))
+ (ly:music-compress music (ly:make-moment (/ (- totallen steallen) totallen)))))
(else
(set! ac:stealForward (- steallen totallen))
(make-sequential-music '())))))
% At last ... here's the music function that applies all the above to a
% score.
-articulate = #(define-music-function (parser location music)
- (ly:music?)
- "Adjust times of note to add tenuto, staccato and
+articulate = #(define-music-function (music)
+ (ly:music?)
+ "Adjust times of note to add tenuto, staccato and
normal articulations.
- "
- (dynamic-wind
- (lambda ()
- (set! ac:stealForward 0)
- (set! ac:eventsBackward '()))
- (lambda ()
- (music-map
- ac:articulate-chord
- (ac:unfoldMusic (event-chord-wrap! music parser))))
- (lambda ()
- (or (= ac:stealForward 0)
- (begin
- (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
- (set! ac:stealForward 0)))
- (set! ac:eventsBackward '()))))
-
+ "
+ (dynamic-wind
+ (lambda ()
+ (set! ac:stealForward 0)
+ (set! ac:eventsBackward '()))
+ (lambda ()
+ (music-map
+ ac:articulate-chord
+ (ac:startup-replacements music)))
+ (lambda ()
+ (or (= ac:stealForward 0)
+ (begin
+ (ly:warning (_ "articulation failed to steal ~a note at end of music") ac:stealForward)
+ (set! ac:stealForward 0)))
+ (set! ac:eventsBackward '()))))
+
+#(define (ac:startup-replacements music)
+ (fold (lambda (f m) (f m))
+ music
+ (list
+ event-chord-wrap!
+ ac:replace-aftergrace
+ ac:replace-appoggiatura
+ ac:unfoldMusic)))
+
+#(define (ac:replace-aftergrace music)
+ (map-some-music
+ (lambda (expr)
+ (with-music-match
+ (expr (music 'SimultaneousMusic
+ elements (?before-grace
+ (music 'SequentialMusic
+ elements ((music 'SkipMusic)
+ (music 'GraceMusic
+ element ?grace))))))
+ (ac:aftergrace ?before-grace ?grace)))
+ music))
+
+#(define (ac:replace-appoggiatura music)
+ ;; appoggiature are ugly to deal with since they require a main
+ ;; note following them. We only try dealing with this followership
+ ;; in sequential music
+ (map-some-music
+ (lambda (m)
+ (if (eq? 'SequentialMusic (ly:music-property m 'name))
+ (pair-for-each
+ (lambda (elts)
+ (let ((expr (car elts))
+ (main (and (pair? (cdr elts)) (cadr elts))))
+ (and main
+ ;;stolen from define-music-display-methods
+ (with-music-match
+ (expr (music
+ 'GraceMusic
+ element (music
+ 'SequentialMusic
+ elements (?start
+ ?music
+ ?stop))))
+ ;; we check whether ?start and ?stop look like
+ ;; startAppoggiaturaMusic stopAppoggiaturaMusic
+ (and (with-music-match (?start (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction START))))))
+ #t)
+ (with-music-match (?stop (music
+ 'SequentialMusic
+ elements ((music
+ 'EventChord
+ elements
+ ((music
+ 'SlurEvent
+ span-direction STOP))))))
+ #t)
+ (let* ((app (ac:appoggiatura ?music main))
+ (apps (ly:music-property app 'elements)))
+ (set-car! elts (car apps))
+ (set-car! (cdr elts) (cadr apps))
+ #f))))))
+ (ly:music-property m 'elements)))
+ #f)
+ music))
% Override \afterGrace to be in terms of audio, not spacing.
% Special handling for a gruppetto after a trill.
-afterGrace =
-#(define-music-function
- (parser location main grace)
- (ly:music? ly:music?)
-
- (set! main (event-chord-wrap! main parser))
- (set! grace (event-chord-wrap! grace parser))
+#(define (ac:aftergrace main grace)
(let*
((main-length (ly:music-length main))
(grace-orig-length (ly:music-length grace))
(factor (ly:moment-div new-main-length main-length))
)
(map (lambda (y) (set! (ly:music-property y 'twiddle) gracelen))
- (filter (lambda (z)
- (and
- (eq? 'ArticulationEvent (ly:music-property z 'name))
- (string= "trill" (ly:music-property z 'articulation-type))))
- (ly:music-property main 'elements)))
+ (filter (lambda (z)
+ (and
+ (eq? 'ArticulationEvent (ly:music-property z 'name))
+ (string= "trill" (ly:music-property z 'articulation-type))))
+ (ly:music-property main 'elements)))
(ac:add-articulation "tenuto" grace)
(make-sequential-music (list (ly:music-compress main factor) (ly:music-compress grace grace-factor)))))
% or 1/3 if the note is dotted (i.e., half the undotted equivalent time)
% Somewhere around the end of the 19th, start of 20th century the rules
% changed, but my main interest is early music.
-appoggiatura =
-#(define-music-function (parser location grace main)
- (ly:music? ly:music?)
- (set! grace (event-chord-wrap! grace parser))
- (set! main (event-chord-wrap! main parser))
+#(define (ac:appoggiatura grace main)
(let* ((maindur (ly:music-length main))
- (grace-orig-len (ly:music-length grace))
- (main-orig-len (ly:music-length main))
- (numerator (ly:moment-main-numerator maindur))
- (factor (if (eq? (remainder numerator 3) 0)
- (ly:make-moment 1/3) (ly:make-moment 1/2))))
+ (grace-orig-len (ly:music-length grace))
+ (main-orig-len (ly:music-length main))
+ (numerator (ly:moment-main-numerator maindur))
+ (factor (if (eq? (remainder numerator 3) 0)
+ (ly:make-moment 1/3) (ly:make-moment 1/2))))
(ly:music-compress grace
(ly:moment-mul factor (ly:moment-div main-orig-len grace-orig-len)))
(ly:music-compress main (ly:moment-sub (ly:make-moment 1/1) factor))
(append (ly:music-property main 'elements)
(list (make-music 'SlurEvent 'span-direction 1))))
(make-sequential-music (list grace main))))
-