From a2eb9d0a93abab905d4d88c33921ee1b8b8cb67c Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Fri, 14 Jan 2011 21:09:57 +0100
Subject: [PATCH] Implement compound time signatures

\compoundMeter is a replacement for \time, allowing complex time
signatures (like (1+3)/8 or 3/8+(2+5)/16, etc.).

The argument to the music function is a list of lists, each
describing one fraction in the signature.
---
 Documentation/changes.tely                   |  14 +++
 input/regression/compound-time-signatures.ly |  44 ++++++++
 ly/music-functions-init.ly                   |  28 +++++
 scm/time-signature-settings.scm              |  99 ++++++++++++++++++
 scripts/musicxml2ly.py                       | 103 -------------------
 5 files changed, 185 insertions(+), 103 deletions(-)
 create mode 100644 input/regression/compound-time-signatures.ly

diff --git a/Documentation/changes.tely b/Documentation/changes.tely
index 8dcbd6426b..c5ddc51b63 100644
--- a/Documentation/changes.tely
+++ b/Documentation/changes.tely
@@ -66,6 +66,20 @@ which scares away people.
 
 @end ignore
 
+@item
+Compound time signatures are now supported by the @code{\compoundMeter} command,
+which can be used instead of @code{\time}:
+@lilypond
+\relative c'' {
+  \compoundMeter #'(3 1 8)
+  c8 c c c
+  \compoundMeter #'((2 8) (5 8))
+  c8 c c c c c c
+  \compoundMeter #'((1 2 3 8) (1 4) (3 8))
+  c8 c c c c c c4 c8 c c
+}
+@end lilypond
+
 @item
 Lyrics above a staff must have their @code{staff-affinity} set to
 @code{DOWN} or must have their @code{alignAboveContext} property
diff --git a/input/regression/compound-time-signatures.ly b/input/regression/compound-time-signatures.ly
new file mode 100644
index 0000000000..e5e5dcd83d
--- /dev/null
+++ b/input/regression/compound-time-signatures.ly
@@ -0,0 +1,44 @@
+\version "2.13.47"
+
+\header {
+    texidoc = "Create compound time signatures. The argument is a Scheme list
+of lists. Each list describes one fraction, with the last entry being the
+denominator, while the first entries describe the summands in the
+enumerator. If the time signature consists of just one fraction,
+the list can be given directly, i.e. not as a list containing a single list.
+For example, a time signature of (3+1)/8 + 2/4 would be created as
+@code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8
+as @code{\\compoundMeter #'((3 2 8))} or shorter
+@code{\\compoundMeter #'(3 2 8)}.
+"
+}
+
+
+
+\relative c' {
+  \compoundMeter #'(1 2 3 4 8)
+  \repeat unfold 10 c8 \repeat unfold 20 c16 \break
+
+  \time 3/4
+  \repeat unfold 6 c8 \repeat unfold 12 c16 \break
+
+  \compoundMeter #'((1 2 3 4 8) (2 4))
+  \repeat unfold 14 c8 \repeat unfold 28 c16 \break
+
+  \compoundMeter #'((1 2 3 4 8) (2 4) (2 3 8))
+  \repeat unfold 19 c8 \repeat unfold 38 c16 \break
+
+  \compoundMeter #'(1 2 3 4 8)
+  \repeat unfold 10 c8 \repeat unfold 20 c16 \break
+
+  \compoundMeter #'((1 8) (3 8))
+  \repeat unfold 4 c8 \repeat unfold 8 c16 \break
+
+  \compoundMeter #'((3 8) (1 8))
+  \repeat unfold 4 c8 \repeat unfold 8 c16 \break
+
+  \time 4/4
+  \repeat unfold 8 c8 \repeat unfold 16 c16 \break
+
+  \bar"|."
+}
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index 8cfaa81d31..a307f0ca89 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -214,6 +214,34 @@ clef =
    (_i "Set the current clef to @var{type}.")
    (make-clef-set type))
 
