% 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'.
% 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
% * 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))
% * 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
% how to do lookahead in scheme.
% * Also ignore explicit line breaks.
% * Add Mordents (reported by Patrick Karl)
-%
+% * Thomas Morley: extend unfold-repeats to reflect the possibility to
+% customize its effect to user-settable repeat-types. Here the most general
+% setting is hard-coded, resulting in unchanged behaviour.
-\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))
#(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)))
+ (new-notename (if (eqv? 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))
+ (new-octave (if (eqv? 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))))
#(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)))
+ (new-notename (if (eqv? 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)
+ (new-octave (if (eqv? 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))))
(map (lambda (y) (ac:setduration y hemisemidur))
(ly:music-property music 'elements))
(set! uppernote (ly:music-deep-copy music))
- (map (lambda (y) (ac:up y))
+ (map ac:up
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property uppernote 'elements)))
(make-music 'BarCheck))))
(else
m)))
- (unfold-repeats music)))
+ (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.
%
% 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 (eqv? direction -1))
+ (set! at-end-of-slur (eqv? direction 1))
+ (loop factor newelements tail actions)))
+
+ ((TrillSpanEvent)
+ (let ((direction (ly:music-property e 'span-direction)))
+ (set! ac:inTrill (eqv? 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 (eqv? direction -1))
+ (loop factor newelements tail actions)))
+
+ (else (loop factor (cons e newelements) tail actions))))))))
(len (ly:duration-log ac:currentDuration))
(dots (ly:duration-dot-count ac:currentDuration)))
- (if (not (eq? num denom))
+ (if (not (eqv? num denom))
(make-sequential-music
(list (ac:to128 music)
(make-music 'EventChord 'elements
(ly:music-property abovenote 'elements))
(map (lambda (y) (ac:setduration y gracedur))
(ly:music-property abovenoteTwo 'elements))
- (map (lambda (y) (ac:up y))
+ (map ac:up
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property abovenote 'elements)))
- (map (lambda (y) (ac:up y))
+ (map ac:up
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property abovenoteTwo 'elements)))
(ly:music-property gracenote 'elements))
(map (lambda (y) (ac:setduration y gracedur))
(ly:music-property belownote 'elements))
- (map (lambda (y) (ac:down y))
+ (map ac:down
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property belownote 'elements)))
(below (ly:music-deep-copy music))
(newmusic (make-sequential-music (list above music below music))))
(begin
- (map (lambda (y) (ac:down y))
+ (map ac:down
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property below 'elements)))
- (map (lambda (y) (ac:up y))
+ (map ac:up
(filter
(lambda (z) (eq? 'NoteEvent (ly:music-property z 'name)))
(ly:music-property above 'elements)))
% At last ... here's the music function that applies all the above to a
% score.
-articulate = #(define-music-function (parser location music)
+articulate = #(define-music-function (music)
(ly:music?)
"Adjust times of note to add tenuto, staccato and
normal articulations.
(lambda ()
(music-map
ac:articulate-chord
- (ac:unfoldMusic (event-chord-wrap! music parser))))
+ (ac:startup-replacements music)))
(lambda ()
(or (= ac:stealForward 0)
(begin
(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))
% 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)
+ (factor (if (eqv? (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)))
(append (ly:music-property main 'elements)
(list (make-music 'SlurEvent 'span-direction 1))))
(make-sequential-music (list grace main))))
-
projects / lilypond.git / blobdiff