X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=ly%2Farticulate.ly;h=0414bd926b89418e9a5d966de31fe81e2ef24b54;hb=23bb09401ef1d8c5f5256b8f7a6c002365b1d88c;hp=5b7ab7234f3c2671c8b3721c64e87e21a5cc039d;hpb=958e95822083954cad00e0a598eb9f12ceba67b9;p=lilypond.git diff --git a/ly/articulate.ly b/ly/articulate.ly index 5b7ab7234f..0414bd926b 100644 --- a/ly/articulate.ly +++ b/ly/articulate.ly @@ -29,10 +29,10 @@ % 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'. @@ -41,20 +41,28 @@ % Manual for a more detailed list of supported items. %%% Technical Details: -% * Any note not under a slur or phrasing mark, and not marked with an -% explicit articulation, is shortened by ac:normalFactor (default 7/8) -% * Any note marked staccato is shortened by ac:staccatoFactor. -% (default 1/2). -% * Any note marked tenuto gets its full value. -% * 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). +% * 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) +% * Appoggiaturas 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. +% 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. +% make accel. and stringendo and so on work too. % %%%USAGE @@ -92,7 +100,6 @@ % * 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)) @@ -108,6 +115,13 @@ % * 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 @@ -135,6 +149,10 @@ % 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)) @@ -523,9 +541,9 @@ (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. % @@ -536,108 +554,114 @@ % ac:articulate-chord applies the actions to each NoteEvent in % 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 + (append + (let ((st ac:stealForward)) + (if (= st 0) + '() + (begin + (set! ac:stealForward 0) + (list 'steal st)))) + actions (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))))))) + (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)))))))) @@ -878,7 +902,7 @@ articulate = #(define-music-function (music) (lambda () (music-map ac:articulate-chord - (ac:unfoldMusic (event-chord-wrap! music (*parser*))))) + (ac:startup-replacements music))) (lambda () (or (= ac:stealForward 0) (begin @@ -886,16 +910,81 @@ articulate = #(define-music-function (music) (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 - (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)) @@ -917,11 +1006,7 @@ afterGrace = % 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 (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)) @@ -939,4 +1024,3 @@ appoggiatura = (append (ly:music-property main 'elements) (list (make-music 'SlurEvent 'span-direction 1)))) (make-sequential-music (list grace main)))) -