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 (define-public (ly:make-listener callback)
  19   "This is a compatibility wrapper for creating a \"listener\" for use
  20 with @code{ly:add-listener} from a @var{callback} taking a single
  21 argument.  Since listeners are equivalent to callbacks, this is no
  22 longer needed."
  23   callback)
  24
  25 (define-public (Measure_counter_engraver context)
  26   "This engraver numbers ranges of measures, which is useful in parts as an
  27 aid for counting repeated measures.  There is no requirement that the
  28 affected measures be repeated, however.  The user delimits the area to
  29 receive a count with @code{\\startMeasureCount} and
  30 @code{\\stopMeasureCount}."
  31   (let ((count-spanner '()) ; a single element of the count
  32         (go? #f) ; is the count in progress?
  33         (stop? #f) ; do we end the count?
  34         (last-measure-seen 0)
  35         (elapsed 0))
  36
  37     (make-engraver
  38      (listeners
  39       ((measure-counter-event engraver event)
  40        (cond
  41         ((and (= START (ly:event-property event 'span-direction))
  42               go?)
  43          (set! stop? #t)
  44          (ly:input-warning
  45           (ly:event-property event 'origin)
  46           "count not ended before another begun"))
  47         ((= START (ly:event-property event 'span-direction))
  48          (set! go? #t)
  49          ;; initialize one less so first measure receives a count spanner
  50          (set! last-measure-seen
  51                (1- (ly:context-property context 'currentBarNumber))))
  52         ((= STOP (ly:event-property event 'span-direction))
  53          (set! stop? #t)
  54          (set! go? #f)))))
  55
  56      ((process-music trans)
  57       (let ((col (ly:context-property context 'currentCommandColumn))
  58             (now (ly:context-property context 'measurePosition))
  59             (current-bar (ly:context-property context 'currentBarNumber)))
  60         ;; Each measure of a count receives a new spanner, which is bounded
  61         ;; by the first "command column" of that measure and the following one.
  62         ;; The possibility of initial grace notes (negative measure position)
  63         ;; is considered.
  64         (if (and (> current-bar last-measure-seen)
  65                  (moment<=? now ZERO-MOMENT))
  66             (begin
  67               ;; Finish the previous count-spanner if there is one.
  68               (if (ly:grob? count-spanner)
  69                   (begin
  70                     (ly:spanner-set-bound! count-spanner RIGHT col)
  71                     (ly:pointer-group-interface::add-grob count-spanner 'columns col)
  72                     (ly:engraver-announce-end-grob trans count-spanner col)
  73                     (set! count-spanner '())))
  74               ;; If count is over, reset variables.
  75               (if stop?
  76                   (begin
  77                     (set! elapsed 0)
  78                     (set! stop? #f)))
  79               ;; If count is in progress, begin a count-spanner.
  80               (if go?
  81                   (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
  82                          (counter (ly:grob-property c 'count-from)))
  83                     (ly:spanner-set-bound! c LEFT col)
  84                     (ly:pointer-group-interface::add-grob c 'columns col)
  85                     (set! (ly:grob-property c 'count-from) (+ counter elapsed))
  86                     (set! count-spanner c)
  87                     (set! elapsed (1+ elapsed))))))
  88         (set! last-measure-seen current-bar)))
  89
  90      ((finalize trans)
  91       (if go?
  92           (begin
  93             (set! go? #f)
  94             (ly:grob-suicide! count-spanner)
  95             (set! count-spanner '())
  96             (ly:warning "measure count left unfinished")))))))
  97
  98 (ly:register-translator
  99  Measure_counter_engraver 'Measure_counter_engraver
 100  '((grobs-created . (MeasureCounter))
 101    (events-accepted . (measure-counter-event))
 102    (properties-read . (currentCommandColumn
 103                        measurePosition
 104                        currentBarNumber))
 105    (properties-written . ())
 106    (description . "\
 107 This engraver numbers ranges of measures, which is useful in parts as an
 108 aid for counting repeated measures.  There is no requirement that the
 109 affected measures be repeated, however.  The user delimits the area to
 110 receive a count with @code{\\startMeasureCount} and
 111 @code{\\stopMeasureCount}.")))
 112
 113 (ly:register-translator
 114  Span_stem_engraver 'Span_stem_engraver
 115  '((grobs-created . (Stem))
 116    (events-accepted . ())
 117    (properties-read . ())
 118    (properties-written . ())
 119    (description . "Connect cross-staff stems to the stems above in the system")))