-
+;;;; This file is part of LilyPond, the GNU music typesetter.
+;;;;
+;;;; Copyright (C) 2000--2015 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; LilyPond is free software: you can redistribute it and/or modify
+;;;; it under the terms of the GNU General Public License as published by
+;;;; the Free Software Foundation, either version 3 of the License, or
+;;;; (at your option) any later version.
+;;;;
+;;;; LilyPond is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;;; GNU General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU General Public License
+;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; autochange - fairly related to part combining.
+;; autochange.scm - fairly related to part combining.
-(define-public (make-autochange-music music)
- (define (generate-split-list change-moment event-list acc)
+(define-public (make-autochange-music ref-pitch music)
+ (define (generate-split-list change-moment prev-dir 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:event-property x 'class) '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
+ 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))
+ (dir (if pitch
+ (sign
+ (- (ly:pitch-steps pitch) (ly:pitch-steps ref-pitch)))
+ 0)))
+ ;; tail recursive.
+ (if (and (not (= dir 0))
+ (not (= dir prev-dir)))
+ (generate-split-list #f
+ dir
+ (cdr event-list)
+ (cons (cons
+ (if change-moment
+ change-moment
+ now)
+ (if (< dir 0) 'down 'up)) acc))
+ (generate-split-list
+ (if pitch #f (if change-moment change-moment now))
+ dir
+ (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)))))
-
(let* ((m (make-music 'AutoChangeMusic))
- (m1 (make-non-relative-music (context-spec-music music 'Voice "one")))
- (context-list (recording-group-emulate music part-combine-listener))
- (evs (car context-list))
+ (m1 (context-spec-music (make-non-relative-music music) 'Voice ""))
+ (context-list
+ (recording-group-emulate m1
+ (ly:parser-lookup 'partCombineListener)))
(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)
+ (split (reverse! (generate-split-list
+ #f
+ 0
+ rev
+ '())
+ '())))
+ (set! (ly:music-property m 'element) m1)
+ (set! (ly:music-property m 'context-change-list) split)
m))