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
  26 Each element of a count is a spanner, and a count is thus a series of
  27 spanners.  Each spanner is bounded by the first @code{CommandColumn} of
  28 successive measures, and boundaries are shared by adjoining spanners."
  29   (let ((count-spanner '()) ; a single element of the count
  30         (go? #f) ; is the count in progress?
  31         (stop? #f) ; do we end the count?
  32         (last-measure-seen 0)
  33         (new-measure? #f)
  34         (elapsed 0))
  35
  36     (make-engraver
  37      (listeners ((measure-counter-event engraver event)
  38                  (set! last-measure-seen (ly:context-property context 'currentBarNumber))
  39                  (set! new-measure? #t)
  40                  (cond
  41                   ((and (= START (ly:event-property event 'span-direction))
  42                         go?)
  43                    (begin
  44                      (set! stop? #t)
  45                      (ly:input-warning
  46                       (ly:event-property event 'origin)
  47                       "count not ended before another begun")))
  48                   ((= START (ly:event-property event 'span-direction))
  49                    (set! go? #t))
  50                   ((= STOP (ly:event-property event 'span-direction))
  51                    (begin
  52                      (set! stop? #t)
  53                      (set! go? #f))))))
  54
  55      ((process-music trans)
  56       (let ((col (ly:context-property context 'currentCommandColumn))
  57             (now (ly:context-property context 'measurePosition))
  58             (current-bar (ly:context-property context 'currentBarNumber)))
  59         ;; If the counter has been started, make sure we're in a new bar
  60         ;; before finishing a count-spanner and starting a new one.
  61         ;; Since we consider all CommandColumns encountered, we need this
  62         ;; check so that a count-spanner is not created for each pair.
  63         (if (and (ly:grob? count-spanner)
  64                  (> current-bar last-measure-seen))
  65             (set! new-measure? #t))
  66         (if new-measure?
  67             (begin
  68               ;; Check if we have the first column of the measure.
  69               ;; The possibility of initial grace notes is considered.
  70               (if (moment<=? now ZERO-MOMENT)
  71                   (begin
  72                     ;; If we have the first column, finish the previous
  73                     ;; counter-spanner (if there is one).
  74                     (if (ly:grob? count-spanner)
  75                         (begin
  76                           (ly:spanner-set-bound! count-spanner RIGHT col)
  77                           (ly:pointer-group-interface::add-grob count-spanner 'columns col)
  78                           (ly:engraver-announce-end-grob trans count-spanner col)
  79                           (set! count-spanner '())))
  80                     ;; if count is over, reset variables
  81                     (if stop?
  82                         (begin
  83                           (set! elapsed 0)
  84                           (set! stop? #f)))
  85                     ;; if count is in progress, begin a counter object
  86                     (if go?
  87                         (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
  88                                (counter (ly:grob-property c 'count-from)))
  89                           (ly:spanner-set-bound! c LEFT col)
  90                           (ly:pointer-group-interface::add-grob c 'columns col)
  91                           (set! (ly:grob-property c 'count-from) (+ counter elapsed))
  92                           (set! count-spanner c)
  93                           (set! elapsed (1+ elapsed))))
  94                     (set! new-measure? #f)))))
  95         (set! last-measure-seen current-bar)))
  96
  97      ((finalize trans)
  98       (if go?
  99           (begin
 100             (set! go? #f)
 101             (ly:grob-suicide! count-spanner)
 102             (set! count-spanner '())
 103             (ly:warning "measure count left unfinished")))))))