scm/autochange.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2000--2015  Han-Wen Nienhuys <hanwen@xs4all.nl>
   4 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  20 ;; autochange.scm - fairly related to part combining.
  21
  22 (define-public (make-autochange-music ref-pitch music)
  23   (define (generate-split-list change-moment prev-dir event-list acc)
  24     (if (null? event-list)
  25         acc
  26         (let* ((now-tun (caar event-list))
  27                (evs (map car (cdar event-list)))
  28                (now (car now-tun))
  29                (notes (filter (lambda (x)
  30                                 (ly:in-event-class? x 'note-event))
  31                               evs))
  32                (pitch (if (pair? notes)
  33                           (ly:event-property (car notes) 'pitch)
  34                           #f))
  35                (dir (if pitch
  36                         (sign
  37                           (- (ly:pitch-steps pitch) (ly:pitch-steps ref-pitch)))
  38                         0)))
  39           ;; tail recursive.
  40           (if (and (not (= dir 0))
  41                    (not (= dir prev-dir)))
  42               (generate-split-list #f
  43                                    dir
  44                                    (cdr event-list)
  45                                    (cons (cons
  46                                           (if change-moment
  47                                               change-moment
  48                                               now)
  49                                           (if (< dir 0) 'down 'up)) acc))
  50               (generate-split-list
  51                (if pitch #f (if change-moment change-moment now))
  52                dir
  53                (cdr event-list) acc)))))
  54
  55   (let* ((m (make-music 'AutoChangeMusic))
  56          (m1 (context-spec-music (make-non-relative-music music) 'Voice ""))
  57          (context-list
  58            (recording-group-emulate m1
  59                                     (ly:parser-lookup 'partCombineListener)))
  60          (rev (reverse! (cdar context-list)))
  61          (split (reverse! (generate-split-list
  62                            #f
  63                            0
  64                            rev
  65                            '())
  66                           '())))
  67     (set! (ly:music-property m 'element) m1)
  68     (set! (ly:music-property m 'context-change-list) split)
  69     m))