Re: Merge Rests Engraver

[Jay Anderson]

On Wed, Feb 22, 2012 at 10:17 PM, Jay Anderson <address@hidden> wrote:
> On Wed, Feb 22, 2012 at 8:45 AM, David Nalesnik
> <address@hidden> wrote:
>> I don't have an answer to your question about overlapping grobs, just a
>> suggestion: could you generalize this to deal with more than two voices?
>>  (Maybe you could collect the acknowledged rests into a list, rather than
>> using separate variables rest-a, rest-b, etc. Just a thought.)
>
> Is this ever done though? I've only ever seen rests combined with two
> voices. It would also complicate things somewhat, but it could be
> doable. We have to check that all rests found at a time step are the
> same length. Also, I don't think it would ever make sense to attempt
> to merge a subset. All or nothing.

Below I made the engravers more general. They work with more than 2
voices. Rests are merged only when rests in all voices at a certain
time are of equal length.

This is good enough for my purposes. I'd be nice to figure out how to
kill the grobs but I haven't been able to do it without causing a
segfault.

Any more comments? Thanks!

-----Jay

\version "2.15.30"

#(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))))

#(define merge-rests-engraver
   (lambda (context)
     (let ((rest-same-length
             (lambda (rest-a rest-b)
               (eq? (ly:grob-property rest-a 'duration-log)
(ly:grob-property rest-b 'duration-log))))
           (rests '()))
     `((start-translation-timestep . ,(lambda (trans)
                                        (set! rests '())))
       (stop-translation-timestep . ,(lambda (trans)
                                       (if (and (has-at-least-two
rests) (all-equal rests rest-same-length))
                                         (for-each
                                           (lambda (rest)
(ly:grob-set-property! rest 'Y-offset 0))
                                           rests))))
       (acknowledgers
         (rest-interface . ,(lambda (engraver grob source-engraver)
                              (if (eq? 'Rest (assoc-ref
(ly:grob-property grob 'meta) 'name))
                                (set! rests (cons grob rests))))))))))

#(define merge-mmrests-engraver
   (lambda (context)
     (let* ((mmrest-same-length
              (lambda (rest-a rest-b)
                (eq? (ly:grob-property rest-a 'measure-count)
(ly:grob-property rest-b 'measure-count))))
            (merge-mmrests
              (lambda (rests)
                (if (all-equal rests mmrest-same-length)
                  (let ((offset (if (eq? (ly:grob-property (car rests)
'measure-count) 1) 1 0)))
                    (for-each
                      (lambda (rest) (ly:grob-set-property! rest
'Y-offset offset))
                      rests)))))
            (curr-rests '())
            (rests '()))
     `((start-translation-timestep . ,(lambda (trans)
                                        (set! curr-rests '())))
       (stop-translation-timestep . ,(lambda (trans)
                                       (if (has-at-least-two curr-rests)
                                         (set! rests (cons curr-rests rests)))))
       (finalize . ,(lambda (translator)
                      (for-each merge-mmrests rests)))
       (acknowledgers
         (rest-interface . ,(lambda (engraver grob source-engraver)
                              (if (eq? 'MultiMeasureRest (assoc-ref
(ly:grob-property grob 'meta) 'name))
                                (set! curr-rests (cons grob curr-rests))))))))))