X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fscheme-engravers.scm;h=b2966d79e61281e985f8af35d4ca475ef074a2b8;hb=212ca268e813cd72eca8c07e714e1b6669cba747;hp=ccb1fb5b0d1a93b89d08db3e8366d1fee26cbacc;hpb=d2762a4f1add2bb04d6fc34d3c7ae03eeb7d500f;p=lilypond.git diff --git a/scm/scheme-engravers.scm b/scm/scheme-engravers.scm index ccb1fb5b0d..b2966d79e6 100644 --- a/scm/scheme-engravers.scm +++ b/scm/scheme-engravers.scm @@ -15,6 +15,12 @@ ;;;; You should have received a copy of the GNU General Public License ;;;; along with LilyPond. If not, see . +(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 @@ -30,22 +36,22 @@ receive a count with @code{\\startMeasureCount} and (make-engraver (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))))) + ((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)) @@ -79,7 +85,7 @@ receive a count with @code{\\startMeasureCount} and (set! (ly:grob-property c 'count-from) (+ counter elapsed)) (set! count-spanner c) (set! elapsed (1+ elapsed)))))) - (set! last-measure-seen current-bar))) + (set! last-measure-seen current-bar))) ((finalize trans) (if go? @@ -88,3 +94,110 @@ receive a count with @code{\\startMeasureCount} and (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)))))