blob: c4c0b6dc0ba9d6887b25af6fd92cd4c36eedcebd (
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
|
(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))
;;; Common scales
(define lydian
'(2 2 2 1 2 2 1))
(define ionian
'(2 2 1 2 2 2 1))
(define mixolydian
'(2 2 1 2 2 1 2))
(define lydian-b7
'(2 2 2 1 2 1 2))
(define altered
'(1 2 1 2 2 2 2))
(define symmetrical-diminished
'(1 2 1 2 1 2 1 2))
(define dorian
'(2 1 2 2 2 1 2))
(define aeolian
'(2 1 2 2 1 2 2))
(define phrygian
'(1 2 2 2 1 2 2))
(define locrian
'(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 (scale->notes 'aeolian 'e) 7 5))
(print-stick
(map (lambda (string-group)
(fretboard string-group (scale->notes 'aeolian 'e) 7 5))
tuning-grand-stick-matched-reciprocal-6+6)))
|
