;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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))