diff options
| -rw-r--r-- | scales/fretboard.scm | 83 | ||||
| -rw-r--r-- | scales/scales.scm | 111 | ||||
| -rw-r--r-- | scales/utils.scm | 27 |
3 files changed, 122 insertions, 99 deletions
diff --git a/scales/fretboard.scm b/scales/fretboard.scm new file mode 100644 index 0000000..97bb1f5 --- /dev/null +++ b/scales/fretboard.scm @@ -0,0 +1,83 @@ +(define-module (scales fretboard) + #:use-module (ice-9 match) + #:use-module (ice-9 format) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:use-module (scales utils) + #:export (tuning-guitar + tuning-grand-stick-matched-reciprocal-6+6 + + string-frets + fretboard + + print-fretboard + print-stick)) + + +;;; Tunings + +(define tuning-guitar + '(e a d g b e)) + +(define tuning-grand-stick-matched-reciprocal-6+6 + '((b e a d g c) (b e a d g c))) + + +(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 (cut string-frets <> 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 print-fret frets) + (format #t "\n")) + +(define (print-fretboard fretboard) + (for-each print-frets fretboard)) + +(define (print-stick fretboards) + (for-each (compose (lambda _ (format #t "\n")) + print-fretboard) + fretboards)) diff --git a/scales/scales.scm b/scales/scales.scm index 97b703e..ec8cf58 100644 --- a/scales/scales.scm +++ b/scales/scales.scm @@ -1,26 +1,18 @@ (define-module (scales scales) - #:use-module (ice-9 match) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-9) - #:use-module (srfi srfi-26)) + #:use-module (scales utils) + #:export (steps->scale - -(define all-notes - (circular-list 'a 'ais 'b 'c 'cis 'd 'dis 'e 'f 'fis 'g 'gis)) - -(define (all-notes-from root) - (find-tail (cut eqv? root <>) all-notes)) - - -;;; Scale notes - -;; A scale note is a note with a scale offset, e.g. a C# at the second -;; scale position. -(define-record-type <scale-note> - (make-scale-note note offset) - scale-note? - (note scale-note-note) - (offset scale-note-offset)) + lydian + ionian + mixolydian + lydian-b7 + altered + symmetrical-diminished + dorian + aeolian + phrygian + locrian)) ;;; Common scales @@ -59,82 +51,3 @@ root note and returns a list of scale notes." (steps->scale '(1 2 2 2 1 2 2))) (define locrian (steps->scale '(1 2 2 1 2 2 2))) - - -;;; Tunings - -(define tuning-guitar - '(e a d g b e)) - -(define tuning-grand-stick-matched-reciprocal-6+6 - '((b e a d g c) (b e a d g c))) - - -(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 print-fret frets) - (format #t "\n")) - -(define (print-fretboard fretboard) - (for-each print-frets fretboard)) - -(define (print-stick fretboards) - (for-each (compose (lambda _ (format #t "\n")) - print-fretboard) - fretboards)) - - - -;;; Examples - -(when #f - (print-fretboard (fretboard tuning-guitar (aeolian 'e) 7 5)) - (print-stick - (map (lambda (string-group) - (fretboard string-group (aeolian 'e) 7 5)) - tuning-grand-stick-matched-reciprocal-6+6))) diff --git a/scales/utils.scm b/scales/utils.scm new file mode 100644 index 0000000..6bb0a9d --- /dev/null +++ b/scales/utils.scm @@ -0,0 +1,27 @@ +(define-module (scales utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-9) + #:use-module (srfi srfi-26) + #:export (all-notes-from + + make-scale-note + scale-note-note + scale-note-offset)) + + +(define all-notes + (circular-list 'a 'ais 'b 'c 'cis 'd 'dis 'e 'f 'fis 'g 'gis)) + +(define (all-notes-from root) + (find-tail (cut eqv? root <>) all-notes)) + + +;;; Scale notes + +;; A scale note is a note with a scale offset, e.g. a C# at the second +;; scale position. +(define-record-type <scale-note> + (make-scale-note note offset) + scale-note? + (note scale-note-note) + (offset scale-note-offset)) |