From 79d76a04b0d9a6c104c8756fcdf31495451cc42e Mon Sep 17 00:00:00 2001
From: rekado <rekado@elephly.net>
Date: Wed, 28 Sep 2016 09:48:21 +0200
Subject: Scales are functions.

A scale is a procedure that takes a root note and returns a list of
scale notes.
---
 scales.scm | 38 ++++++++++++++++++++++++++------------
 1 file changed, 26 insertions(+), 12 deletions(-)

diff --git a/scales.scm b/scales.scm
index 0ac91db..271d6ce 100644
--- a/scales.scm
+++ b/scales.scm
@@ -21,26 +21,40 @@
 
 ;;; Common scales
 
+(define (steps->scale steps)
+  "Given a list of semitone steps, return a procedure that takes a
+root note and returns a list of scale notes."
+  (let ((offsets (reverse
+                  (fold (lambda (step acc)
+                          (cons (+ step (car acc)) acc))
+                        '(0) steps))))
+    (lambda (root)
+      (let ((notes (all-notes-from root)))
+        (map (lambda (offset)
+               (make-scale-note (list-ref notes offset)
+                                offset))
+             offsets)))))
+
 (define lydian
-  '(2 2 2 1 2 2 1))
+  (steps->scale '(2 2 2 1 2 2 1)))
 (define ionian
-  '(2 2 1 2 2 2 1))
+  (steps->scale '(2 2 1 2 2 2 1)))
 (define mixolydian
-  '(2 2 1 2 2 1 2))
+  (steps->scale '(2 2 1 2 2 1 2)))
 (define lydian-b7
-  '(2 2 2 1 2 1 2))
+  (steps->scale '(2 2 2 1 2 1 2)))
 (define altered
-  '(1 2 1 2 2 2 2))
+  (steps->scale '(1 2 1 2 2 2 2)))
 (define symmetrical-diminished
-  '(1 2 1 2 1 2 1 2))
+  (steps->scale '(1 2 1 2 1 2 1 2)))
 (define dorian
-  '(2 1 2 2 2 1 2))
+  (steps->scale '(2 1 2 2 2 1 2)))
 (define aeolian
-  '(2 1 2 2 1 2 2))
+  (steps->scale '(2 1 2 2 1 2 2)))
 (define phrygian
-  '(1 2 2 2 1 2 2))
+  (steps->scale '(1 2 2 2 1 2 2)))
 (define locrian
-  '(1 2 2 1 2 2 2))
+  (steps->scale '(1 2 2 1 2 2 2)))
 
 
 ;;; Tunings
@@ -106,8 +120,8 @@ indicated for as many FRETS as specified."
 ;;; Examples
 
 (when #f
-  (print-fretboard (fretboard tuning-guitar (scale->notes 'aeolian 'e) 7 5))
+  (print-fretboard (fretboard tuning-guitar (aeolian 'e) 7 5))
   (print-stick
    (map (lambda (string-group)
-          (fretboard string-group (scale->notes 'aeolian 'e) 7 5))
+          (fretboard string-group (aeolian 'e) 7 5))
         tuning-grand-stick-matched-reciprocal-6+6)))
-- 
cgit v1.2.3