Encode fret information when building strings.

1 files changed, 48 insertions, 35 deletions

diff --git a/scales.scm b/scales.scm
index 271d6ce..913a58a 100644
--- a/scales.scm
+++ b/scales.scm
@@ -1,6 +1,10 @@
-(use-modules (srfi srfi-1)
-             (srfi srfi-26))
+(define-module (scales)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26))
 
+
 (define all-notes
   (circular-list 'a 'ais 'b 'c 'cis 'd 'dis 'e 'f 'fis 'g 'gis))
 
@@ -66,45 +70,54 @@ root note and returns a list of scale notes."
   '((c g d a e b) (c g d a e b)))
 
 
-(define (steps->offsets steps)
-  "Given a list of semitone steps return a pattern of absolute
-pitch offsets."
-  (reverse
-   (fold (lambda (step acc)
-           (cons (+ step (car acc)) acc))
-         '(0) steps)))
-
-(define (scale->notes scale root)
-  (let ((notes (all-notes-from root)))
-    (map (lambda (offset)
-           (list-ref notes offset))
-         (steps->offsets scale))))
-
-(define (fretboard tuning notes frets fret-offset)
-  "Generate a fretboard (a list of lists of notes) for an instrument
-with the given TUNING where the position of the given NOTES are
-indicated for as many FRETS as specified."
-  (let ((keep-notes (lambda (note)
-                      (if (member note notes)
-                          note #f))))
-    (map (lambda (root)
-           (map keep-notes
-                (drop (take (all-notes-from root)
-                            (+ frets fret-offset))
-                      fret-offset)))
-         (reverse tuning))))
-
-;; TODO: keep more metadata, e.g. scale position
+(define-record-type <fret>
+  (make-fret position note)
+  fret?
+  (position fret-position)
+  (note     fret-note))
+
+
+
+(define* (string-frets root scale-notes
+                       #:optional (frets 7) (fret-offset 0))
+  "Represent an instrument string as a list of FRETS frets.  Each fret
+contains a <FRET> object holding its position (starting from
+FRET-OFFSET) as well as the scale note matching one of the SCALE-NOTES
+at this position or #f."
+  (map (match-lambda
+         ((position note)
+          (make-fret position
+                     (find (lambda (scale-note)
+                             (eqv? note
+                                   (scale-note-note scale-note)))
+                           scale-notes))))
+       (zip (iota frets fret-offset)
+            (take (all-notes-from root)
+                  (+ frets fret-offset)))))
+
+(define* (fretboard tuning scale-notes
+                    #:optional (frets 7) (fret-offset 0))
+  "Generate a fretboard (a list of lists of frets) for an instrument
+with the given TUNING where the position of the notes of a given SCALE
+are indicated for as many FRETS as specified."
+  (map (lambda (root)
+         (string-frets root scale-notes frets fret-offset))
+       (reverse tuning)))
 
 
 ;;; Printing
+(define (print-fret fret)
+  (let ((note (fret-note fret)))
+    (format #t "-~3,,,'-,a-|"
+            (if note
+                 (if (zero? (scale-note-offset note))
+                     (string-upcase (symbol->string (scale-note-note note)))
+                     (scale-note-note note))
+                 "-"))))
 
 (define (print-frets frets)
   (display "|")
-  (for-each (lambda (note)
-              (format #t "-~3,,,'-,a-|"
-                      (if note note "-")))
-            frets)
+  (for-each print-fret frets)
   (format #t "\n"))
 
 (define (print-fretboard fretboard)