blob: 271d6ce4656107d521d0eb8e54280f7593d41a28 (
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
|
(use-modules (srfi srfi-1)
(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 (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
;;; Printing
(define (print-frets frets)
(display "|")
(for-each (lambda (note)
(format #t "-~3,,,'-,a-|"
(if note note "-")))
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)))
|
