Ok, I played with it a bit more. I still don't like the relative hack,
but I think the code below is slightly cleaner.
#(define (nondestructive-music-map fn mus)
(music-map fn (ly:music-deep-copy mus)))
#(define (create-note pitch duration)
(make-music 'NoteEvent
'duration duration
'pitch pitch))
#(define (make-chord chord-pitches chordevent)
(let* ((skip (car (ly:music-property chordevent 'elements)))
(rest (cdr (ly:music-property chordevent 'elements)))
(duration (ly:music-property skip 'duration)))
(if (eq? (ly:music-property skip 'name) 'SkipEvent)
(make-music 'EventChord
'elements (append
(map (lambda (x) (create-note x duration))
(pick-pitches chord-pitches))
rest))
chordevent)))
#(define (apply-chord mus pitches)
(if (eq? (ly:music-property mus 'name) 'EventChord)
(make-chord pitches mus)
mus))
% Returns two pitches from the input:
% <The original pitch(es)>
% <The pitch(es) in octave '-1'>
% This makes the function work in \relative sections.
% A flag is included to mark which marks if the first pitches need to be used or
% not.
#(define (get-pitches mus)
(let* ((p (map
(lambda (x) (ly:music-property x 'pitch))
(ly:music-property mus 'elements)))
(first-p (car p))
(pitch (ly:pitch-notename first-p))
(alteration (ly:pitch-alteration first-p))
(octave -1)
(px (ly:make-pitch octave pitch alteration)))
(list #t p (cons px (cdr p)))))
% Return the first set of pitches if the flag is true else return the second
% set. Always set the flag to false before returning.
#(define (pick-pitches pitches)
(let* ((first (car pitches))
(native-octave (cadr pitches))
(relative-octave (caddr pitches))
(return (if first native-octave relative-octave)))
(set-car! pitches #f)
return))
#(define (rhythm-template template)
(define-music-function (parser location mus) (ly:music?)
(let ((pitches (get-pitches mus)))
(nondestructive-music-map (lambda (mus) (apply-chord mus
pitches)) template))))
%Example usage:
%These methods should only be used within a \relative section.
rhya = #(rhythm-template #{s8.-> s16 s8#} )
rhyb = #(rhythm-template #{s8[ r16 s16 s8]#} )
rhyc = #(rhythm-template #{s16 s~ s4#} )
rhyd = #(rhythm-template #{ \times 2/3 { s8 s8 s8 } s4 s4 s8 s8 s4 #} )
rhye = #(rhythm-template #{ \times 2/3 { s8---\pp s8-- s8-- } s4--
s4-- s8-- s8-- s4-- #} )
rhyf = #(rhythm-template #{ \times 2/3 { s4 \times 2/3 { s8 s-> s } s4 } #} )
\score
{
\new Staff \relative c'
{
\time 6/8
\rhya c \rhyb c' |
\rhya <c, e> \rhyb <c f> |
\rhyc <c e> \rhyc <c d> |
\time 5/4
\rhyd c
\rhyd e
\rhye <c e g>
\time 4/4
\rhyf c \rhyf d
}
}
_______________________________________________
lilypond-user mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/lilypond-user
