;;; 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>
(else
(list-ref scale
- (modulo
- (+ (index pitch scale)
- (- (index to-pitch scale)
- (index from-pitch scale)))
- (length 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}.
(else
(list-ref scale
- (modulo
- (+ (index to-pitch scale)
- (- (index around-pitch scale)
- (index pitch scale)))
- (length 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
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)))
+ (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))
+ (for-each (lambda (x) (change-pitches x converter)) elements))
((ly:music? element)
(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) ... )}
"
(let ((elements (ly:music-property music 'elements))
- (element (ly:music-property music 'element))
- (pitch (ly:music-property music 'pitch)))
+ (element (ly:music-property music 'element))
+ (pitch (ly:music-property music 'pitch)))
(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."
(lambda (lis n)
(map
(lambda (i)
- (ly:make-pitch
- (+ (- n 6) (ly:pitch-octave i))
- (ly:pitch-notename i)
- (ly:pitch-alteration i)))
+ (ly:make-pitch
+ (+ (- n 6) (ly:pitch-octave i))
+ (ly:pitch-notename i)
+ (ly:pitch-alteration i)))
lis)))
(let ((scale (make-scale music)))
;; ------------- 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))))
(if (ly:dir? span-dir)
(ly:music-set-property! music 'span-direction (- span-dir)))
- (map retrograde-music reversed)
+ (for-each retrograde-music reversed)
music))
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))))
+ (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)
+(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))