X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fautochange.scm;h=b358c22b53dd0a610abcb28266601d42a645ee3e;hb=57f01d7d76f5f682f41da1229fd1fd3ab308201d;hp=b7169c8a99a31f2662584cb394a98e4cc0ad6dac;hpb=9f3572d98bb948c9689cd1f75401a029451fa001;p=lilypond.git diff --git a/scm/autochange.scm b/scm/autochange.scm index b7169c8a99..b358c22b53 100644 --- a/scm/autochange.scm +++ b/scm/autochange.scm @@ -1,46 +1,46 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; autochange - fairly related to part combining. +;; autochange.scm - fairly related to part combining. -(define-public (make-autochange-music music) +(define-public (make-autochange-music parser music) (define (generate-split-list change-moment event-list acc) (if (null? event-list) - acc - (let* ((now-tun (caar event-list)) - (evs (map car (cdar event-list))) - (now (car now-tun)) - (notes (filter (lambda (x) - (equal? (ly:music-property x 'name) 'NoteEvent)) - evs)) - (pitch (if (pair? notes) - (ly:music-property (car notes) 'pitch) - #f))) - ;; tail recursive. - (if (and pitch (not (= (ly:pitch-steps pitch) 0))) - (generate-split-list #f - (cdr event-list) - (cons (cons + acc + (let* ((now-tun (caar event-list)) + (evs (map car (cdar event-list))) + (now (car now-tun)) + (notes (filter (lambda (x) + (ly:in-event-class? x 'note-event)) + evs)) + (pitch (if (pair? notes) + (ly:event-property (car notes) 'pitch) + #f))) + ;; tail recursive. + (if (and pitch (not (= (ly:pitch-steps pitch) 0))) + (generate-split-list #f + (cdr event-list) + (cons (cons + + (if change-moment + change-moment + now) + (sign (ly:pitch-steps pitch))) acc)) + (generate-split-list + (if pitch #f now) + (cdr event-list) acc))))) - (if change-moment - change-moment - now) - (sign (ly:pitch-steps pitch))) acc)) - (generate-split-list - (if pitch #f now) - (cdr event-list) acc))))) - - (set! noticed '()) (let* ((m (make-music 'AutoChangeMusic)) - (context (ly:run-translator (make-non-relative-music music) part-combine-listener)) - (evs (last-pair noticed)) - (split (reverse! (generate-split-list - #f - (if (pair? evs) - (reverse! (cdar evs) '()) '()) - '()) - '()))) + (m1 (make-non-relative-music (context-spec-music music 'Voice "one"))) + (context-list (recording-group-emulate music + (ly:parser-lookup parser 'partCombineListener))) + (evs (car context-list)) + (rev (reverse! (cdar context-list))) + (split (reverse! (generate-split-list + #f + rev + '()) + '()))) (set! (ly:music-property m 'element) music) (set! (ly:music-property m 'split-list) split) - (set! noticed '()) m))