+
+compoundMeter =
+#(define-music-function (parser location args) (pair?)
+  (_i "Create compound time signatures. The argument is a Scheme list of 
+lists. Each list describes one fraction, with the last entry being the 
+denominator, while the first entries describe the summands in the 
+enumerator. If the time signature consists of just one fraction, 
+the list can be given directly, i.e. not as a list containing a single list.
+For example, a time signature of (3+1)/8 + 2/4 would be created as 
+@code{\\compoundMeter #'((3 1 8) (2 4))}, and a time signature of (3+2)/8 
+as @code{\\compoundMeter #'((3 2 8))} or shorter 
+@code{\\compoundMeter #'(3 2 8)}.")
+  (let* ((mlen (calculate-compound-measure-length args))
+         (beat (calculate-compound-base-beat args))
+         (beatGrouping (calculate-compound-beat-grouping args))
+         (timesig (cons (ly:moment-main-numerator mlen)
+                        (ly:moment-main-denominator mlen))))
+  #{
+    \once \override Staff.TimeSignature #'stencil = #(lambda (grob)
+		(grob-interpret-markup grob (format-compound-time $args)))
+    \set Timing.timeSignatureFraction = $timesig
+    \set Timing.baseMoment = $beat
+    \set Timing.beatStructure = $beatGrouping
+    \set Timing.beamExceptions = #'()
+    \set Timing.measureLength = $mlen
+  #} ))
+
+
 cueClef =
 #(define-music-function (parser location type) (string?)
   (_i "Set the current cue clef to @var{type}.")
diff --git a/scm/time-signature-settings.scm b/scm/time-signature-settings.scm
index e6141d4836..4046282a93 100644
--- a/scm/time-signature-settings.scm
+++ b/scm/time-signature-settings.scm
@@ -302,3 +302,102 @@ with the new setting alist @var{setting}. "
           'timeSignatureSettings
           time-signature)))
     'Timing))
+
+
+
+
+;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+;;; Formatting of complex/compound time signatures
+
+(define (insert-markups l m)
+  (let ((ll (reverse l)))
+    (let join-markups ((markups (list (car ll)))
+                       (remaining (cdr ll)))
+      (if (pair? remaining)
+          (join-markups (cons (car remaining) (cons m markups)) (cdr remaining))
+          markups))))
+
+;;; Use a centered-column inside a left-column, because the centered column
+;;; moves its reference point to the center, which the left-column undoes.
+(define (format-time-fraction time-sig-fraction)
+  (let* ((revargs (reverse (map number->string time-sig-fraction)))
+         (den (car revargs))
+         (nums (reverse (cdr revargs))))
+    (make-override-markup '(baseline-skip . 0)
+      (make-number-markup
+        (make-left-column-markup (list
+          (make-center-column-markup (list
+            (make-line-markup (insert-markups nums "+"))
+            den))))))))
+
+(define (format-complex-compound-time time-sig)
+  (make-override-markup '(baseline-skip . 0)
+    (make-number-markup
+      (make-line-markup
+        (insert-markups (map format-time-fraction time-sig)
+                        (make-vcenter-markup "+"))))))
+
+(define-public (format-compound-time time-sig)
+  (cond
+    ((not (pair? time-sig)) (null-markup))
+    ((pair? (car time-sig)) (format-complex-compound-time time-sig))
+    (else (format-time-fraction time-sig))))
+
+
+;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+;;; Measure length calculation of (possibly complex) compound time signatures
+
+(define (calculate-time-fraction time-sig-fraction)
+  (let* ((revargs (reverse time-sig-fraction))
+         (den (car revargs))
+         (num (apply + (cdr revargs))))
+    (ly:make-moment num den)))
+
+(define (calculate-complex-compound-time time-sig)
+  (let add-moment ((moment ZERO-MOMENT)
+                   (remaining (map calculate-time-fraction time-sig)))
+    (if (pair? remaining)
+        (add-moment (ly:moment-add moment (car remaining)) (cdr remaining))
+        moment)))
+
+(define-public (calculate-compound-measure-length time-sig)
+  (cond
+    ((not (pair? time-sig)) (ly:make-moment 4 4))
+    ((pair? (car time-sig)) (calculate-complex-compound-time time-sig))
+    (else (calculate-time-fraction time-sig))))
+
+
+;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+;;; Base beat length: Use the smallest denominator from all fraction
+
+(define (calculate-compound-base-beat-full time-sig)
+  (apply max (map last time-sig)))
+
+(define-public (calculate-compound-base-beat time-sig)
+  (ly:make-moment 1
+    (cond
+      ((not (pair? time-sig)) 4)
+      ((pair? (car time-sig)) (calculate-compound-base-beat-full time-sig))
+      (else (calculate-compound-base-beat-full (list time-sig))))))
+
+
+;;;%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+;;; Beat Grouping
+
+(define (normalize-fraction frac beat)
+  (let* ((thisbeat (car (reverse frac)))
+         (factor (/ beat thisbeat)))
+    (map (lambda (f) (* factor f)) frac)))
+
+(define (beat-grouping-internal time-sig)
+  ;; Normalize to given beat, extract the beats and join them to one list
+  (let* ((beat (calculate-compound-base-beat-full time-sig))
+         (normalized (map (lambda (f) (normalize-fraction f beat)) time-sig))
+         (beats (map (lambda (f) (reverse (cdr (reverse f)))) normalized)))
+    (apply append beats)))
+
+(define-public (calculate-compound-beat-grouping time-sig)
+  (cond
+    ((not (pair? time-sig)) '(2 . 2))
+    ((pair? (car time-sig)) (beat-grouping-internal time-sig))
+    (else (beat-grouping-internal (list time-sig)))))
diff --git a/scripts/musicxml2ly.py b/scripts/musicxml2ly.py
index 6c6f13c27c..76d989f7a0 100644
--- a/scripts/musicxml2ly.py
+++ b/scripts/musicxml2ly.py
@@ -69,107 +69,6 @@ additional_definitions = {
            (num (if numerator numerator (ly:event-property ev 'numerator))))
        (format "~a:~a" den num)))
 """,
-
-  "compound-time-signature": """%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% Formatting of (possibly complex) compound time signatures
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-#(define-public (insert-markups l m)
-  (let* ((ll (reverse l)))
-    (let join-markups ((markups (list (car ll)))
-                       (remaining (cdr ll)))
-      (if (pair? remaining)
-        (join-markups (cons (car remaining) (cons m markups)) (cdr remaining))
-        markups))))
-
-% Use a centered-column inside a left-column, because the centered column
-% moves its reference point to the center, which the left-column undoes.
-% The center-column also aligns its contented centered, which is not undone...
-#(define-public (format-time-fraction time-sig-fraction)
-  (let* ((revargs (reverse (map number->string time-sig-fraction)))
-         (den (car revargs))
-         (nums (reverse (cdr revargs))))
-    (make-override-markup '(baseline-skip . 0)
-      (make-number-markup
-        (make-left-column-markup (list
-          (make-center-column-markup (list
-            (make-line-markup (insert-markups nums "+"))
-            den))))))))
-
-#(define-public (format-complex-compound-time time-sig)
-  (let* ((sigs (map format-time-fraction time-sig)))
-    (make-override-markup '(baseline-skip . 0)
-      (make-number-markup
-        (make-line-markup
-          (insert-markups sigs (make-vcenter-markup "+")))))))
-
-#(define-public (format-compound-time time-sig)
-  (cond
-    ((not (pair? time-sig)) (null-markup))
-    ((pair? (car time-sig)) (format-complex-compound-time time-sig))
-    (else (format-time-fraction time-sig))))
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% Measure length calculation of (possibly complex) compound time signatures
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-#(define-public (calculate-time-fraction time-sig-fraction)
-  (let* ((revargs (reverse time-sig-fraction))
-         (den (car revargs))
-         (nums (cdr revargs)))
-    (ly:make-moment (apply + nums) den)))
-
-#(define-public (calculate-complex-compound-time time-sig)
-  (let* ((sigs (map calculate-time-fraction time-sig)))
-    (let add-moment ((moment ZERO-MOMENT)
-                     (remaining sigs))
-      (if (pair? remaining)
-        (add-moment (ly:moment-add moment (car remaining)) (cdr remaining))
-        moment))))
-
-#(define-public (calculate-compound-measure-length time-sig)
-  (cond
-    ((not (pair? time-sig)) (ly:make-moment 4 4))
-    ((pair? (car time-sig)) (calculate-complex-compound-time time-sig))
-    (else (calculate-time-fraction time-sig))))
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% Base beat lenth
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-#(define-public (calculate-compound-base-beat-full time-sig)
-  (let* ((den (map last time-sig)))
-    (apply max den)))
-
-#(define-public (calculate-compound-base-beat time-sig)
-  (ly:make-moment 1 (cond
-    ((not (pair? time-sig)) 4)
-    ((pair? (car time-sig)) (calculate-compound-base-beat-full time-sig))
-    (else (calculate-compound-base-beat-full (list time-sig))))))
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-% The music function to set the complex time signature
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-compoundMeter =
-#(define-music-function (parser location args) (pair?)
-  (let ((mlen (calculate-compound-measure-length args))
-        (beat (calculate-compound-base-beat args)))
-  #{
-\once \override Staff.TimeSignature #'stencil = #ly:text-interface::print
-\once \override Staff.TimeSignature #'text = #(format-compound-time $args)
-% \set Staff.beatGrouping = #(reverse (cdr (reverse $args)))
-\set Timing.measureLength = $mlen
-\set Timing.timeSignatureFraction = #(cons (ly:moment-main-numerator $mlen)
-                                           (ly:moment-main-denominator $mlen))
-\set Timing.baseMoment = $beat
-
-% TODO: Implement beatGrouping and auto-beam-settings!!!
-#} ))
-"""
 }
 
 def round_to_two_digits (val):
@@ -839,8 +738,6 @@ def musicxml_time_to_lily (attributes):
         return None
     change = musicexp.TimeSignatureChange()
     change.fractions = sig
-    if (len(sig) != 2) or isinstance (sig[0], list):
-        needed_additional_definitions.append ("compound-time-signature")
 
     time_elm = attributes.get_maybe_exist_named_child ('time')
     if time_elm and hasattr (time_elm, 'symbol'):
-- 
2.39.2