From: David Kastrup <dak@gnu.org>
Date: Wed, 4 Dec 2013 09:00:38 +0000 (+0100)
Subject: Implement event-chord-reduce for reducing chords to single notes
X-Git-Tag: release/2.19.0-1~111
X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=ec5fd52f03ae1abe8de998e8b3ab27f12443805b;p=lilypond.git

Implement event-chord-reduce for reducing chords to single notes
---

diff --git a/scm/music-functions.scm b/scm/music-functions.scm
index d3d720276b..a5aa02fdd1 100644
--- a/scm/music-functions.scm
+++ b/scm/music-functions.scm
@@ -20,6 +20,7 @@
 (use-modules (scm safe-utility-defs))
 
 (use-modules (ice-9 optargs))
+(use-modules (srfi srfi-11))
 
 ;;; ly:music-property with setter
 ;;; (ly:music-property my-music 'elements)
@@ -1969,6 +1970,37 @@ yourself."
   (map (lambda (x) (ly:music-property x 'pitch))
        (event-chord-notes event-chord)))
 
+(define-public (event-chord-reduce music)
+  "Reduces event chords in @var{music} to their first note event,
+retaining only the chord articulations.  Returns the modified music."
+  (map-some-music
+   (lambda (m)
+     (and (music-is-of-type? m 'event-chord)
+          (let*-values (((notes arts) (partition
+                                       (lambda (mus)
+                                         (music-is-of-type? mus 'rhythmic-event))
+                                       (ly:music-property m 'elements)))
+                        ((dur) (ly:music-property m 'duration))
+                        ((full-arts) (append arts
+                                             (ly:music-property m 'articulations)))
+                        ((first-note) (and (pair? notes) (car notes))))
+            (cond (first-note
+                   (set! (ly:music-property first-note 'articulations)
+                         full-arts)
+                   first-note)
+                  ((ly:duration? dur)
+                   ;; A repeat chord. Produce an unpitched note.
+                   (make-music 'NoteEvent
+                               'duration dur
+                               'articulations full-arts))
+                  (else
+                   (ly:music-error m (_ "Missing duration"))
+                   (make-music 'NoteEvent
+                               'duration (ly:make-duration 2 0 0)
+                               'articulations full-arts))))))
+   music))
+
+
 (defmacro-public make-relative (variables reference music)
   "The list of pitch or music variables in @var{variables} is used as
 a sequence for creating relativable music from @var{music}.