From 4ec2b86c6574bad0fdbf0c67aacd5d3836bebfd3 Mon Sep 17 00:00:00 2001 From: Mark Polesky Date: Wed, 22 Jul 2009 00:20:58 -0700 Subject: [PATCH] autochange.scm: Use averaged chord pitches to determine staff. --- scm/autochange.scm | 22 +++++++++++++++++++++- 1 files changed, 21 insertions(+), 1 deletions(-) diff --git a/scm/autochange.scm b/scm/autochange.scm index c445997..f0f732e 100644 --- a/scm/autochange.scm +++ b/scm/autochange.scm @@ -3,6 +3,26 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; autochange - fairly related to part combining. +(define (notes-get-pitches notes) + (map (lambda (x) (ly:event-property x 'pitch)) + notes)) + +(define (get-avg-pitch-steps pitches) + ((lambda (x) + ;; avg-pitch-steps *near* zero should never *be* zero. + (cond ((< 0 x 1) 1) + ((< -1 x 0) -1) + (else (round x)))) + (apply average (map ly:pitch-steps pitches)))) + +(define (make-dummy-pitch pitch-steps) + (let ((octave (floor (/ pitch-steps 7))) + (notename (modulo pitch-steps 7))) + (ly:make-pitch octave notename 0))) + +(define (notes-get-avg-pitch notes) + (make-dummy-pitch (get-avg-pitch-steps (notes-get-pitches notes)))) + (define-public (make-autochange-music parser music) (define (generate-split-list change-moment event-list acc) (if (null? event-list) @@ -14,7 +34,7 @@ (equal? (ly:event-property x 'class) 'note-event)) evs)) (pitch (if (pair? notes) - (ly:event-property (car notes) 'pitch) + (notes-get-avg-pitch notes) #f))) ;; tail recursive. (if (and pitch (not (= (ly:pitch-steps pitch) 0))) -- 1.6.3.msysgit.0