Add modal transformations

6 files changed, 484 insertions, 11 deletions

diff --git a/Documentation/changes.tely b/Documentation/changes.tely
index f2a4b4c797..002f6a89cf 100644
--- a/Documentation/changes.tely
+++ b/Documentation/changes.tely
@@ -62,6 +62,36 @@ which scares away people.
 @end ignore
 
 @item
+A minimal composer toolkit of modal transformations is provided.
+A motif may be @notation{transposed}, @notation{inverted} and/or
+converted to its @notation{retrograde} within any scale.
+
+@lilypond
+pentatonicScale = \relative a' { a c d f g }
+motif = \relative c'' { d8 c f,4 <a f'> <a f'> }
+
+\new Staff <<
+  {
+    \partial 4
+    \pentatonicScale
+    \motif
+    \modalTranspose c a, \pentatonicScale \motif
+    \modalInversion d'' a' \pentatonicScale \motif
+    \retrograde \motif
+  }
+  {
+    \partial 4
+    s4^"pentatonic scale"
+    s1
+    s1^"motif"
+    s1^"transposition"
+    s1^"inversion"
+    s1^"retrograde"
+  }
+>>
+@end lilypond
+
+@item
 Black mensural notation has minimal support.
 
 @item
diff --git a/Documentation/notation/pitches.itely b/Documentation/notation/pitches.itely
index 0db01c8bde..78a222794d 100644
--- a/Documentation/notation/pitches.itely
+++ b/Documentation/notation/pitches.itely
@@ -594,6 +594,7 @@ This section discusses how to modify pitches.
 @menu
 * Octave checks::
 * Transpose::
+* Modal transformations::
 @end menu
 
 @node Octave checks
@@ -788,6 +789,7 @@ see @ref{Instrument transpositions}.
 @seealso
 Notation Reference:
 @ref{Relative octave entry},
+@ref{Modal transformations},
 @ref{Instrument transpositions}.
 
 Snippets:
@@ -811,6 +813,170 @@ The relative conversion will not affect @code{\transpose},
 To use relative mode within transposed music, an additional
 @code{\relative} must be placed inside @code{\transpose}.
 
