;;; 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>
(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) ... )}
(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."
;; ------------- 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))))
(ly:pitch-transpose to (ly:pitch-diff around p))))
music))
-(define-public (music-invert around-pitch to-pitch music)
+(define-public (music-invert around to 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)))
-
+ (music-map (lambda (x) (pitch-invert around to x)) music))