X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fmodal-transforms.scm;h=9617329d77843a4e13777046cc86908be1edd44a;hb=2ccb49133730ac1e98c7068e884297f3246aaf3b;hp=cdaa015ccc08099c251c51304ece2c77a66c61d9;hpb=fd7ad42f98d7e6117958a41e74cd736e396fb933;p=lilypond.git

diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
index cdaa015ccc..9617329d77 100644
--- a/scm/modal-transforms.scm
+++ b/scm/modal-transforms.scm
@@ -1,6 +1,6 @@
 ;;; modal-transforms.scm --- Modal transposition, inversion, and retrograde.
 
-;; Copyright (C) 2011 Ellis & Grant, Inc.
+;; Copyright (C) 2011--2012 Ellis & Grant, Inc.
 
 ;; Author: Michael Ellis <michael.f.ellis@gmail.com>
 
@@ -126,7 +126,7 @@ LilyPond scheme pitches, e.g. @code{(ly:make-pitch 0 2 0)}
       (change-pitches element converter)))))
 
 
-(define (extract-pitch-sequence music)
+(define (make-scale 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) ... )}
@@ -140,20 +140,15 @@ Typically used to construct a scale for input to transposer-factory
 
     (cond
      ((ly:pitch? pitch)
-      pitch)
+      (list pitch))
 
      ((pair? elements)
-      (map
-       (lambda (x) (extract-pitch-sequence x))
+      (append-map
+       (lambda (x) (make-scale 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)))
-
+      (make-scale element)))))
 
 (define (make-extended-scale music)
   "Extend scale given by @var{music} by 5 octaves up and down."
@@ -176,21 +171,15 @@ Typically used to construct a scale for input to transposer-factory
 
 ;; ------------- PUBLIC FUNCTIONS -----------------------------
 
-(define-public (make-modal-transposer from-pitch to-pitch scale)
+(define-public (make-modal-transposer from to 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))))
-
+  (let ((transposer (transposer-factory (make-extended-scale scale))))
     (lambda (p)
       (transposer from to p))))
 
-(define-public (make-modal-inverter around-pitch to-pitch scale)
+(define-public (make-modal-inverter around to 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))))
-
+  (let ((inverter (inverter-factory (make-extended-scale scale))))
     (lambda (p)
       (inverter around to p))))
 
@@ -220,3 +209,17 @@ Typically used to construct a scale for input to transposer-factory
     (map retrograde-music reversed)
 
     music))
+
+(define-public (pitch-invert around to music)
+  "If @var{music} is a single pitch, inverts it about @var{around}
+and transposes from @var{around} to @var{to}."
+  (let ((p (ly:music-property music 'pitch)))
+    (if (ly:pitch? p)
+	(ly:music-set-property!
+	 music 'pitch
+	 (ly:pitch-transpose to (ly:pitch-diff around p))))
+    music))
+
+(define-public (music-invert around to music)
+  "Applies pitch-invert to all pitches in @var{music}."
+     (music-map (lambda (x) (pitch-invert around to x)) music))