I've tweaked the autochange code a little more and I've been able to make some of the improvements suggested. It's still under construction, but I'm posting it so you guys can play with it. The easiest way to test it would be to just save the autochange_revised.scm and autochange.ly attachments in the same directory and then compile autochange.ly.
Play around with the max-avg-deviation variable in
autochange_revised.scm. Eventually I'll also add a max-deviation
property which will allow fine-tuning of the staff-change
algorithm.
I've attached (in miniature) a png which shows the file compiled
with the current setting on the left, and with my revisions on the
right.
I think there will always be situations that end up not looking
right. One can only automate so much. But I think this is big
improvement over the current function.
Let me know what you guys think.
- Mark
<<attachment: autochange.png>>
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; autochange - fairly related to part combining.
; copied from lily-library.scm
(define (sign x)
(if (= x 0)
0
(if (< x 0) -1 1)))
(define (notes-get-pitches notes)
(map (lambda (x) (ly:event-property x 'pitch))
notes))
(define (get-avg-pitch-steps pitches)
(round (apply average (map ly:pitch-steps pitches))))
(define (get-pitch-steps-range pitches)
(let ((pitch-steps (map ly:pitch-steps pitches)))
(cons (apply min pitch-steps) (apply max pitch-steps))))
(define-public (make-autochange-music parser music)
;; don't let gradually moving chords get stuck in one staff.
;; when the absolute-value of a chord's average staff-position
;; exceeds this value, allow the chord to change staves.
;; at the moment, this does not affect single notes, only chords that
;; are close together
;; TODO: max-deviation
(define max-avg-deviation 2)
(define (generate-split-list change-moment event-list last-profile acc)
;; acc is a reversed list of (moment . staff) pairs,
;; where staff is 1 or -1.
;; last-profile is (last-staff . last-extremity)
(if (null? event-list)
acc
(let* ((now-tun (caar event-list))
(evs (map car (cdar event-list)))
(now (car now-tun)) ; a moment
(notes (filter (lambda (x)
(equal? (ly:event-property x 'class)
'note-event))
evs))
(pitches (notes-get-pitches notes))
(this-avg (if (pair? notes)
(get-avg-pitch-steps pitches)
#f))
(this-range (if (pair? notes)
(get-pitch-steps-range pitches)
'(0 . 0)))
(last-staff (car last-profile))
(last-extremity (cdr last-profile))
(is-single-note (= (car this-range) (cdr this-range)))
(this-staff
(cond ; don't change staves if this-avg is C.
((= 0 this-avg) last-staff)
;; TODO: this block could be better organized:
((or ; when to force a change during chords.
(if is-single-note
#f
(< max-avg-deviation (abs this-avg)))
; if chord normally goes in the other staff
; and this-avg exceeds last-extremity.
(and (not (= last-staff (sign this-avg)))
(< (abs last-extremity)
(abs this-avg))
(if is-single-note
(< max-avg-deviation (abs this-avg)))
#t))
(sign this-avg))
(else last-staff))) ; -1 or 1
(this-extremity (if (positive? this-staff)
(car this-range)
(cdr this-range)))
(this-profile (cons this-staff this-extremity)))
;; tail recursive.
(if (and this-avg
(not (= last-staff this-staff)))
(generate-split-list #f
(cdr event-list)
this-profile
(cons (cons
(if change-moment
change-moment
now)
(sign this-avg))
acc))
(generate-split-list
(if this-avg #f now)
(cdr event-list)
this-profile
acc)))))
(let* ((m (make-music 'AutoChangeMusic))
(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
'(1 . 0) ; first staff must default to 1.
'())
'())))
(set! (ly:music-property m 'element) music)
(set! (ly:music-property m 'split-list) split)
m))
\version "2.13.2"
% uncomment to test revised version:
%#(load "autochange_revised.scm")
uppersFirstShort = \relative {
<b g>8 <c g> <c a> <d a>
<d b> <e b> <e c> <f c>
<f c> <e c> <e b> <d b>
<d a> <c a> <c g> <b g>
}
lowersFirstShort = \relative {
<g b>8 <g c> <a c> <a d>
<b d> <b e> <c e> <c f>
<c f> <c e> <b e> <b d>
<a d> <a c> <g c> <g b>
}
uppersFirstLong = \relative {
<b g>8 <c g> <c a> <d a>
<d b> <e b> <e c> <f c>
<f d> <g d> <g e> <a e>
<a e> <g e> <g d> <f d>
<f c> <e c> <e b> <d b>
<d a> <c a> <c g> <b g>
}
lowersFirstLong = \relative {
<g b>8 <g c> <a c> <a d>
<b d> <b e> <c e> <c f>
<d f> <d g> <e g> <e a>
<e a> <e g> <d g> <d f>
<c f> <c e> <b e> <b d>
<a d> <a c> <g c> <g b>
}
\new PianoStaff \autochange \uppersFirstShort
\new PianoStaff \autochange \lowersFirstShort
\new PianoStaff \autochange \uppersFirstLong
\new PianoStaff \autochange \lowersFirstLong
\new PianoStaff \autochange \relative {
<b, e'>8 <d' f> <b, e'> <d' f>
<a d'> <g b> <a d'> <g b>
}
\new PianoStaff \autochange \relative {
c8 d e f g f e d c b a g f g a b c
}
\new PianoStaff \autochange \relative {
<c, e>8 <d f> <e g> <f a>
<g b> <a c> <b d> <c e>
<d f> <e g> <f a> <g b>
<g b> <f a> <e g> <d f>
<c e> <b d> <a c> <g b>
<f a> <e g> <d f> <c e>
}
_______________________________________________ lilypond-devel mailing list lilypond-devel@gnu.org http://lists.gnu.org/mailman/listinfo/lilypond-devel
