blob: 913a58af862afed53c34222a2ebed482ca7d0476 (
about) (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
(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 <scale-note>
(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
'((c g d a e b) (c g d a e b)))
(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)))
|
