scm/autochange.scm

   1
   2
   3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   4 ;; autochange.scm - fairly related to part combining.
   5
   6 (define-public (make-autochange-music music)
   7   (define (generate-split-list change-moment prev-dir event-list acc)
   8     (if (null? event-list)
   9         acc
  10         (let* ((now-tun (caar event-list))
  11                (evs (map car (cdar event-list)))
  12                (now (car now-tun))
  13                (notes (filter (lambda (x)
  14                                 (ly:in-event-class? x 'note-event))
  15                               evs))
  16                (pitch (if (pair? notes)
  17                           (ly:event-property (car notes) 'pitch)
  18                           #f))
  19                (dir (if pitch (sign (ly:pitch-steps pitch)) 0)))
  20           ;; tail recursive.
  21           (if (and (not (= dir 0))
  22                    (not (= dir prev-dir)))
  23               (generate-split-list #f
  24                                    dir
  25                                    (cdr event-list)
  26                                    (cons (cons
  27
  28                                           (if change-moment
  29                                               change-moment
  30                                               now)
  31                                           (if (< dir 0) 'down 'up)) acc))
  32               (generate-split-list
  33                (if pitch #f (if change-moment change-moment now))
  34                dir
  35                (cdr event-list) acc)))))
  36
  37   (let* ((m (make-music 'AutoChangeMusic))
  38          (m1 (context-spec-music (make-non-relative-music music) 'Voice ""))
  39          (context-list (recording-group-emulate m1
  40                                                 (ly:parser-lookup 'partCombineListener)))
  41          (rev (reverse! (cdar context-list)))
  42          (split (reverse! (generate-split-list
  43                            #f
  44                            0
  45                            rev
  46                            '())
  47                           '())))
  48     (set! (ly:music-property m 'element) m1)
  49     (set! (ly:music-property m 'context-change-list) split)
  50     m))