Re: Change \retrograde to deal with ties and repeat chords/notes (issue 302470043 by address@hidden)

[dak]

Reviewers: thomasmorley651,


https://codereview.appspot.com/302470043/diff/1/scm/modal-transforms.scm
File scm/modal-transforms.scm (right):

https://codereview.appspot.com/302470043/diff/1/scm/modal-transforms.scm#newcode188
scm/modal-transforms.scm:188: ;; See also LSR #105.
On 2016/08/16 06:23:17, thomasmorley651 wrote:
> There is no LSR-snippet 105. Must have been deleted somewhen in the
past.
> Actually the entire LSR doesn't mention retrograde at all nowadays.

Done.

Namely, removed that line.  Will not reupload a new review just for
that, however.

Description:
Change \retrograde to deal with ties and repeat chords/notes


Consists of commits:

Remove warning about ties in \retrograde


Change retrograde-music function to deal with ties


Let \retrograde expand repeat chords/notes

Since those lose their point of reference, expanding them
prior to retrograding keeps the results sane.

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

Affected files (+64, -28 lines):
  M Documentation/notation/pitches.itely
  M ly/music-functions-init.ly
  M scm/modal-transforms.scm


Index: Documentation/notation/pitches.itely
diff --git a/Documentation/notation/pitches.itely  
b/Documentation/notation/pitches.itely
index  
0699239db55b6e8bdc52a3add4b21dd39d3d926a..b34ec98fb88b638ea0003d3cc27673afe5691b59  
100644
--- a/Documentation/notation/pitches.itely
+++ b/Documentation/notation/pitches.itely
@@ -902,11 +902,6 @@ music = \relative { c'8. ees16( fis8. a16 b8.) gis16  
f8. d16 }
 }
 @end lilypond

address@hidden
-Manual ties inside @code{\retrograde} will be broken and
-generate warnings.  Some ties can be generated automatically
-by enabling @ref{Automatic note splitting}.
-
 @seealso
 Notation Reference:
 @ref{Inversion},
Index: ly/music-functions-init.ly
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index  
ee9fdb8c2064b604e8123b0032bdd730f41d5f99..76c2ec64b882f079ec9fbf441076cfc30a305631  
100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -1551,7 +1551,12 @@ retrograde =
 #(define-music-function (music)
     (ly:music?)
     (_i "Return @var{music} in reverse order.")
-    (retrograde-music music))
+    (retrograde-music
+     (expand-repeat-notes!
+      (expand-repeat-chords!
+       (cons 'rhythmic-event
+             (ly:parser-lookup '$chord-repeat-events))
+       music))))

 revertTimeSignatureSettings =
 #(define-music-function
Index: scm/modal-transforms.scm
diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
index  
98e9ac3021750bd510e9e9b276944820ab730fd4..5e0ce7ef1c31e5c8544e1cb0b8463ec3f8c6eca6  
100644
--- a/scm/modal-transforms.scm
+++ b/scm/modal-transforms.scm
@@ -185,32 +185,68 @@ Typically used to construct a scale for input to

 (define-public (retrograde-music music)
   "Returns @var{music} in retrograde (reversed) order."
-  ;; Copied from LSR #105 and renamed.
+  ;; See also LSR #105.
   ;; Included here to allow this module to provide a complete set of
   ;; common formal operations on motives, i.e transposition,
   ;; inversion and retrograding.

-  (let* ((elements (ly:music-property music 'elements))
-         (arts (ly:music-property music 'articulations))
-         (reversed (reverse elements))
-         (element (ly:music-property music 'element))
-         (span-dir (ly:music-property music 'span-direction)))
-
-    (ly:music-set-property! music 'elements reversed)
-
-    (for-each retrograde-music arts)
-
-    (if (ly:music? element)
-        (ly:music-set-property!
-         music 'element
-         (retrograde-music element)))
-
-    (if (ly:dir? span-dir)
-        (ly:music-set-property! music 'span-direction (- span-dir)))
-
-    (for-each retrograde-music reversed)
-
-    music))
+  (define (reverse-span! m)
+    ;; invert direction of two-sided spanners
+    (let ((spd (ly:music-property m 'span-direction)))
+      (if (ly:dir? spd)
+          (set! (ly:music-property m 'span-direction) (- spd)))))
+
+  ;; carryover is a possible list of tie events, the loop returns any
+  ;; such trailing list from the given expression
+  (define (loop m carryover)
+    (define (filter-ties! carryover field)
+      (let ((vals (ly:music-property m field)))
+        (if (pair? vals)
+            (call-with-values
+                (lambda ()
+                  (partition! (music-type-predicate 'tie-event) vals))
+              (lambda (ties no-ties)
+                (for-each reverse-span! no-ties)
+                (set! (ly:music-property m field)
+                      (append! no-ties carryover))
+                ties))
+            (begin
+              (if (pair? carryover)
+                  (set! (ly:music-property m field) carryover))
+              '()))))
+
+    (cond ((music-is-of-type? m 'event-chord)
+           (append!
+            (filter-ties! carryover 'elements)
+            ;; articulations on an event-chord do not occur
+            ;; "naturally" but are supported when user-generated
+            ;; elsewhere, so we treat them properly
+            (filter-ties! '() 'articulations)))
+
+          ((music-is-of-type? m 'rhythmic-event)
+           (filter-ties! carryover 'articulations))
+
+          ;; The following is hardly correct but tieing inside of
+          ;; <<...>> is really beyond our pay grade.
+          ((music-is-of-type? m 'simultaneous-music)
+           (append-map! (lambda (m) (loop m (ly:music-deep-copy  
carryover)))
+                        (ly:music-property m 'elements)))
+          (else
+           (reverse-span! m)
+           (let ((elt (ly:music-property m 'element))
+                 (elts (ly:music-property m 'elements)))
+             (let ((res
+                    (fold loop
+                          (if (ly:music? elt) (loop elt carryover)  
carryover)
+                          elts)))
+               (if (pair? elts)
+                   (set! (ly:music-property m 'elements) (reverse! elts)))
+               (append! res (filter-ties! '() 'articulations)))))))
+  (let ((dangling (loop music '())))
+    (for-each
+     (lambda (t) (ly:music-warning t (_ "Dangling tie in \\retrograde")))
+     dangling))
+  music)

 (define-public (pitch-invert around to music)
   "If @var{music} is a single pitch, inverts it about @var{around}