;;;; You should have received a copy of the GNU General Public License
;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+(define-public (ly:make-listener callback)
+ "This is a compatibility wrapper for creating a \"listener\" for use
+with @code{ly:add-listener} from a @var{callback} taking a single
+argument. Since listeners are equivalent to callbacks, this is no
+longer needed."
+ callback)
(define-public (Measure_counter_engraver context)
"This engraver numbers ranges of measures, which is useful in parts as an
aid for counting repeated measures. There is no requirement that the
affected measures be repeated, however. The user delimits the area to
receive a count with @code{\\startMeasureCount} and
-@code{\\stopMeasureCount}.
-
-Each element of a count is a spanner, and a count is thus a series of
-spanners. Each spanner is bounded by the first @code{CommandColumn} of
-successive measures, and boundaries are shared by adjoining spanners."
+@code{\\stopMeasureCount}."
(let ((count-spanner '()) ; a single element of the count
(go? #f) ; is the count in progress?
(stop? #f) ; do we end the count?
(last-measure-seen 0)
- (new-measure? #f)
(elapsed 0))
(make-engraver
- (listeners ((measure-counter-event engraver event)
- (set! last-measure-seen (ly:context-property context 'currentBarNumber))
- (set! new-measure? #t)
- (cond
- ((and (= START (ly:event-property event 'span-direction))
- go?)
- (begin
- (set! stop? #t)
- (ly:input-warning
- (ly:event-property event 'origin)
- "count not ended before another begun")))
- ((= START (ly:event-property event 'span-direction))
- (set! go? #t))
- ((= STOP (ly:event-property event 'span-direction))
- (begin
- (set! stop? #t)
- (set! go? #f))))))
+ (listeners
+ ((measure-counter-event engraver event)
+ (cond
+ ((and (= START (ly:event-property event 'span-direction))
+ go?)
+ (set! stop? #t)
+ (ly:input-warning
+ (ly:event-property event 'origin)
+ "count not ended before another begun"))
+ ((= START (ly:event-property event 'span-direction))
+ (set! go? #t)
+ ;; initialize one less so first measure receives a count spanner
+ (set! last-measure-seen
+ (1- (ly:context-property context 'currentBarNumber))))
+ ((= STOP (ly:event-property event 'span-direction))
+ (set! stop? #t)
+ (set! go? #f)))))
((process-music trans)
(let ((col (ly:context-property context 'currentCommandColumn))
(now (ly:context-property context 'measurePosition))
(current-bar (ly:context-property context 'currentBarNumber)))
- ;; If the counter has been started, make sure we're in a new bar
- ;; before finishing a count-spanner and starting a new one.
- ;; Since we consider all CommandColumns encountered, we need this
- ;; check so that a count-spanner is not created for each pair.
- (if (and (ly:grob? count-spanner)
- (> current-bar last-measure-seen))
- (set! new-measure? #t))
- (if new-measure?
+ ;; Each measure of a count receives a new spanner, which is bounded
+ ;; by the first "command column" of that measure and the following one.
+ ;; The possibility of initial grace notes (negative measure position)
+ ;; is considered.
+ (if (and (> current-bar last-measure-seen)
+ (moment<=? now ZERO-MOMENT))
(begin
- ;; Check if we have the first column of the measure.
- ;; The possibility of initial grace notes is considered.
- (if (moment<=? now ZERO-MOMENT)
+ ;; Finish the previous count-spanner if there is one.
+ (if (ly:grob? count-spanner)
+ (begin
+ (ly:spanner-set-bound! count-spanner RIGHT col)
+ (ly:pointer-group-interface::add-grob count-spanner 'columns col)
+ (ly:engraver-announce-end-grob trans count-spanner col)
+ (set! count-spanner '())))
+ ;; If count is over, reset variables.
+ (if stop?
(begin
- ;; If we have the first column, finish the previous
- ;; counter-spanner (if there is one).
- (if (ly:grob? count-spanner)
- (begin
- (ly:spanner-set-bound! count-spanner RIGHT col)
- (ly:pointer-group-interface::add-grob count-spanner 'columns col)
- (ly:engraver-announce-end-grob trans count-spanner col)
- (set! count-spanner '())))
- ;; if count is over, reset variables
- (if stop?
- (begin
- (set! elapsed 0)
- (set! stop? #f)))
- ;; if count is in progress, begin a counter object
- (if go?
- (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
- (counter (ly:grob-property c 'count-from)))
- (ly:spanner-set-bound! c LEFT col)
- (ly:pointer-group-interface::add-grob c 'columns col)
- (set! (ly:grob-property c 'count-from) (+ counter elapsed))
- (set! count-spanner c)
- (set! elapsed (1+ elapsed))))
- (set! new-measure? #f)))))
+ (set! elapsed 0)
+ (set! stop? #f)))
+ ;; If count is in progress, begin a count-spanner.
+ (if go?
+ (let* ((c (ly:engraver-make-grob trans 'MeasureCounter col))
+ (counter (ly:grob-property c 'count-from)))
+ (ly:spanner-set-bound! c LEFT col)
+ (ly:pointer-group-interface::add-grob c 'columns col)
+ (set! (ly:grob-property c 'count-from) (+ counter elapsed))
+ (set! count-spanner c)
+ (set! elapsed (1+ elapsed))))))
(set! last-measure-seen current-bar)))
((finalize trans)
(ly:grob-suicide! count-spanner)
(set! count-spanner '())
(ly:warning "measure count left unfinished")))))))
+
+(ly:register-translator
+ Measure_counter_engraver 'Measure_counter_engraver
+ '((grobs-created . (MeasureCounter))
+ (events-accepted . (measure-counter-event))
+ (properties-read . (currentCommandColumn
+ measurePosition
+ currentBarNumber))
+ (properties-written . ())
+ (description . "\
+This engraver numbers ranges of measures, which is useful in parts as an
+aid for counting repeated measures. There is no requirement that the
+affected measures be repeated, however. The user delimits the area to
+receive a count with @code{\\startMeasureCount} and
+@code{\\stopMeasureCount}.")))
+
+(ly:register-translator
+ Span_stem_engraver 'Span_stem_engraver
+ '((grobs-created . (Stem))
+ (events-accepted . ())
+ (properties-read . ())
+ (properties-written . ())
+ (description . "Connect cross-staff stems to the stems above in the system")))
+
+(define-public (Merge_rests_engraver context)
+"Engraver to merge rests in multiple voices on the same staff.
+
+This works by gathering all rests at a time step. If they are all of the same
+length and there are at least two they are moved to the correct location as
+if there were one voice."
+
+ (define (is-single-bar-rest? mmrest)
+ (eqv? (ly:grob-property mmrest 'measure-count) 1))
+
+ (define (is-whole-rest? rest)
+ (eqv? (ly:grob-property rest 'duration-log) 0))
+
+ (define (mmrest-offset mmrest)
+ "For single measures they should hang from the second line from the top
+ (offset of 1). For longer multimeasure rests they should be centered on the
+ middle line (offset of 0).
+ NOTE: For one-line staves full single measure rests should be positioned at
+ 0, but I don't anticipate this engraver's use in that case. No errors are
+ given in this case."
+ (if (is-single-bar-rest? mmrest) 1 0))
+
+ (define (rest-offset rest)
+ (if (is-whole-rest? rest) 1 0))
+
+ (define (rest-eqv rest-len-prop)
+ "Compare rests according the given property"
+ (define (rest-len rest) (ly:grob-property rest rest-len-prop))
+ (lambda (rest-a rest-b)
+ (eqv? (rest-len rest-a) (rest-len rest-b))))
+
+ (define (rests-all-unpitched rests)
+ "Returns true when all rests do not override the staff-position grob
+ property. When a rest has a position set we do not want to merge rests at
+ that position."
+ (every (lambda (rest) (null? (ly:grob-property rest 'staff-position))) rests))
+
+ (define (merge-mmrests rests)
+ "Move all multimeasure rests to the single voice location."
+ (if (all-equal rests (rest-eqv 'measure-count))
+ (merge-rests rests mmrest-offset)))
+
+ (define (merge-rests rests offset-function)
+ (let ((y-offset (offset-function (car rests))))
+ (for-each
+ (lambda (rest) (ly:grob-set-property! rest 'Y-offset y-offset))
+ rests))
+ (for-each
+ (lambda (rest) (ly:grob-set-property! rest 'transparent #t))
+ (cdr rests)))
+
+ (define has-one-or-less (lambda (lst) (or (null? lst) (null? (cdr lst)))))
+ (define has-at-least-two (lambda (lst) (not (has-one-or-less lst))))
+ (define (all-equal lst pred)
+ (or (has-one-or-less lst)
+ (and (pred (car lst) (cadr lst)) (all-equal (cdr lst) pred))))
+
+ (let ((curr-mmrests '())
+ (mmrests '())
+ (rests '()))
+ (make-engraver
+ ((start-translation-timestep translator)
+ (set! rests '())
+ (set! curr-mmrests '()))
+ (acknowledgers
+ ((rest-interface engraver grob source-engraver)
+ (cond
+ ((ly:context-property context 'suspendRestMerging #f)
+ #f)
+ ((grob::has-interface grob 'multi-measure-rest-interface)
+ (set! curr-mmrests (cons grob curr-mmrests)))
+ (else
+ (set! rests (cons grob rests))))))
+ ((stop-translation-timestep translator)
+ (if (and
+ (has-at-least-two rests)
+ (all-equal rests (rest-eqv 'duration-log))
+ (rests-all-unpitched rests))
+ (merge-rests rests rest-offset))
+ (if (has-at-least-two curr-mmrests)
+ (set! mmrests (cons curr-mmrests mmrests))))
+ ((finalize translator)
+ (for-each merge-mmrests mmrests)))))
projects / lilypond.git / blobdiff