Correction:
Murphy's law. Still looks okay to me, but (sigh!) just the error message
for ill-formed duration strings missed the "not" in "not a valid duration".
Cheers,
Alexander
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% applyRhythm
%%
%% 2009, Alexander Kobel (www.a-kobel.de)
%%
%% This program is free software. It comes without any warranty, to
%% the extent permitted by applicable law. You can redistribute it
%% and/or modify it under the terms of the Do What The Fuck You Want
%% To Public License, Version 2, as published by Sam Hocevar. See
%% http://sam.zoy.org/wtfpl/COPYING for more details.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% inspired by: http://lsr.dsi.unimi.it/LSR/Item?id=390
%% Thanks to the unknown contributor!
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Version 1.1
%%
%% Changes to http://lsr.dsi.unimi.it/LSR/Item?id=390:
%%
%% - \makeRhythm => \applyRhythm
%% - reversed order of arguments for \applyRhythm
%% - name changes in the backend (no more camel case, e.g.)
%% - checking well-formedness of duration strings
%% - support *num/den arguments
%% - support rests and skips
%% - support additional (arbitrary) whitespace in the rhythm string
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% This should also work with older version,
%% probably up to <= 2.10.
%% Please report if this is the case.
\version "2.12.2"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parsing single duration strings, like "4..*2/3"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(use-modules (ice-9 regex))
#(define duration-string-pattern "^[0-9]+\\.*(\\*[0-9]+)?(/[0-9]+)?$")
#(define (string->duration str)
(if (not (string-match duration-string-pattern str))
(begin
(display (string-append "warning: `" str "' does not denote a
valid duration. "
"Using `128...*256'
instead.")
(current-error-port))
(ly:make-duration 7 3 256 1))
(let* (
(dot-index (string-index str #\.))
(nom-index (string-index str #\*))
(den-index (string-index str #\/))
(end-of-nom (or den-index (string-length str)))
(end-of-dots (or nom-index end-of-nom))
(end-of-length (or dot-index end-of-dots))
(length (ly:intlog2 (string->number (substring str 0
end-of-length))))
(dot-count (if dot-index
(- end-of-dots
dot-index)
0))
(nom (if nom-index
;; get rid of the "*"
(string->number (substring str (1+
nom-index) end-of-nom))
1))
(den (if den-index
;; get rid of the "/"
(string->number (substring str (1+
den-index) (string-length str)))
1)))
(ly:make-duration length dot-count nom den))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Parsing rhythm strings, like "4. 8 4 8.*8/9 16*4/3"
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (string->duration-vector rhythm)
(let ((duration-string-list (string-tokenize rhythm)))
(list->vector (map string->duration duration-string-list))))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Replace the duration of a chord by a duration
%% given as a specific element of a vector of durations
%%
%% Only apply to certain types of events (in particular,
%% not to multi measure rests)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (replace-chord-duration chord duration-vector index)
(begin
(if (or
(eq? 'NoteEvent (ly:music-property chord 'name))
(eq? 'RestEvent (ly:music-property chord 'name))
(eq? 'SkipEvent (ly:music-property chord 'name))
)
(set! (ly:music-property chord 'duration) (vector-ref
duration-vector index)))
chord))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Apply the rhythm scheme of duration-vector at index
%% if music is a chord event; do nothing otherwise
%% Returns:
%% The transformed event and the index of the next duration
%% in the rhythm vector
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define (replace-event-duration event duration-vector index)
(begin
(if (eq? 'EventChord (ly:music-property event 'name))
(begin
(map (lambda (chord) (replace-chord-duration chord
duration-vector index))
(ly:music-property event 'elements))
(set! index (modulo (1+ index) (vector-length
duration-vector)))))
(cons event index)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% The end-user function:
%% Apply rhythm (given as string) to music.
%%
%% If music has more chords than rhythm has entries,
%% repeat the rhythm as often as necessary.
%%
%% Example usage:
%% \applyRhythm "4 8 8 4 8.*8/9 16*4/3" { c d e f g a | a g f e d c }
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
applyRhythm =
#(define-music-function (parser location rhythm music) (string? ly:music?)
(let (
(duration-vector (string->duration-vector rhythm))
(index 0)
)
(music-map
(lambda (event)
(let ((result (replace-event-duration event duration-vector
index)))
(begin
(set! index (cdr result))
(car result))))
music)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% Test
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
applyRhythmTestCaseString = "
4... 32
8. 16 8.*8/9 16*4/3 "
applyRhythmTestCase = \new Score {
<<
\new Staff \applyRhythm \applyRhythmTestCaseString \relative c'
{ <c e> c <c e> c c c | R1 | c r r c r c }
\new Staff \repeat unfold 3 { \repeat unfold 4 \times 2/3 {
c''8 c'' c'' } \break }
>>
}
%% \score { \applyRhythmTestCase }
_______________________________________________
lilypond-user mailing list
lilypond-user@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-user