m@24
|
1 (cl:in-package #:amuse)
|
m@24
|
2
|
m@24
|
3 ;;; Pulling compositions from the database
|
m@24
|
4
|
m@24
|
5 (defgeneric get-composition (identifier))
|
m@24
|
6
|
m@24
|
7 ;;; Simple Accessors
|
m@24
|
8
|
m@24
|
9 ;; pitch-based
|
m@24
|
10
|
m@24
|
11 (defgeneric pitch (object &key kind)) ; ? Maybe this returns the pitch
|
m@24
|
12 ; in its ur form?
|
m@24
|
13 (defgeneric chromatic-pitch (pitch-designator)) ; How simple are these
|
m@24
|
14 (defgeneric diatonic-pitch (pitch-designator)) ; if has to be computed?
|
m@24
|
15 (defgeneric frequency (object)) ;?
|
m@24
|
16 (defgeneric midi-pitch-number (pitch-designator))
|
m@24
|
17 (defgeneric meredith-chromatic-pitch-number (pitch-designator)
|
m@24
|
18 ;; David Meredith's PhD and ps13 code
|
m@24
|
19 (:method (p) (- (midi-pitch-number p) 21)))
|
m@24
|
20 (defgeneric pitch-class (pitch-designator)
|
m@24
|
21 (:method (p) (mod (midi-pitch-number p) 12)))
|
m@24
|
22 (defgeneric span (pitch-interval-designator))
|
m@24
|
23
|
m@24
|
24 ;; time
|
m@24
|
25
|
m@24
|
26 (defgeneric duration (period-designator))
|
m@24
|
27 (defgeneric (setf duration) (value period-designator))
|
m@24
|
28 (defgeneric timepoint (moment-designator))
|
m@24
|
29 (defgeneric (setf timepoint) (value moment-designator))
|
m@24
|
30 (defgeneric cut-off (anchored-period-designator) ; name?
|
m@24
|
31 (:method (apd) (time+ (moment apd) (floating-period apd))))
|
m@24
|
32
|
m@24
|
33 ;; others
|
m@24
|
34
|
m@24
|
35 ;; I've given the time-sig accessors general names because it allows
|
m@24
|
36 ;; for symbols in time-signatures as well as numbers - numerator is an
|
m@24
|
37 ;; odd accessor if the time sig is C (even in common practice) but
|
m@24
|
38 ;; it's meaning is clear. beat-units-per-bar is clearer, though, I
|
m@24
|
39 ;; think.
|
m@24
|
40
|
m@24
|
41 (defgeneric beat-units-per-bar (time-signature))
|
m@24
|
42 (defgeneric time-signature-numerator (time-signature)
|
m@24
|
43 (:method (ts) (beat-units-per-bar ts)))
|
m@24
|
44 (defgeneric beat-units (time-signature))
|
m@24
|
45 (defgeneric time-signature-denominator (time-signature)
|
m@24
|
46 (:method (ts) (beat-units ts)))
|
m@24
|
47
|
m@24
|
48 (defgeneric key-signature-sharps (key-signature))
|
m@24
|
49
|
m@24
|
50 (defgeneric bpm (tempo)) ;; in bpm
|
m@24
|
51 (defgeneric microseconds-per-crotchet (tempo)
|
m@24
|
52 ;; As used (when rounded) in MIDI
|
m@24
|
53 (:method (tp) (/ 60000000 (bpm tp))))
|
m@24
|
54
|
m@24
|
55 ;;; Coerce-type accessors
|
m@24
|
56
|
m@24
|
57 ;; Should I be including these default methods? Should the accessors
|
m@24
|
58 ;; be direct slot accessors or the generics I'm using? Should we
|
m@24
|
59 ;; return the object itself if it already is in the target class?
|
m@24
|
60
|
m@24
|
61 (defgeneric anchored-period (anchored-period-designator)
|
m@24
|
62 (:method (apd) (make-anchored-period (onset apd) (duration apd))))
|
m@24
|
63
|
m@24
|
64 (defgeneric floating-period (period-designator)
|
m@24
|
65 (:method (pd) (make-floating-period (duration pd))))
|
m@24
|
66
|
m@24
|
67 (defgeneric moment (moment-designator)
|
m@24
|
68 (:method (md) (make-moment (timepoint md))))
|
m@24
|
69
|
m@24
|
70 (defgeneric onset (anchored-period-designator)
|
m@24
|
71 (:method (apd) (moment apd)))
|
m@24
|
72 (defgeneric (setf onset) (value anchored-period-designator))
|
m@24
|
73
|
m@24
|
74 ;;; Time Protocol (or moments?)
|
m@24
|
75
|
m@24
|
76 ;; negative times/durations -> ERROR?
|
m@24
|
77
|
m@24
|
78 ;; time+: <time> <duration> -> <time>
|
m@24
|
79 ;; <duration> <time> -> <time> (same as previous?)
|
m@24
|
80 ;; <duration> <duration> -> <duration> (or a distinct duration+?)
|
m@24
|
81 ;; <time> <time> -> ERROR?
|
m@24
|
82 ;;
|
m@24
|
83 ;; time-: <time> <time> -> <duration>
|
m@24
|
84 ;; <time> <duration> -> <time>
|
m@24
|
85 ;; <duration> <duration> -> <duration> (or a distinct duration-?)
|
m@24
|
86 ;; <duration> <time> -> ERROR?
|
m@24
|
87 ;; <anchored> <anchored> -> (time- (moment o1) (moment o2)) ? or error?
|
m@24
|
88
|
m@24
|
89 (defgeneric time+ (object1 object2))
|
m@24
|
90 (defgeneric time- (object1 object2))
|
m@24
|
91
|
m@24
|
92 (defgeneric time> (object1 object2))
|
m@24
|
93 (defgeneric time< (object1 object2)
|
m@24
|
94 (:method (o1 o2) (time> o2 o1)))
|
m@24
|
95 (defgeneric time= (object1 object2))
|
m@24
|
96 (defgeneric time>= (object1 object2)
|
m@24
|
97 (:method (o1 o2) (or (time> o1 o2) (time= o1 o2))))
|
m@24
|
98 (defgeneric time<= (object1 object2)
|
m@24
|
99 (:method (o1 o2) (or (time< o1 o2) (time= o1 o2))))
|
m@24
|
100 (defgeneric time/= (object1 object2)
|
m@24
|
101 (:method (o1 o2) (not (time= o1 o2))))
|
m@24
|
102
|
m@24
|
103 ;;; Duration protocol
|
m@24
|
104
|
m@24
|
105 (defgeneric duration> (object1 object2))
|
m@24
|
106 (defgeneric duration< (object1 object2)
|
m@24
|
107 (:method (o1 o2) (duration> o2 o1)))
|
m@24
|
108 (defgeneric duration= (object1 object2))
|
m@24
|
109 (defgeneric duration>= (object1 object2)
|
m@24
|
110 (:method (o1 o2) (or (duration> o1 o2) (duration= o1 o2))))
|
m@24
|
111 (defgeneric duration<= (object1 object2)
|
m@24
|
112 (:method (o1 o2) (or (duration< o1 o2) (duration= o1 o2))))
|
m@24
|
113 (defgeneric duration/= (object1 object2)
|
m@24
|
114 (:method (o1 o2) (not (duration= o1 o2))))
|
m@24
|
115
|
m@24
|
116 ;; for linear scaling:
|
m@24
|
117 (defgeneric duration* (object1 object2))
|
m@24
|
118 (defgeneric duration/ (object1 number))
|
m@24
|
119
|
m@24
|
120 ;;; Pitch protocol
|
m@24
|
121
|
m@24
|
122 ;; pitch+: <pitch> <pitch> -> ERROR
|
m@24
|
123 ;; <pitch> <interval> -> <pitch>
|
m@24
|
124 ;; <interval> <pitch> -> <pitch> (same as previous?)
|
m@24
|
125 ;; <interval> <interval> -> <interval> (or a distinct interval+?)
|
m@24
|
126 ;;
|
m@24
|
127 ;; pitch-: <pitch> <pitch> -> <interval>
|
m@24
|
128 ;; <pitch> <interval> -> <pitch>
|
m@24
|
129 ;; <interval> <interval> -> <interval>
|
m@24
|
130 ;; <interval> <pitch> -> ERROR
|
m@24
|
131
|
m@24
|
132 (defgeneric pitch+ (object1 object2))
|
m@24
|
133 (defgeneric pitch- (object1 object2))
|
m@24
|
134
|
m@24
|
135 (defgeneric pitch> (object1 object2))
|
m@24
|
136 (defgeneric pitch< (object1 object2)
|
m@24
|
137 (:method (o1 o2) (pitch> o2 o1)))
|
m@24
|
138 (defgeneric pitch= (object1 object2))
|
m@24
|
139 (defgeneric pitch>= (object1 object2)
|
m@24
|
140 (:method (o1 o2) (or (pitch> o1 o2) (pitch= o1 o2))))
|
m@24
|
141 (defgeneric pitch<= (object1 object2)
|
m@24
|
142 (:method (o1 o2) (or (pitch< o1 o2) (pitch= o1 o2))))
|
m@24
|
143 (defgeneric pitch/= (object1 object2)
|
m@24
|
144 (:method (o1 o2) (not (pitch= o1 o2))))
|
m@24
|
145
|
m@24
|
146 ;;; Interval protocol (emphasise _pitch_ not _time_ interval?)
|
m@24
|
147
|
m@24
|
148 (defgeneric interval> (object1 object2))
|
m@24
|
149 (defgeneric interval< (object1 object2)
|
m@24
|
150 (:method (o1 o2) (interval> o2 o1)))
|
m@24
|
151 (defgeneric interval= (object1 object2))
|
m@24
|
152 (defgeneric interval>= (object1 object2)
|
m@24
|
153 (:method (o1 o2) (or (interval> o1 o2) (interval= o1 o2))))
|
m@24
|
154 (defgeneric interval<= (object1 object2)
|
m@24
|
155 (:method (o1 o2) (or (interval< o1 o2) (interval= o1 o2))))
|
m@24
|
156 (defgeneric interval/= (object1 object2)
|
m@24
|
157 (:method (o1 o2) (not (interval= o1 o2))))
|
m@24
|
158
|
m@24
|
159 ;;; Allen's (1984) interval relations
|
m@24
|
160 ;;; . equals already defined as INTERVAL= above
|
m@24
|
161 ;;; . inverses ommitted for now (just use CL:NOT)
|
m@24
|
162 ;;; . can all be defined in terms of MEETS (apparently)
|
m@24
|
163
|
m@24
|
164 (defgeneric meets (object1 object2))
|
m@24
|
165 (defgeneric before (object1 object2))
|
m@24
|
166 (defgeneric overlaps (object1 object2))
|
m@24
|
167 (defgeneric during (object1 object2))
|
m@24
|
168 (defgeneric starts (object1 object2))
|
m@24
|
169 (defgeneric ends (object1 object2))
|
m@24
|
170
|
m@24
|
171 ;;; and extensions thereof ...
|
m@24
|
172
|
m@24
|
173 (defgeneric subinterval (object1 object2)
|
m@24
|
174 (:method (o1 o2) (or (starts o1 o2) (during o1 o2) (ends o1 o2))))
|
m@24
|
175
|
m@24
|
176 (defgeneric disjoint (object1 object2)
|
m@24
|
177 (:method (o1 o2)
|
m@24
|
178 (or (before o1 o2) (meets o1 o2) (meets o2 o1) (before o2 o1))))
|
m@24
|
179
|
m@24
|
180 ;;; More time-based functions
|
m@24
|
181 ;; Return the anchored-period representing the intersection of two
|
m@24
|
182 ;; anchored-period-specifiers.
|
m@24
|
183 (defgeneric period-intersection (anchored-period-specifier1
|
m@24
|
184 anchored-period-specifier2))
|
m@24
|
185
|
m@24
|
186 (defgeneric inter-onset-interval (moment-designator1 moment-designator2)
|
m@24
|
187 (:method (md1 md2) (time- (moment md2) (moment md1))))
|
m@24
|
188
|
m@24
|
189
|
m@24
|
190 ;;; Time Signature
|
m@24
|
191
|
m@24
|
192 (defgeneric get-applicable-time-signatures (object1 object2))
|
m@24
|
193
|
m@24
|
194 ;;; Tempo
|
m@24
|
195
|
m@24
|
196 (defgeneric get-applicable-tempi (object1 object2))
|
m@24
|
197
|
m@24
|
198 ;;; Tonality (Key Signature / Mode)
|
m@24
|
199
|
m@24
|
200 (defgeneric get-applicable-key-signatures (object1 object2))
|
m@24
|
201
|
m@24
|
202 ;;; Dynamics
|
m@24
|
203 ;;; Voice
|
m@24
|
204 ;;; Boundary Strength (phrasing)
|
m@24
|
205
|