+@node Modal transformations
+@unnumberedsubsubsec Modal transformations
+
+@cindex modal transformations
+@cindex transformations, modal
+@cindex operations, modal
+
+In a musical composition that is based on a scale, a motif is
+frequently transformed in various ways.  It may be
+@notation{transposed} to start at different places in the scale, it
+may be @notation{inverted} around a pivot point in the scale, and/or
+it may be converted to its @notation{retrograde} (written backwards).
+
+@warning{Any note that does not lie within the given scale will be
+left untransformed.}
+
+@subsubheading Modal transposition
+
+@cindex modal transposition
+@cindex transposition, modal
+@cindex operation, transposition
+@funindex \modalTranspose
+@funindex modalTranspose
+
+A motif can be transposed within a given scale with:
+
+@example
+\modalTranspose @var{from-pitch} @var{to-pitch} @var{scale} @var{motif}
+@end example
+
+The notes of @var{motif} are shifted within the @var{scale} by the
+number of scale degrees given by the interval between @var{to-pitch}
+and @var{from-pitch}:
+
+@lilypond[verbatim,quote]
+diatonicScale = \relative c' { c d e f g a b }
+motif = \relative c' { c8 d e f g a b c }
+
+\new Staff {
+  \motif
+  \modalTranspose c f \diatonicScale \motif
+  \modalTranspose c b, \diatonicScale \motif
+}
+@end lilypond
+
+An ascending scale of any length and with any intervals may be
+specified:
+
+@lilypond[verbatim,quote]
+pentatonicScale = \relative c' { ges aes bes des ees }
+motif = \relative c' { ees8 des ges,4 <ges' bes,> <ges bes,> }
+
+\new Staff {
+  \motif
+  \modalTranspose ges ees' \pentatonicScale \motif
+}
+@end lilypond
+
+When used with a chromatic scale @code{\modalTranspose} has a
+similar effect to @code{\transpose}, but with the ability to
+specify the names of the notes to be used:
+
+@lilypond[verbatim,quote]
+chromaticScale = \relative c' { c cis d dis e f fis g gis a ais b }
+motif = \relative c' { c8 d e f g a b c }
+
+\new Staff {
+  \motif
+  \transpose c f \motif
+  \modalTranspose c f \chromaticScale \motif
+}
+@end lilypond
+
+@subsubheading Modal inversion
+
+@cindex modal inversion
+@cindex inversion, modal
+@cindex operation, inversion
+@funindex \modalInversion
+@funindex modalInversion
+
+A motif can be inverted within a given scale around a given pivot
+note and transposed in a single operation with:
+
+@example
+\modalInversion @var{around-pitch} @var{to-pitch} @var{scale} @var{motif}
+@end example
+
+The notes of @var{motif} are placed the same number of scale degrees
+from the @var{around-pitch} note within the @var{scale}, but in the
+opposite direction, and the result is then shifted within the
+@var{scale} by the number of scale degrees given by the interval between
+@var{to-pitch} and @var{around-pitch}.
+
+So to simply invert around a note in the scale use the same value for
+@var{around-pitch} and @var{to-pitch}:
+
+@lilypond[verbatim,quote]
+octatonicScale = \relative c' { ees f fis gis a b c d }
+motif = \relative c' { c8. ees16 fis8. a16 b8. gis16 f8. d16 }
+
+\new Staff {
+  \motif
+  \modalInversion fis' fis' \octatonicScale \motif
+}
+@end lilypond
+
+To invert around a pivot between two notes in the scale, invert around
+one of the notes and then transpose by one scale degree.  The two notes
+specified can be interpreted as bracketing the pivot point:
+
+@lilypond[verbatim,quote]
+scale = \relative c' { c g' }
+motive = \relative c' { c c g' c, }
+
+\new Staff {
+  \motive
+  \modalInversion c' g' \scale \motive
+}
+@end lilypond
+
+
+@subsubheading Retrograde transformation
+
+@cindex retrograde transformation
+@cindex transformation, retrograde
+@cindex operation, retrograde
+@funindex \retrograde
+@funindex retrograde
+
+A motif can be reversed to produce its retrograde:
+
+@lilypond[verbatim,quote]
+motif = \relative c' { c8. ees16( fis8. a16 b8.) gis16 f8. d16 }
+
+\new Staff {
+  \motif
+  \retrograde \motif
+}
+@end lilypond
+
+The combined operation of inversion and retrograde produce the
+retrograde-inversion:
+
+@lilypond[verbatim,quote]
+octatonicScale = \relative c' { ees f fis gis a b c d }
+motif = \relative c' { c8. ees16 fis8. a16 b8. gis16 f8. d16 }
+
+\new Staff {
+  \motif
+  \retrograde \modalInversion c' c' \octatonicScale \motif
+}
+@end lilypond
+
+@seealso
+Notation Reference:
+@ref{Transpose}.
+
+@knownissues
+Manual ties inside @code{\retrograde} will be broken and
+generate warnings.  Some ties can be generated automatically
+by enabling @ref{Automatic note splitting}.
+
+
 @node Displaying pitches
 @subsection Displaying pitches
 
@@ -2791,5 +2957,3 @@ Internals Reference:
 @rinternals{Pitch_squash_engraver},
 @rinternals{Voice},
 @rinternals{RhythmicStaff}.
-
-
diff --git a/input/regression/modal-transforms.ly b/input/regression/modal-transforms.ly
new file mode 100644
index 0000000000..9070601510
--- /dev/null
+++ b/input/regression/modal-transforms.ly
@@ -0,0 +1,34 @@
+\version "2.13.51"
+\header {
+    texidoc = "\modalTranspose, \retrograde and \modalInversion work
+for an octatonic motif."
+}
+
+cOctatonicScale = {
+  c' d' ees' f'
+  ges' aes' a' b'
+}
+motif = {
+  c'8. ees'16 ges'8. a'16
+  b'8. aes'16 f'8. d'16
+}
+
+\score {
+  \new Staff {
+    \time 4/4
+    <<
+      {
+        \motif
+        \modalTranspose c' f' \cOctatonicScale \motif
+        \retrograde \motif
+        \modalInversion aes' b' \cOctatonicScale \motif
+      }
+      {
+        s1-"Octatonic motif" |
+        s1-"motif transposed from c to f" |
+        s1-"motif in retrograde" |
+        s1-"motif inverted around aes to b" |
+      }
+    >>
+  }
+}
diff --git a/ly/music-functions-init.ly b/ly/music-functions-init.ly
index fc49725f07..34261c114b 100644
--- a/ly/music-functions-init.ly
+++ b/ly/music-functions-init.ly
@@ -214,14 +214,14 @@ clef =
 
 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, 
+  (_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 
+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))
@@ -462,13 +462,29 @@ makeClusters =
    (_i "Display chords in @var{arg} as clusters.")
    (music-map note-to-cluster arg))
 
