LSR/654
< LSR
 |
Der Inhalt dieser Seite wurde aus dem LilyPond Snippet Repository übernommen und steht unter folgender Lizenz: CC0. See Public Domain Help Pages for more info. | |
Beschreibung
This snippet describes a function \changePitch, to repeatedly print a given rhythm with different notes. Its syntax is \changePitch \pattern \newnotes. This will replace notes in \pattern by notes in \newnotes. If the note-count in \newnotes is greater, the pattern is copied repeatedly. Rests or skips are allowed, and the function also works for chords. More detailed documentation (in pdf format), and also the most recent "changePitch.ly" can be found here.
%% http://lsr.di.unimi.it/LSR/Item?id=654
%% see also http://lilypond.org/doc/v2.18/Documentation/notation/short-repeats
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% LSR workaround:
#(set! paper-alist (cons '("snippet" . (cons (* 150 mm) (* 75 mm))) paper-alist))
\paper {
#(set-paper-size "snippet")
tagline = ##f
indent = 0
}
\markup\vspace #.5
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% version 2013/05/11
%% for lilypond 2.18 or higher
%% last changes : - \changePitch : a single s as the last event of newnotes parameter
%% will give you the ending rests of the pattern (if there), and two s
%% also the beginning ones. If pattern ends with a note, a single
%% ending s will have no effects.
%% - Is now \language independant (no more #{ c #})
%% - new algorithm for make-notes-list, change-pitch
%% and has-notes? (shorter and safer)
%%
%%%%%%%%%%%%%%%%%%%%%%%%% some utility functions %%%%%%%%%%%%%%%%%%%%%
#(define (name-of music)
(ly:music-property music 'name))
#(define (has-notes? music)
"Return true if there is at least one note in `music, false otherwise."
(or (eq? (name-of music) 'NoteEvent)
(let ((e (ly:music-property music 'element)))
(and (ly:music? e)
(has-notes? e)))
(let loop ((es (ly:music-property music 'elements)))
(and (pair? es)
(or (has-notes? (car es))
(loop (cdr es)))))))
%% An EventChord is sometimes used as a wrapper in Lilypond, so we have to check
%% if a chord is a standard chord with notes. We could have used has-notes? but
%% this version is perhaps more efficient.
%% Optional events name like 'RestEvent can be included.
#(define (note-or-chord? music . otherEvent)
"Is music a note or a chord with notes ?"
(let ((name (name-of music)))
(or (memq name (cons 'NoteEvent otherEvent))
(and (eq? name 'EventChord) ; have this chord at least one note ?
(let loop ((es (ly:music-property music 'elements)))
(and (pair? es)
(or (eq? (name-of (car es)) 'NoteEvent)
(loop (cdr es)))))))))
#(define (expand-q-chords music); for q chords : see chord-repetition-init.ly
(expand-repeat-chords! (list 'rhythmic-event) music))
#(define (clean-music mus)
"Try to reduce the number of sequential music"
(let ((name (ly:music-property mus 'name)))
(cond
((eq? name 'SequentialMusic)
(ly:music-set-property! mus 'elements (fold-right
(lambda (evt prev-list)
(if (eq? (name-of evt) 'SequentialMusic)
(append (ly:music-property (clean-music evt) 'elements) prev-list)
(cons (clean-music evt) prev-list)))
'()
(ly:music-property mus 'elements))))
((eq? name 'SimultaneousMusic)
(ly:music-set-property! mus 'elements
(map clean-music (ly:music-property mus 'elements))))
((memq name (list 'RelativeOctaveMusic 'UnrelativableMusic))
(ly:music-set-property! mus 'element (clean-music
(ly:music-property mus 'element)))))
mus))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% changePitch %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define cPInsertInPattern (gensym))
#(define cPSamePitch (gensym))
#(define cPSamePitchEnd (gensym))
#(define cPPatternEnd (gensym))
#(define (make-notes-list music)
"Make a list with each element will be of one of these types :
1- a note, a chord, a rest
2- an integer, indicating the number of notes to skip in pattern ( The user will
indicate that, by a corresponding number of skips (s or \\skip) in `newnotes
parameter of \\changePitch )
3- a list of musics, to be inserted between 2 notes of pattern, and added with
the \\insert function, inside `newnotes"
(let ((res '()) ; the list to fill
(prev #f))
(define (fill-notes-list evt)
(let ((tags (ly:music-property evt 'tags))
(name (name-of evt)))
(cond
((memq cPInsertInPattern tags) ; a music added by \insert
(ly:music-set-property! evt 'tags
(delq cPInsertInPattern tags)) ; remove the tag
(if (integer? prev)(set! res (cons prev res)))
(set! prev (if (pair? prev)(cons evt prev)(list evt)))) ; a list
((memq name (list 'SkipEvent 'SkipMusic))
(if (pair? prev)(set! res (cons prev res))) ; keep the reverse order
(set! prev (if (integer? prev) (1+ prev) 1)))
; ((memq name (list 'EventChord 'NoteEvent 'RestEvent))
((note-or-chord? evt 'RestEvent) ; a note, a chord, or a rest
(if (or (pair? prev)(integer? prev))(set! res (cons prev res)))
(set! prev evt)
(set! res (cons evt res)))
(else
(let ((elt (ly:music-property evt 'element))
(elts (ly:music-property evt 'elements)))
(if (ly:music? elt) (fill-notes-list elt))
(if (pair? elts)(for-each fill-notes-list elts)))))))
(fill-notes-list music)
(if (or (pair? prev)(integer? prev))(set! res (cons prev res)))
(reverse res)))
%%%%%%%%%%%% used inside the inner function change-one-note
#(define (copy-duration from to) ; from and to as EventChord or NoteEvent
(let ((max-dur #f)); in theory, 2 notes in a chord can have a different duration
(music-map (lambda (x) ; get main duration from `from
(let ((dur (ly:music-property x 'duration)))
(if (and (ly:duration? dur)
(or (not max-dur)
(ly:duration<? max-dur dur))); take the greater
(set! max-dur dur))
x))
from)
(music-map (lambda (x) ; set duration to duration of `to
(if (ly:duration? (ly:music-property x 'duration))
(ly:music-set-property! x 'duration max-dur))
x)
to)))
#(define (copy-arti from to) ; from and to as EventChord or NoteEvent
(let* ((es-from (ly:music-property from 'elements))
(es-to (ly:music-property to 'elements))
(arti-from (if (null? es-from)
(ly:music-property from 'articulations)
(filter
(lambda(x)
(not (ly:duration? (ly:music-property x 'duration))))
es-from))))
(if (null? es-to) ; NoteEvent
(ly:music-set-property! to 'articulations
(append (ly:music-property to 'articulations) arti-from))
(ly:music-set-property! to 'elements ; EventChord
(append es-to arti-from)))
; copy also 'tags and 'to-relative-callback
(ly:music-set-property! to 'tags
(append (ly:music-property from 'tags)(ly:music-property to 'tags)))
(if (null? es-to)
(ly:music-set-property! to 'to-relative-callback
(ly:music-property from 'to-relative-callback))
(begin
(ly:music-set-property! to 'to-relative-callback
ly:music-sequence::event-chord-relative-callback)
(ly:music-set-property! (car es-to) 'to-relative-callback
(ly:music-property from 'to-relative-callback))))
))
%% del-arti is called for all notes but the first of a \samePitch section.
#(define (del-arti note-or-chord)
(ly:music-set-property! note-or-chord 'articulations '())
(ly:music-set-property! note-or-chord 'elements
(filter (lambda(x)
(and (ly:duration? (ly:music-property x 'duration))
(ly:music-set-property! x 'articulations '())))
(ly:music-property note-or-chord 'elements))) ; can be empty
(music-map ;; del all caution accidentals
(lambda(x)(if (eq? (name-of x) 'NoteEvent) (begin
(ly:music-set-property! x 'force-accidental #f)
(ly:music-set-property! x 'cautionary #f)))
x)
note-or-chord))
#(define (change-pitch pattern newnotes)
"The scheme function of \\changePitch, `pattern and `newnotes as music."
(let ((seq-list '()) ; list of transformed patterns
(skip-notnote-event? #f) ; #t if a \skip or an \insert is found in newnotes
(same-pitch-section? #f) ; #t if we are in the 2nd pattern note of a\samePitch section
;(dummy-note #{ c4 #}) ; \language dependant -:(
(dummy-note (make-music 'NoteEvent ; to avoid pbs with pattern without any notes
'duration (ly:make-duration 2 0 1) ;
'pitch (ly:make-pitch -1 0 0))) ;
(pattern2 #{ $pattern \tag #cPPatternEnd s4 #}) ; to detect the end of pattern
(last-notes-list #f)) ; buffer
(set! seq-list (cdr ; skip dummy notes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let loop ((notes-list (cons dummy-note (make-notes-list newnotes))); see make-notes-list
(pat-list (cons dummy-note (circular-list pattern2)))
(res '())) ; the list to fill
(if (or (null? notes-list)(null? pat-list)) ; pat-list may be a regular list in the loop
(reverse res) ;;;;;; return the list in the right order
(let ((x (car notes-list)) ;;;;;; go deeper, taking 1st elt of each lists
(evt (ly:music-deep-copy (car pat-list))))
(cond
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((pair? x) ; x is a list of musics, added with \insert in newnotes
(set! skip-notnote-event? #t) ; for events between 2 pattern notes
(set! last-notes-list notes-list) ; for section "else" of this cond statement
(loop (cdr notes-list) pat-list (append x res))) ; append x to res
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((note-or-chord? evt) ; evt in pattern is a note or a chord (with notes)
(set! last-notes-list notes-list) ; for section "else" later
(cond
((ly:music? x) ;;;;;; the elt of notes-list is a note or a chord
(if same-pitch-section? ; x is used several times. Copy arti of x only to the
(set! x (del-arti (ly:music-deep-copy x)))) ; 1st note of \samePitch section
(copy-duration evt x) ; evt = from, x = to
(copy-arti evt x)
(let ((tags (ly:music-property x 'tags)))
(cond ; are we in a \samePitch section ?
((memq cPSamePitch tags) ; yes, first,remove the tag
(ly:music-set-property! x 'tags (delq cPSamePitch tags))
(set! same-pitch-section? #t)) ; then set the flag
((memq cPSamePitchEnd tags) ; last note of \samePitch
(ly:music-set-property! x 'tags (delq cPSamePitchEnd tags))
(set! same-pitch-section? #f)))) ; unset the flag
(set! skip-notnote-event? #f); stop deletion of not-notes event.
(if same-pitch-section?
(loop notes-list (cdr pat-list)(cons x res))
(loop (cdr notes-list)(cdr pat-list)(cons x res)))) ; next new note
((integer? x) ;;;;;; user want to skip over the current evt note. We also
(set! skip-notnote-event? x) ; don't add any events bis next pattern note
;; (format #t "x : ~a\n" x) ; for testing
(cond ((= x 1) ; only one s
(loop (cdr notes-list)(cdr pat-list) res)) ; next notes-list elt
(else ; several successive s
(set-car! notes-list (1- x)) ; for the next loop
(loop notes-list (cdr pat-list) res)))))) ; the next evt only
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((or (ly:music-property evt 'duration #f) ; current evt in pattern is not a note
(not (has-notes? evt)))
(cond ((memq cPPatternEnd (ly:music-property evt 'tags)) ; last evt of pattern
(let ((x (car notes-list)))
(if (and (integer? x)
(or (null? (cdr notes-list)) ; last elt ?
(and (null? (cddr notes-list)) ; 2nd to last and last is
(pair? (car (cdr notes-list)))))) ; a \insert section
(cond
((= x 1)
(set! skip-notnote-event? x)
(loop (cdr notes-list) (cdr pat-list) res))
(else
(set-car! notes-list (1- x))
(loop notes-list (cdr pat-list) res))))
(loop notes-list (cdr pat-list) res))) ;; ignores evt
(skip-notnote-event? (loop notes-list (cdr pat-list) res))
(else (loop notes-list (cdr pat-list)(cons evt res)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(else
(let ((e (ly:music-property evt 'element))
(es (ly:music-property evt 'elements))
(empty? #f)) ; don't add to res if #t
(if (ly:music? e)
(let ((new-e (loop notes-list (list e) '())))
(ly:music-set-property! evt 'element
(case (length new-e)
((0) (set! empty? #t)
new-e)
((1)(car new-e))
(else (make-sequential-music new-e))))))
(if (pair? es)
(let ((new-es (loop notes-list es '())))
(ly:music-set-property! evt 'elements new-es)
(set! empty? (and empty? (null! new-es))))) ; #t if both empty
(let ((next-new-notes (if (or same-pitch-section?
(and (integer? skip-notnote-event?)
(> skip-notnote-event? 1)))
last-notes-list
(cdr last-notes-list))))
(if empty? (loop next-new-notes (cdr pat-list) res)
(loop next-new-notes (cdr pat-list) (cons evt res))))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ((relativize (lambda(m)
(let* ((clean-newnotes (clean-music newnotes))
(name (name-of clean-newnotes)))
(if (memq name (list 'RelativeOctaveMusic 'UnrelativableMusic))
(make-music name 'element m)
m)))))
(case (length seq-list)
((0) (make-music 'Music 'void #t))
((1) (relativize (car seq-list)))
(else (relativize (clean-music (make-sequential-music seq-list))))))))
changePitch = #(define-music-function (parser location pattern newnotes)
(ly:music? ly:music?)
"Change each notes in `pattern by the notes (or rests) given in `newnotes.
If count of events doesn't match, pattern is duplicated repeatedly or truncate."
(let* ((expand-q (lambda (music) (expand-repeat-chords!
(cons 'rhythmic-event (ly:parser-lookup parser '$chord-repeat-events))
music)))
(pattern (expand-q pattern))
(newnotes (expand-q newnotes)))
(change-pitch pattern newnotes)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% enhancement functions, working with \changePitch pattern newnotes
samePitch = #(define-music-function (parser location music) (ly:music?)
"Inside the `pattern parameter of the \\changePitch function, all notes grouped
by this function will have the same pitch, according to the current note of
`newnotes parameter of \\changePitch."
(let((not-first? #f)
(last-note #f))
(map-some-music
(lambda (x)
(cond
((note-or-chord? x)
(if not-first? ; set all pitches to the pitch of the first note
(ly:music-set-property! x 'to-relative-callback
(lambda (x p) ; set pitch to the prev value
(ly:prob-set-property! x 'pitch p)
p))
(set! not-first? x)) ; do nothing for first note
(ly:music-set-property! x 'tags (cons
cPSamePitch ; add tag cPSamePitch to x
(ly:music-property x 'tags)))
(set! last-note x) ; save the note x
x)
(else #f)))
music)
(if last-note ; the last saved EventChord
(ly:music-set-property! last-note 'tags (cons
cPSamePitchEnd ; add cPSamePitchEnd tag, delete cPSamePitch tag
(delq cPSamePitch (ly:music-property last-note 'tags)))))
music))
%% this function should be no more needed, as copy-arti should avoid pbs
%% in relative mode and \samePitch
absolute = #(define-music-function (parser location music) (ly:music?)
"Make `music unrelativable. To use inside a \\samePitch function in relative
mode."
(make-music 'UnrelativableMusic 'element music))
insert = #(define-music-function (parser location music) (ly:music?)
"Using this function inside the `newnotes parameter of the \\changePitch
function, allow you to insert and remplace by `music, all music between one note
and his following, in the `pattern parameter of \\changePitch, ."
#{ \tag #cPInsertInPattern $music #})
%%%%%%%
#(define (n-copy n music)
(cond
((> n 1)(make-sequential-music
(map (lambda (x)(ly:music-deep-copy music))
(make-list n))))
((= n 1) music)
(else (make-music 'Music 'void #t))))
nCopy = #(define-music-function (parser location n music)(integer? ly:music?)
(n-copy n music))
%% same effect as { \repeat unfold n s } but \nSkip works inside the `newnotes
%% parameter of \changePitch.
nSkip = #(define-music-function (parser location n)(integer?)
"Return \\skip \\skip \\skip ... n times."
#{ \nCopy #n s #})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% shortcuts
% default values for patI and patII, if the user do not define
% them, before using \cPI and \cPII
% patI ={ c8. c16 } % not \language independant
patI = #(make-music 'SequentialMusic 'elements (list
(make-music 'NoteEvent 'duration (ly:make-duration 3 1 1)
'pitch (ly:make-pitch -1 0 0))
(make-music 'NoteEvent 'duration (ly:make-duration 4 0 1)
'pitch (ly:make-pitch -1 0 0))))
% patII = { c4. c8 }
patII = #(make-music 'SequentialMusic 'elements (list
(make-music 'NoteEvent 'duration (ly:make-duration 2 1 1)
'pitch (ly:make-pitch -1 0 0))
(make-music 'NoteEvent 'duration (ly:make-duration 3 0 1)
'pitch (ly:make-pitch -1 0 0))))
cPI = #(define-music-function (parser location newnotes) (ly:music?)
#{ \changePitch \patI $newnotes #})
cPII = #(define-music-function (parser location newnotes) (ly:music?)
#{ \changePitch \patII $newnotes #})
#(define cP changePitch)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The example %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
testMusic = { c d e f g f e d <c e> <d f> <e g> <d f> }
fillerChord = { <c e>2 }
\relative c' {
\override Score.RehearsalMark.self-alignment-X = #LEFT
\mark "pattern = { c8.-> c16-. }"
\changePitch { c8.-> c16-. } {
\testMusic
}
\fillerChord
\break
\mark "pattern = { c8 c16( c) }"
\changePitch { c8 c16( c) } {
\testMusic
}
\fillerChord
\fillerChord
\break
\time 6/8
\mark "pattern = { c4( c8) c8.( c16) c8-. }"
\changePitch { c4( c8) c8.( c16) c8-. } {
\testMusic
}
<c e>4.
}
%% http://lsr.di.unimi.it/LSR/Item?id=654
%% see also http://lilypond.org/doc/v2.18/Documentation/notation/short-repeats
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% LSR workaround:
#(set! paper-alist (cons '("snippet" . (cons (* 150 mm) (* 75 mm))) paper-alist))
\paper {
#(set-paper-size "snippet")
tagline = ##f
indent = 0
}
\markup\vspace #.5
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% version 2013/05/11
%% for lilypond 2.18 or higher
%% last changes : - \changePitch : a single s as the last event of newnotes parameter
%% will give you the ending rests of the pattern (if there), and two s
%% also the beginning ones. If pattern ends with a note, a single
%% ending s will have no effects.
%% - Is now \language independant (no more #{ c #})
%% - new algorithm for make-notes-list, change-pitch
%% and has-notes? (shorter and safer)
%%
%%%%%%%%%%%%%%%%%%%%%%%%% some utility functions %%%%%%%%%%%%%%%%%%%%%
#(define (name-of music)
(ly:music-property music 'name))
#(define (has-notes? music)
"Return true if there is at least one note in `music, false otherwise."
(or (eq? (name-of music) 'NoteEvent)
(let ((e (ly:music-property music 'element)))
(and (ly:music? e)
(has-notes? e)))
(let loop ((es (ly:music-property music 'elements)))
(and (pair? es)
(or (has-notes? (car es))
(loop (cdr es)))))))
%% An EventChord is sometimes used as a wrapper in Lilypond, so we have to check
%% if a chord is a standard chord with notes. We could have used has-notes? but
%% this version is perhaps more efficient.
%% Optional events name like 'RestEvent can be included.
#(define (note-or-chord? music . otherEvent)
"Is music a note or a chord with notes ?"
(let ((name (name-of music)))
(or (memq name (cons 'NoteEvent otherEvent))
(and (eq? name 'EventChord) ; have this chord at least one note ?
(let loop ((es (ly:music-property music 'elements)))
(and (pair? es)
(or (eq? (name-of (car es)) 'NoteEvent)
(loop (cdr es)))))))))
#(define (expand-q-chords music); for q chords : see chord-repetition-init.ly
(expand-repeat-chords! (list 'rhythmic-event) music))
#(define (clean-music mus)
"Try to reduce the number of sequential music"
(let ((name (ly:music-property mus 'name)))
(cond
((eq? name 'SequentialMusic)
(ly:music-set-property! mus 'elements (fold-right
(lambda (evt prev-list)
(if (eq? (name-of evt) 'SequentialMusic)
(append (ly:music-property (clean-music evt) 'elements) prev-list)
(cons (clean-music evt) prev-list)))
'()
(ly:music-property mus 'elements))))
((eq? name 'SimultaneousMusic)
(ly:music-set-property! mus 'elements
(map clean-music (ly:music-property mus 'elements))))
((memq name (list 'RelativeOctaveMusic 'UnrelativableMusic))
(ly:music-set-property! mus 'element (clean-music
(ly:music-property mus 'element)))))
mus))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%% changePitch %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#(define cPInsertInPattern (gensym))
#(define cPSamePitch (gensym))
#(define cPSamePitchEnd (gensym))
#(define cPPatternEnd (gensym))
#(define (make-notes-list music)
"Make a list with each element will be of one of these types :
1- a note, a chord, a rest
2- an integer, indicating the number of notes to skip in pattern ( The user will
indicate that, by a corresponding number of skips (s or \\skip) in `newnotes
parameter of \\changePitch )
3- a list of musics, to be inserted between 2 notes of pattern, and added with
the \\insert function, inside `newnotes"
(let ((res '()) ; the list to fill
(prev #f))
(define (fill-notes-list evt)
(let ((tags (ly:music-property evt 'tags))
(name (name-of evt)))
(cond
((memq cPInsertInPattern tags) ; a music added by \insert
(ly:music-set-property! evt 'tags
(delq cPInsertInPattern tags)) ; remove the tag
(if (integer? prev)(set! res (cons prev res)))
(set! prev (if (pair? prev)(cons evt prev)(list evt)))) ; a list
((memq name (list 'SkipEvent 'SkipMusic))
(if (pair? prev)(set! res (cons prev res))) ; keep the reverse order
(set! prev (if (integer? prev) (1+ prev) 1)))
; ((memq name (list 'EventChord 'NoteEvent 'RestEvent))
((note-or-chord? evt 'RestEvent) ; a note, a chord, or a rest
(if (or (pair? prev)(integer? prev))(set! res (cons prev res)))
(set! prev evt)
(set! res (cons evt res)))
(else
(let ((elt (ly:music-property evt 'element))
(elts (ly:music-property evt 'elements)))
(if (ly:music? elt) (fill-notes-list elt))
(if (pair? elts)(for-each fill-notes-list elts)))))))
(fill-notes-list music)
(if (or (pair? prev)(integer? prev))(set! res (cons prev res)))
(reverse res)))
%%%%%%%%%%%% used inside the inner function change-one-note
#(define (copy-duration from to) ; from and to as EventChord or NoteEvent
(let ((max-dur #f)); in theory, 2 notes in a chord can have a different duration
(music-map (lambda (x) ; get main duration from `from
(let ((dur (ly:music-property x 'duration)))
(if (and (ly:duration? dur)
(or (not max-dur)
(ly:duration<? max-dur dur))); take the greater
(set! max-dur dur))
x))
from)
(music-map (lambda (x) ; set duration to duration of `to
(if (ly:duration? (ly:music-property x 'duration))
(ly:music-set-property! x 'duration max-dur))
x)
to)))
#(define (copy-arti from to) ; from and to as EventChord or NoteEvent
(let* ((es-from (ly:music-property from 'elements))
(es-to (ly:music-property to 'elements))
(arti-from (if (null? es-from)
(ly:music-property from 'articulations)
(filter
(lambda(x)
(not (ly:duration? (ly:music-property x 'duration))))
es-from))))
(if (null? es-to) ; NoteEvent
(ly:music-set-property! to 'articulations
(append (ly:music-property to 'articulations) arti-from))
(ly:music-set-property! to 'elements ; EventChord
(append es-to arti-from)))
; copy also 'tags and 'to-relative-callback
(ly:music-set-property! to 'tags
(append (ly:music-property from 'tags)(ly:music-property to 'tags)))
(if (null? es-to)
(ly:music-set-property! to 'to-relative-callback
(ly:music-property from 'to-relative-callback))
(begin
(ly:music-set-property! to 'to-relative-callback
ly:music-sequence::event-chord-relative-callback)
(ly:music-set-property! (car es-to) 'to-relative-callback
(ly:music-property from 'to-relative-callback))))
))
%% del-arti is called for all notes but the first of a \samePitch section.
#(define (del-arti note-or-chord)
(ly:music-set-property! note-or-chord 'articulations '())
(ly:music-set-property! note-or-chord 'elements
(filter (lambda(x)
(and (ly:duration? (ly:music-property x 'duration))
(ly:music-set-property! x 'articulations '())))
(ly:music-property note-or-chord 'elements))) ; can be empty
(music-map ;; del all caution accidentals
(lambda(x)(if (eq? (name-of x) 'NoteEvent) (begin
(ly:music-set-property! x 'force-accidental #f)
(ly:music-set-property! x 'cautionary #f)))
x)
note-or-chord))
#(define (change-pitch pattern newnotes)
"The scheme function of \\changePitch, `pattern and `newnotes as music."
(let ((seq-list '()) ; list of transformed patterns
(skip-notnote-event? #f) ; #t if a \skip or an \insert is found in newnotes
(same-pitch-section? #f) ; #t if we are in the 2nd pattern note of a\samePitch section
;(dummy-note #{ c4 #}) ; \language dependant -:(
(dummy-note (make-music 'NoteEvent ; to avoid pbs with pattern without any notes
'duration (ly:make-duration 2 0 1) ;
'pitch (ly:make-pitch -1 0 0))) ;
(pattern2 #{ $pattern \tag #cPPatternEnd s4 #}) ; to detect the end of pattern
(last-notes-list #f)) ; buffer
(set! seq-list (cdr ; skip dummy notes
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let loop ((notes-list (cons dummy-note (make-notes-list newnotes))); see make-notes-list
(pat-list (cons dummy-note (circular-list pattern2)))
(res '())) ; the list to fill
(if (or (null? notes-list)(null? pat-list)) ; pat-list may be a regular list in the loop
(reverse res) ;;;;;; return the list in the right order
(let ((x (car notes-list)) ;;;;;; go deeper, taking 1st elt of each lists
(evt (ly:music-deep-copy (car pat-list))))
(cond
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((pair? x) ; x is a list of musics, added with \insert in newnotes
(set! skip-notnote-event? #t) ; for events between 2 pattern notes
(set! last-notes-list notes-list) ; for section "else" of this cond statement
(loop (cdr notes-list) pat-list (append x res))) ; append x to res
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((note-or-chord? evt) ; evt in pattern is a note or a chord (with notes)
(set! last-notes-list notes-list) ; for section "else" later
(cond
((ly:music? x) ;;;;;; the elt of notes-list is a note or a chord
(if same-pitch-section? ; x is used several times. Copy arti of x only to the
(set! x (del-arti (ly:music-deep-copy x)))) ; 1st note of \samePitch section
(copy-duration evt x) ; evt = from, x = to
(copy-arti evt x)
(let ((tags (ly:music-property x 'tags)))
(cond ; are we in a \samePitch section ?
((memq cPSamePitch tags) ; yes, first,remove the tag
(ly:music-set-property! x 'tags (delq cPSamePitch tags))
(set! same-pitch-section? #t)) ; then set the flag
((memq cPSamePitchEnd tags) ; last note of \samePitch
(ly:music-set-property! x 'tags (delq cPSamePitchEnd tags))
(set! same-pitch-section? #f)))) ; unset the flag
(set! skip-notnote-event? #f); stop deletion of not-notes event.
(if same-pitch-section?
(loop notes-list (cdr pat-list)(cons x res))
(loop (cdr notes-list)(cdr pat-list)(cons x res)))) ; next new note
((integer? x) ;;;;;; user want to skip over the current evt note. We also
(set! skip-notnote-event? x) ; don't add any events bis next pattern note
;; (format #t "x : ~a\n" x) ; for testing
(cond ((= x 1) ; only one s
(loop (cdr notes-list)(cdr pat-list) res)) ; next notes-list elt
(else ; several successive s
(set-car! notes-list (1- x)) ; for the next loop
(loop notes-list (cdr pat-list) res)))))) ; the next evt only
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((or (ly:music-property evt 'duration #f) ; current evt in pattern is not a note
(not (has-notes? evt)))
(cond ((memq cPPatternEnd (ly:music-property evt 'tags)) ; last evt of pattern
(let ((x (car notes-list)))
(if (and (integer? x)
(or (null? (cdr notes-list)) ; last elt ?
(and (null? (cddr notes-list)) ; 2nd to last and last is
(pair? (car (cdr notes-list)))))) ; a \insert section
(cond
((= x 1)
(set! skip-notnote-event? x)
(loop (cdr notes-list) (cdr pat-list) res))
(else
(set-car! notes-list (1- x))
(loop notes-list (cdr pat-list) res))))
(loop notes-list (cdr pat-list) res))) ;; ignores evt
(skip-notnote-event? (loop notes-list (cdr pat-list) res))
(else (loop notes-list (cdr pat-list)(cons evt res)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(else
(let ((e (ly:music-property evt 'element))
(es (ly:music-property evt 'elements))
(empty? #f)) ; don't add to res if #t
(if (ly:music? e)
(let ((new-e (loop notes-list (list e) '())))
(ly:music-set-property! evt 'element
(case (length new-e)
((0) (set! empty? #t)
new-e)
((1)(car new-e))
(else (make-sequential-music new-e))))))
(if (pair? es)
(let ((new-es (loop notes-list es '())))
(ly:music-set-property! evt 'elements new-es)
(set! empty? (and empty? (null! new-es))))) ; #t if both empty
(let ((next-new-notes (if (or same-pitch-section?
(and (integer? skip-notnote-event?)
(> skip-notnote-event? 1)))
last-notes-list
(cdr last-notes-list))))
(if empty? (loop next-new-notes (cdr pat-list) res)
(loop next-new-notes (cdr pat-list) (cons evt res))))))))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; end loop ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(let ((relativize (lambda(m)
(let* ((clean-newnotes (clean-music newnotes))
(name (name-of clean-newnotes)))
(if (memq name (list 'RelativeOctaveMusic 'UnrelativableMusic))
(make-music name 'element m)
m)))))
(case (length seq-list)
((0) (make-music 'Music 'void #t))
((1) (relativize (car seq-list)))
(else (relativize (clean-music (make-sequential-music seq-list))))))))
changePitch = #(define-music-function (parser location pattern newnotes)
(ly:music? ly:music?)
"Change each notes in `pattern by the notes (or rests) given in `newnotes.
If count of events doesn't match, pattern is duplicated repeatedly or truncate."
(let* ((expand-q (lambda (music) (expand-repeat-chords!
(cons 'rhythmic-event (ly:parser-lookup parser '$chord-repeat-events))
music)))
(pattern (expand-q pattern))
(newnotes (expand-q newnotes)))
(change-pitch pattern newnotes)))
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% enhancement functions, working with \changePitch pattern newnotes
samePitch = #(define-music-function (parser location music) (ly:music?)
"Inside the `pattern parameter of the \\changePitch function, all notes grouped
by this function will have the same pitch, according to the current note of
`newnotes parameter of \\changePitch."
(let((not-first? #f)
(last-note #f))
(map-some-music
(lambda (x)
(cond
((note-or-chord? x)
(if not-first? ; set all pitches to the pitch of the first note
(ly:music-set-property! x 'to-relative-callback
(lambda (x p) ; set pitch to the prev value
(ly:prob-set-property! x 'pitch p)
p))
(set! not-first? x)) ; do nothing for first note
(ly:music-set-property! x 'tags (cons
cPSamePitch ; add tag cPSamePitch to x
(ly:music-property x 'tags)))
(set! last-note x) ; save the note x
x)
(else #f)))
music)
(if last-note ; the last saved EventChord
(ly:music-set-property! last-note 'tags (cons
cPSamePitchEnd ; add cPSamePitchEnd tag, delete cPSamePitch tag
(delq cPSamePitch (ly:music-property last-note 'tags)))))
music))
%% this function should be no more needed, as copy-arti should avoid pbs
%% in relative mode and \samePitch
absolute = #(define-music-function (parser location music) (ly:music?)
"Make `music unrelativable. To use inside a \\samePitch function in relative
mode."
(make-music 'UnrelativableMusic 'element music))
insert = #(define-music-function (parser location music) (ly:music?)
"Using this function inside the `newnotes parameter of the \\changePitch
function, allow you to insert and remplace by `music, all music between one note
and his following, in the `pattern parameter of \\changePitch, ."
#{ \tag #cPInsertInPattern $music #})
%%%%%%%
#(define (n-copy n music)
(cond
((> n 1)(make-sequential-music
(map (lambda (x)(ly:music-deep-copy music))
(make-list n))))
((= n 1) music)
(else (make-music 'Music 'void #t))))
nCopy = #(define-music-function (parser location n music)(integer? ly:music?)
(n-copy n music))
%% same effect as { \repeat unfold n s } but \nSkip works inside the `newnotes
%% parameter of \changePitch.
nSkip = #(define-music-function (parser location n)(integer?)
"Return \\skip \\skip \\skip ... n times."
#{ \nCopy #n s #})
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% shortcuts
% default values for patI and patII, if the user do not define
% them, before using \cPI and \cPII
% patI ={ c8. c16 } % not \language independant
patI = #(make-music 'SequentialMusic 'elements (list
(make-music 'NoteEvent 'duration (ly:make-duration 3 1 1)
'pitch (ly:make-pitch -1 0 0))
(make-music 'NoteEvent 'duration (ly:make-duration 4 0 1)
'pitch (ly:make-pitch -1 0 0))))
% patII = { c4. c8 }
patII = #(make-music 'SequentialMusic 'elements (list
(make-music 'NoteEvent 'duration (ly:make-duration 2 1 1)
'pitch (ly:make-pitch -1 0 0))
(make-music 'NoteEvent 'duration (ly:make-duration 3 0 1)
'pitch (ly:make-pitch -1 0 0))))
cPI = #(define-music-function (parser location newnotes) (ly:music?)
#{ \changePitch \patI $newnotes #})
cPII = #(define-music-function (parser location newnotes) (ly:music?)
#{ \changePitch \patII $newnotes #})
#(define cP changePitch)
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% The example %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
testMusic = { c d e f g f e d <c e> <d f> <e g> <d f> }
fillerChord = { <c e>2 }
\relative c' {
\override Score.RehearsalMark.self-alignment-X = #LEFT
\mark "pattern = { c8.-> c16-. }"
\changePitch { c8.-> c16-. } {
\testMusic
}
\fillerChord
\break
\mark "pattern = { c8 c16( c) }"
\changePitch { c8 c16( c) } {
\testMusic
}
\fillerChord
\fillerChord
\break
\time 6/8
\mark "pattern = { c4( c8) c8.( c16) c8-. }"
\changePitch { c4( c8) c8.( c16) c8-. } {
\testMusic
}
<c e>4.
}