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

diff --git a/scm/modal-transforms.scm b/scm/modal-transforms.scm
index cdaa015ccc..151fb8c3be 100644
--- a/scm/modal-transforms.scm
+++ b/scm/modal-transforms.scm
@@ -220,3 +220,20 @@ 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-pitch to-pitch music)
+  "Applies pitch-invert to all pitches in @var{music}."
+  (let ((around (car (extract-pitch-sequence around-pitch)))
+	(to (car (extract-pitch-sequence to-pitch))))
+     (music-map (lambda (x) (pitch-invert around to x)) music)))
+