Let Merge_rests_engraver deal with dotted rests (issue 324310043 by address@hidden)

[thomasmorley65]

Reviewers: ,

Message:
Please review.

Does this engraver needs an entry via ly:register-translator like the
Measure_counter_engraver in the same file (scheme-engravers.scm)?

Description:
Let Merge_rests_engraver deal with dotted rests

Compare simple rests by their duration-length, duration-log does
not take possible dots into account.
Superfluous dots are killed with ly:grob-suicide!

Please review this at https://codereview.appspot.com/324310043/

Affected files (+45, -9 lines):
  M input/regression/merge-rests-engraver.ly
  M scm/scheme-engravers.scm


Index: input/regression/merge-rests-engraver.ly
diff --git a/input/regression/merge-rests-engraver.ly  
b/input/regression/merge-rests-engraver.ly
index  
688fc31f79a131cf9e3405d54199cdefaf1c4cd0..c9b8d0a499b9bd31e94b09216aa391effab3b507  
100644
--- a/input/regression/merge-rests-engraver.ly
+++ b/input/regression/merge-rests-engraver.ly
@@ -46,6 +46,14 @@ voiceA = \relative {

   % Don't merge pitched rests
   c4\rest d\rest e\rest f\rest |
+
+  % Merged dotted rests get only one dot, don't kill dots if merging rests  
is
+  % suspended
+  r4. r8
+  \set Staff.suspendRestMerging = ##t
+  r4. r8 |
+  \set Staff.suspendRestMerging = ##f
+  r4 r4 r4 r4
 }

 voiceB = \relative {
@@ -60,11 +68,16 @@ voiceB = \relative {
   r1 r1 |
   r4 r8 r r2 |
   r4 r r r |
+  r4. r8 r4. r8 |
+  r4. r8 r4. r8 |
 }

 voiceC = \relative {
   s1*2 |
   r2 r4 r8 r16 r32 r64 r128 r | % Combines rests from more than 2 voices
+  s1*11
+  r4. r8 r4. r8 |
+  r4. r8 r4. r8 |
 }

 \score {
Index: scm/scheme-engravers.scm
diff --git a/scm/scheme-engravers.scm b/scm/scheme-engravers.scm
index  
b2966d79e61281e985f8af35d4ca475ef074a2b8..22dfad1745f3f6b2fae48fee051d0e0795ad7228  
100644
--- a/scm/scheme-engravers.scm
+++ b/scm/scheme-engravers.scm
@@ -174,15 +174,23 @@ if there were one voice."
   (define (all-equal lst pred)
     (or (has-one-or-less lst)
         (and (pred (car lst) (cadr lst)) (all-equal (cdr lst) pred))))
+  (define moment=?
+    (lambda (a b) (not (or (ly:moment<? a b) (ly:moment<? b a)))))

   (let ((curr-mmrests '())
         (mmrests '())
-        (rests '()))
+        (rests '())
+        (dots '()))
     (make-engraver
       ((start-translation-timestep translator)
         (set! rests '())
-        (set! curr-mmrests '()))
+        (set! curr-mmrests '())
+        (set! dots '()))
       (acknowledgers
+        ((dot-column-interface engraver grob source-engraver)
+         (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)
@@ -192,12 +200,27 @@ if there were one voice."
             (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))))
+        (let (;; get a list of the rests 'duration-lengths, 'duration-log  
does
+              ;; not take dots into account
+              (durs
+                (map
+                  (lambda (g)
+                    (ly:duration-length
+                      (ly:prob-property
+                        (ly:grob-property g 'cause)
+                        'duration)))
+                  rests)))
+          (if (and
+                (has-at-least-two rests)
+                (all-equal durs moment=?)
+                (rests-all-unpitched rests))
+              (merge-rests rests rest-offset))
+          (if (has-at-least-two curr-mmrests)
+              (set! mmrests (cons curr-mmrests mmrests)))
+          ;; ly:grob-suicide! works nicely for dots, as opposed to rests.
+          (if (and (pair? dots)
+                   (all-equal durs moment=?)
+                   (not (ly:context-property context 'suspendRestMerging  
#f)))
+              (for-each ly:grob-suicide! (cdr dots)))))
       ((finalize translator)
         (for-each merge-mmrests mmrests)))))