86 lines
3.1 KiB
Plaintext
86 lines
3.1 KiB
Plaintext
Better_Merge_rests_engraver =
|
|
#(lambda (context)
|
|
(define (has-one-or-less? lst) (or (null? lst) (null? (cdr lst))))
|
|
(define (has-at-least-two? 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))))
|
|
(define (measure-count-eqv? a b)
|
|
(eqv?
|
|
(ly:grob-property a 'measure-count)
|
|
(ly:grob-property b 'measure-count)))
|
|
|
|
(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 (less-by-layer a b)
|
|
(<
|
|
(ly:grob-property b 'layer 0)
|
|
(ly:grob-property a 'layer 0)))
|
|
|
|
(define (merge-mmrests mmrests)
|
|
"Move all multimeasure rests to the single voice location."
|
|
(if (all-equal? mmrests measure-count-eqv?)
|
|
(begin
|
|
(for-each
|
|
(lambda (rest) (ly:grob-set-property! rest 'direction CENTER))
|
|
mmrests)
|
|
(for-each
|
|
(lambda (rest) (ly:grob-set-property! rest 'transparent #t))
|
|
(cdr (sort mmrests less-by-layer))))))
|
|
|
|
(define (merge-rests rests)
|
|
(for-each
|
|
(lambda (rest) (ly:grob-set-property! rest 'staff-position 0))
|
|
rests)
|
|
(for-each
|
|
(lambda (rest) (ly:grob-set-property! rest 'transparent #t))
|
|
(cdr (sort rests less-by-layer))))
|
|
|
|
(let ((mmrests '())
|
|
(rests '())
|
|
(dots '()))
|
|
(make-engraver
|
|
((start-translation-timestep translator)
|
|
(set! rests '())
|
|
(set! mmrests '())
|
|
(set! dots '()))
|
|
(acknowledgers
|
|
((dot-column-interface engraver grob source-engraver)
|
|
(if (not (ly:context-property context 'suspendRestMerging #f))
|
|
(set!
|
|
dots
|
|
(append (ly:grob-array->list (ly:grob-object grob 'dots))
|
|
dots))))
|
|
((rest-interface engraver grob source-engraver)
|
|
(cond
|
|
((ly:context-property context 'suspendRestMerging #f)
|
|
#f)
|
|
((grob::has-interface grob 'multi-measure-rest-interface)
|
|
(set! mmrests (cons grob mmrests)))
|
|
(else
|
|
(set! rests (cons grob rests))))))
|
|
((stop-translation-timestep translator)
|
|
(let (;; get a list of the rests 'duration-lengths, 'duration-log does
|
|
;; not take dots into account
|
|
(durs
|
|
(map
|
|
(lambda (g)
|
|
(ly:duration->moment
|
|
(ly:prob-property
|
|
(ly:grob-property g 'cause)
|
|
'duration)))
|
|
rests)))
|
|
(if (and
|
|
(has-at-least-two? rests)
|
|
(all-equal? durs equal?)
|
|
(rests-all-unpitched? rests))
|
|
(begin
|
|
(merge-rests rests)
|
|
;; ly:grob-suicide! works nicely for dots, as opposed to rests.
|
|
(if (pair? dots) (for-each ly:grob-suicide! (cdr dots)))))
|
|
(if (has-at-least-two? mmrests)
|
|
(merge-mmrests mmrests))))))) |