+modalInversion =
+#(define-music-function (parser location around to scale music)
+    (ly:music? ly:music? ly:music? ly:music?)
+    (_i "Invert @var{music} about @var{around} using @var{scale} and
+transpose from @var{around} to @var{to}.")
+    (let ((inverter (make-modal-inverter around to scale)))
+      (change-pitches music inverter)
+      music))
+
+modalTranspose =
+#(define-music-function (parser location from to scale music)
+    (ly:music? ly:music? ly:music? ly:music?)
+    (_i "Transpose @var{music} from pitch @var{from} to pitch @var{to}
+using @var{scale}.")
+    (let ((transposer (make-modal-transposer from to scale)))
+      (change-pitches music transposer)
+      music))
+
 musicMap =
 #(define-music-function (parser location proc mus) (procedure? ly:music?)
    (_i "Apply @var{proc} to @var{mus} and all of the music it contains.")
    (music-map proc mus))
 
-
-
 %% noPageBreak and noPageTurn are music functions (not music indentifiers),
 %% because music identifiers are not allowed at top-level.
 noPageBreak =
@@ -780,6 +796,12 @@ resetRelativeOctave =
 
      reference-note))
 
+retrograde =
+#(define-music-function (parser location music)
+    (ly:music?)
+    (_i "Return @var{music} in reverse order.")
+    (retrograde-music music))
+
 revertTimeSignatureSettings =
 #(define-music-function
    (parser location time-signature)
