scm/scheme-engravers.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 2012 David Nalesnik <david.nalesnik@gmail.com>
   4 ;;;;
   5 ;;;; LilyPond is free software: you can redistribute it and/or modify
   6 ;;;; it under the terms of the GNU General Public License as published by
   7 ;;;; the Free Software Foundation, either version 3 of the License, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; LilyPond is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 ;;;; GNU General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  17
  18
  19 (define-public (Measure_counter_engraver context)
  20   "This engraver numbers ranges of measures, which is useful in parts as an
  21 aid for counting repeated measures.  There is no requirement that the
  22 affected measures be repeated, however.  The user delimits the area to
  23 receive a count with @code{\\startMeasureCount} and
  24 @code{\\stopMeasureCount}."
  25   (let ((count-spanner '()) ; a single element of the count
  26         (go? #f) ; is the count in progress?
  27         (stop? #f) ; do we end the count?
  28         (last-measure-seen 0)
  29         (elapsed 0))
  30
  31     (make-engraver
  32      (listeners
  33        ((measure-counter-event engraver event)
  34         (cond
  35           ((and (= START (ly:event-property event 'span-direction))
  36                 go?)
  37            (set! stop? #t)
  38            (ly:input-warning
  39              (ly:event-property event 'origin)
  40              "count not ended before another begun"))
  41           ((= START (ly:event-property event 'span-direction))
  42            (set! go? #t)
  43            ;; initialize one less so first measure receives a count spanner
  44            (set! last-measure-seen
  45                  (1- (ly:context-property context 'currentBarNumber))))
  46           ((= STOP (ly:event-property event 'span-direction))
  47            (set! stop? #t)
  48            (set! go? #f)))))
  49
  50      ((process-music trans)
  51       (let ((col (ly:context-property context 'currentCommandColumn))
  52             (now (ly:context-property context 'measurePosition))
  53             (current-bar (ly:context-property context 'currentBarNumber)))
  54         ;; Each measure of a count receives a new spanner, which is bounded
  55         ;; by the first "command column" of that measure and the following one.
  56         ;; The possibility of initial grace notes (negative measure position)
  57         ;; is considered.
  58         (if (and (> current-bar last-measure-seen)
  59                  (moment<=? now ZERO-MOMENT))
  60             (begin
  61               ;; Finish the previous count-spanner if there is one.
  62               (if (ly:grob? count-spanner)
  63                   (begin
  64                     (ly:spanner-set-bound! count-spanner RIGHT col)
  65                     (ly:pointer-group-interface::add-grob count-spanner 'columns col)
  66                     (ly:engraver-announce-end-grob trans count-spanner col)
  67                     (set! count-spanner '())))
  68               ;; If count is over, reset variables.
  69               (if stop?
  70                   (begin
  71                     (set! elapsed 0)
  72                     (set! stop? #f)))
  73               ;; If count is in progress, begin a count-spanner.
  74               (if go?
  75                   (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
  76                          (counter (ly:grob-property c 'count-from)))
  77                     (ly:spanner-set-bound! c LEFT col)
  78                     (ly:pointer-group-interface::add-grob c 'columns col)
  79                     (set! (ly:grob-property c 'count-from) (+ counter elapsed))
  80                     (set! count-spanner c)
  81                     (set! elapsed (1+ elapsed))))))
  82                     (set! last-measure-seen current-bar)))
  83
  84      ((finalize trans)
  85       (if go?
  86           (begin
  87             (set! go? #f)
  88             (ly:grob-suicide! count-spanner)
  89             (set! count-spanner '())
  90             (ly:warning "measure count left unfinished")))))))