From 0c1b4802f10d8a283150d1d305866fc8a208e970 Mon Sep 17 00:00:00 2001 From: rekado Date: Wed, 28 Sep 2016 09:57:01 +0200 Subject: Move scales.scm to subdir. --- scales.scm | 140 ------------------------------------------------------ scales/scales.scm | 140 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 140 insertions(+), 140 deletions(-) delete mode 100644 scales.scm create mode 100644 scales/scales.scm diff --git a/scales.scm b/scales.scm deleted file mode 100644 index aa3b7df..0000000 --- a/scales.scm +++ /dev/null @@ -1,140 +0,0 @@ -(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)) - -(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 - (make-scale-note note offset) - scale-note? - (note scale-note-note) - (offset scale-note-offset)) - - -;;; 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 - (steps->scale '(2 2 2 1 2 2 1))) -(define ionian - (steps->scale '(2 2 1 2 2 2 1))) -(define mixolydian - (steps->scale '(2 2 1 2 2 1 2))) -(define lydian-b7 - (steps->scale '(2 2 2 1 2 1 2))) -(define altered - (steps->scale '(1 2 1 2 2 2 2))) -(define symmetrical-diminished - (steps->scale '(1 2 1 2 1 2 1 2))) -(define dorian - (steps->scale '(2 1 2 2 2 1 2))) -(define aeolian - (steps->scale '(2 1 2 2 1 2 2))) -(define phrygian - (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 - (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 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/scales.scm b/scales/scales.scm new file mode 100644 index 0000000..97b703e --- /dev/null +++ b/scales/scales.scm @@ -0,0 +1,140 @@ +(define-module (scales 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)) + +(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 + (make-scale-note note offset) + scale-note? + (note scale-note-note) + (offset scale-note-offset)) + + +;;; 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 + (steps->scale '(2 2 2 1 2 2 1))) +(define ionian + (steps->scale '(2 2 1 2 2 2 1))) +(define mixolydian + (steps->scale '(2 2 1 2 2 1 2))) +(define lydian-b7 + (steps->scale '(2 2 2 1 2 1 2))) +(define altered + (steps->scale '(1 2 1 2 2 2 2))) +(define symmetrical-diminished + (steps->scale '(1 2 1 2 1 2 1 2))) +(define dorian + (steps->scale '(2 1 2 2 2 1 2))) +(define aeolian + (steps->scale '(2 1 2 2 1 2 2))) +(define phrygian + (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 + (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 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))) -- cgit v1.2.3