diff --git a/scm/lily.scm b/scm/lily.scm
index 08e6561058..97b6c34c26 100644
--- a/scm/lily.scm
+++ b/scm/lily.scm
@@ -403,6 +403,7 @@ LilyPond safe mode.  The syntax is the same as `define*-public'."
     "chord-generic-names.scm"
     "stencil.scm"
     "markup.scm"
+    "modal-transforms.scm"
     "music-functions.scm"
     "part-combiner.scm"
     "autochange.scm"
diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
new file mode 100644
index 0000000000..cdaa015ccc
--- /dev/null
+++ b/scm/modal-transforms.scm
@@ -0,0 +1,222 @@
+;;; modal-transforms.scm --- Modal transposition, inversion, and retrograde.
+
+;; Copyright (C) 2011 Ellis & Grant, Inc.
+
+;; Author: Michael Ellis <michael.f.ellis@gmail.com>
+
+;; COPYRIGHT NOTICE
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+;; for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program; if not, write to the Free Software
+;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA.
+
+
+(define (transposer-factory scale)
+  "Returns a transposer for the specified @var{scale}.
+It is an error if either argument to a transposer is not in the scale
+it was created with.  A transposer knows nothing about LilyPond
+internals.  It treats scales as an ordered list of arbitrary items and
+pitches as members of a scale.
+"
+
+  (define (index item lis)
+    (list-index (lambda (x) (equal? item x)) lis))
+
+  (lambda (from-pitch to-pitch pitch)
+    (cond
+     ((not (member from-pitch scale))
+      (ly:warning (_i "'from' pitch not in scale; ignoring"))
+      pitch)
+
+     ((not (member to-pitch scale))
+      (ly:warning (_i "'to' pitch not in scale; ignoring"))
+      pitch)
+
+     ((not (member pitch scale))
+      (ly:warning (_i "pitch to be transposed not in scale; ignoring"))
+      pitch)
+
+     (else
+      (list-ref scale
+		(modulo
+		 (+ (index pitch scale)
+		    (- (index to-pitch scale)
+		       (index from-pitch scale)))
+		 (length scale)))))))
+
+(define (inverter-factory scale)
+  "Returns an inverter for the specified @var{scale}.
+It is an error if either argument to an inverter
+is not in the scale it was created with.  An inverter knows nothing
+about LilyPond internals.  It treats scales as an ordered list of
+arbitrary items and pitches as members of a scale.
+"
+
+  (define (index item lis)
+    (list-index (lambda (x) (equal? item x)) lis))
+
+  (lambda (around-pitch to-pitch pitch)
+    (cond
+     ((not (member around-pitch scale))
+      (ly:warning (_i "'around' pitch not in scale; ignoring"))
+      pitch)
+
+     ((not (member to-pitch scale))
+      (ly:warning (_i "'to' pitch not in scale; ignoring"))
+      pitch)
+
+     ((not (member pitch scale))
+      (ly:warning (_i "pitch to be inverted not in scale; ignoring"))
+      pitch)
+
+     (else
+      (list-ref scale
+		(modulo
+		 (+ (index to-pitch scale)
+		    (- (index around-pitch scale)
+		       (index pitch scale)))
+		 (length scale)))))))
+
+(define (replicate-modify lis n mod-proc)
+  "Apply @code{(mod-proc lis n)} to each element of a list and
+concatenate the results.  Knows nothing of LilyPond internals."
+  (cond
+   ((< n 0)
+    (ly:warning (_i "negative replication count; ignoring")))
+   ((= n 0)
+    '())
+   ((= n 1)
+    (mod-proc lis 1))
+   ((> n 1)
+    (append
+     (replicate-modify lis (- n 1) mod-proc)
+     (mod-proc lis n)))))
+
+
+
+(define-public (change-pitches music converter)
+  "Recurse through @var{music}, applying @var{converter} to pitches.
+Converter is typically a transposer or an inverter as defined above in
+this module, but may be user-defined.  The converter function must take
+a single pitch as its argument and return a new pitch.  These are
+LilyPond scheme pitches, e.g. @code{(ly:make-pitch 0 2 0)}
+"
+  (let ((elements (ly:music-property music 'elements))
+	(element (ly:music-property music 'element))
+	(pitch (ly:music-property music 'pitch)))
+
+    (cond
+     ((ly:pitch? pitch)
+      (ly:music-set-property! music 'pitch (converter pitch)))
+
+     ((pair? elements)
+      (map (lambda (x) (change-pitches x converter)) elements))
+
+     ((ly:music? element)
+      (change-pitches element converter)))))
+
+
+(define (extract-pitch-sequence music)
+  "Recurse through @var{music}, extracting pitches.
+Returns a list of pitch objects, e.g
+@code{'((ly:make-pitch 0 2 0) (ly:make-pitch 0 4 0) ... )}
+Typically used to construct a scale for input to transposer-factory
+(see).
+"
+
+  (let ((elements (ly:music-property music 'elements))
+	(element (ly:music-property music 'element))
+	(pitch (ly:music-property music 'pitch)))
+
+    (cond
+     ((ly:pitch? pitch)
+      pitch)
+
+     ((pair? elements)
+      (map
+       (lambda (x) (extract-pitch-sequence x))
+       elements))
+
+     ((ly:music? element)
+      (extract-pitch-sequence element)))))
+
+(define (make-scale music)
+  "Convenience wrapper for extract-pitch-sequence."
+  (map car (extract-pitch-sequence music)))
+
+
+(define (make-extended-scale music)
+  "Extend scale given by @var{music} by 5 octaves up and down."
+  ;; This is a bit of a hack since, in theory, someone might want to
+  ;; transpose further than 5 octaves from the original scale
+  ;; definition.  In practice this seems unlikely to occur very often.
+  (define extender
+    (lambda (lis n)
+      (map
+       (lambda (i)
+	 (ly:make-pitch
+	  (+ (- n 6) (ly:pitch-octave i))
+	  (ly:pitch-notename i)
+	  (ly:pitch-alteration i)))
+       lis)))
+
+  (let ((scale (make-scale music)))
+    (replicate-modify scale 11 extender)))
+
+
+;; ------------- PUBLIC FUNCTIONS -----------------------------
+
+(define-public (make-modal-transposer from-pitch to-pitch scale)
+  "Wrapper function for transposer-factory."
+  (let ((transposer (transposer-factory (make-extended-scale scale)))
+	(from (car (extract-pitch-sequence from-pitch)))
+	(to (car (extract-pitch-sequence to-pitch))))
+
+    (lambda (p)
+      (transposer from to p))))
+
+(define-public (make-modal-inverter around-pitch to-pitch scale)
+  "Wrapper function for inverter-factory"
+  (let ((inverter (inverter-factory (make-extended-scale scale)))
+	(around (car (extract-pitch-sequence around-pitch)))
+	(to (car (extract-pitch-sequence to-pitch))))
+
+    (lambda (p)
+      (inverter around to p))))
+
+
+(define-public (retrograde-music music)
+  "Returns @var{music} in retrograde (reversed) order."
+  ;; Copied from LSR #105 and renamed.
+  ;; 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))
+         (reversed (reverse elements))
+         (element (ly:music-property music 'element))
+         (span-dir (ly:music-property music 'span-direction)))
+
+    (ly:music-set-property! music 'elements reversed)
+
+    (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)))
+
+    (map retrograde-music reversed)
+
+    music))