/
pitch.lisp
130 lines (105 loc) · 4.04 KB
/
pitch.lisp
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
;;;; pitch.lisp
;;;;
;;;; Copyright (c) 2021 Izaak Walton
(in-package #:vibratsia)
;;; Note/Frequency Conversions
(defvar note-freq-table '((C . 16.35)
(C# . 17.32)
;(Db . 17.32)
(D . 18.35)
(D# . 19.45)
;(Eb . 19.45)
(E . 20.6)
(F . 21.83)
(F# . 23.12)
;(Gb . 23.12)
(G . 24.5)
(G# . 25.96)
;(Ab . 25.96)
(A . 27.5)
(Bb . 29.14)
(B . 30.87)))
;;;Functions to convert note to frequency
(defun octave-shift (freq num-octaves)
(* freq (expt 2 num-octaves)))
(defun freq-climber (freq octaves-up)
"Adjusts the note-frequency to the proper octave."
(cond ((zerop octaves-up) freq)
(t (freq-climber (* 2 freq) (- octaves-up 1)))))
(defun note-to-freq (note-name octave);;;has to use quoted note-name
"Takes a note and octave, returns the note's frequency."
(freq-climber (cdr (assoc note-name note-freq-table)) octave))
;;;Functions to convert frequency to note
(defun minimize-freq (frequency counter)
"Minimizes the frequency until it's in the base octave."
(cond ((< frequency 31) (list frequency counter))
(t (minimize-freq (/ frequency 2) (+ counter 1)))))
(defun closest-note (freq freq-list)
"Returns the equal temperament note-name closest to the frequency."
(loop :with min-note := (car (first freq-list))
:with min-freq := (cdr (first freq-list))
:with min-dist := (abs (- freq min-freq))
:for (note . note-freq) :in (rest freq-list)
:for dist := (abs (- freq note-freq))
:when (< dist min-dist)
:do (setf min-note note
min-freq note-freq
min-dist dist)
:finally (return (values min-note
min-dist))))
(defun freq-to-note (freq)
"Takes a frequency and returns a (note octave) pair."
(destructuring-bind (canonical-freq octave)
(minimize-freq freq 0)
(list (closest-note canonical-freq note-freq-table) octave)))
;;; Note Class
(defclass note ()
((note-name :initarg :note-name
:accessor note-name)
(octave :initarg :octave
:accessor octave)
(freq-float :initarg :freq-float
:accessor freq-float))
(:documentation "A note defined by Note-name, octave number,
and frequency."))
(defmethod print-object ((obj note) stream)
(print-unreadable-object (obj stream :type t)
(with-accessors ((note-name note-name)
(octave octave)
(freq-float freq-float))
obj
(format stream "~a-~a, Frequency: ~f" note-name octave freq-float))))
(defun make-note (frequency)
"Makes a full note instance from a given frequency."
(make-instance 'note :note-name (first (freq-to-note frequency))
:octave (second (freq-to-note frequency))
:freq-float frequency))
;;;Frequency generation
;fn = f0 * (a)^n
;f0 = 440
;n = half steps away from fixed note (positive or negative)
;fn = frequency of note n half steps away
;a = 2^1/12
(defun freq-adjust (root interval)
"Raises or lowers a root frequency by an interval n in half-steps.
+----------------------------------+
| n 1/12|
|f(n) = f(0) * (a) where a = 2 |
+----------------------------------+"
(* root (expt (expt 2 (/ 1 12)) interval)))
(defun freq-incr (fixed)
"Raises a frequency by one half-step, for building chromatic test samples.
+----------------------------------+
| 1 1/12|
|f(1) = f(0) * (a) where a = 2 |
+----------------------------------+"
(* fixed (expt (expt 2 (/ 1 12)) 1)))
(defun frequency-ladder (min max)
"Builds a chromatic test-sample within the bounds."
(cond ((> min max) nil)
(t (cons min (frequency-ladder (freq-incr min) max)))))
;;; Note Operations
(defgeneric transpose (object half-steps)
(:documentation "Transposes a given object by a signed number of half-steps."))
(defmethod transpose ((note note) half-steps)
(make-note (freq-adjust (freq-float note) half-steps)))