d@34
|
1 (cl:in-package #:amuse-midi)
|
d@34
|
2
|
j@302
|
3 (defgeneric midi-channel (midi-message)
|
d@134
|
4 (:documentation "MIDI channel. Also used for midi output"))
|
d@34
|
5 (defmethod midi-channel ((midi-message midi-message))
|
d@34
|
6 (%midi-message-channel midi-message))
|
d@34
|
7
|
j@317
|
8 (defgeneric (setf midi-channel) (value event))
|
j@317
|
9 (defmethod (setf midi-channel) (value (event midi-message))
|
j@317
|
10 (setf (%midi-message-channel event) value) event)
|
j@317
|
11
|
d@134
|
12 (defgeneric midi-track (midi-message)
|
d@134
|
13 (:documentation "MIDI track. Also used for midi output"))
|
d@34
|
14 (defmethod midi-track ((midi-message midi-message))
|
d@34
|
15 (%midi-message-track midi-message))
|
d@34
|
16
|
j@317
|
17 (defgeneric (setf midi-track) (value event))
|
j@317
|
18 (defmethod (setf midi-track) (value (event midi-message))
|
j@317
|
19 (setf (%midi-message-track event) value) event)
|
j@317
|
20
|
d@134
|
21 (defgeneric midi-velocity (event)
|
d@134
|
22 (:documentation "MIDI velocity. Also used for midi output"))
|
d@34
|
23 (defmethod midi-velocity ((event midi-pitched-event))
|
d@34
|
24 (%midi-pitched-event-velocity event))
|
d@34
|
25 (defmethod midi-velocity ((event midi-percussive-event))
|
d@34
|
26 (%midi-percussive-event-velocity event))
|
d@34
|
27
|
j@317
|
28 (defgeneric (setf midi-velocity) (value event))
|
j@317
|
29 (defmethod (setf midi-velocity) (value (event midi-pitched-event))
|
j@317
|
30 (setf (%midi-pitched-event-velocity event) value) event)
|
j@317
|
31 (defmethod (setf midi-velocity) (value (event midi-percussive-event))
|
j@317
|
32 (setf (%midi-percussive-event-velocity event) value) event)
|
j@317
|
33
|
d@134
|
34 (defgeneric midi-patch (event)
|
d@134
|
35 (:documentation "MIDI patch (instrumental sound). Also used for
|
d@134
|
36 midi output"))
|
d@34
|
37 (defmethod midi-patch ((event midi-pitched-event))
|
d@34
|
38 (%midi-pitched-event-patch event))
|
j@317
|
39 (defmethod midi-patch ((event midi-percussive-event))
|
j@317
|
40 (%midi-percussive-event-patch event))
|
d@34
|
41
|
j@317
|
42 (defgeneric (setf midi-patch) (value event))
|
j@317
|
43 (defmethod (setf midi-patch) (value (event midi-pitched-event))
|
j@317
|
44 (setf (%midi-pitched-event-patch event) value) event)
|
j@317
|
45 (defmethod (setf midi-patch) (value (event midi-percussive-event))
|
j@317
|
46 (setf (%midi-percussive-event-patch event) value) event)
|
j@302
|
47
|
d@134
|
48 (defgeneric midi-drum-sound (event)
|
d@134
|
49 (:documentation "MIDI pitch for unpitched events (usually, drum
|
d@134
|
50 sound for drum kits on channel 10, but also for semi-pitched
|
d@134
|
51 SFX, etc). Also used for midi output"))
|
d@34
|
52 (defmethod midi-drum-sound ((event midi-percussive-event))
|
d@34
|
53 (%midi-percussive-event-sound event))
|
d@34
|
54
|
j@317
|
55 (defgeneric (setf midi-drum-sound) (value event))
|
j@317
|
56 (defmethod (setf midi-drum-sound) (value (event midi-percussive-event))
|
j@317
|
57 (setf (%midi-percussive-event-sound event) value) event)
|
j@317
|
58
|
j@317
|
59 (defgeneric midi-note-number (event)
|
j@317
|
60 (:documentation "Same as get-pitch-for-midi"))
|
j@317
|
61 (defmethod midi-note-number ((event midi-pitched-event))
|
j@317
|
62 (midi-pitch-number event))
|
j@317
|
63 (defmethod midi-note-number ((event midi-percussive-event))
|
j@317
|
64 (midi-drum-sound event))
|
j@317
|
65
|
j@302
|
66 (defgeneric midi-drum-sound= (event1 event2))
|
j@302
|
67 (defmethod midi-drum-sound= ((event1 midi-percussive-event)
|
j@302
|
68 (event2 midi-percussive-event))
|
j@302
|
69 (= (midi-drum-sound event1) (midi-drum-sound event2)))
|
j@302
|
70 (defmethod midi-drum-sound= ((event1 event)
|
j@302
|
71 (event2 event))
|
j@302
|
72 "Return nil for any comparisons involving non-percussive events."
|
j@302
|
73 nil)
|
j@302
|
74
|
d@34
|
75 (defmethod time-signatures ((composition midi-composition))
|
d@34
|
76 (%midi-time-signatures composition))
|
d@34
|
77 (defmethod (setf time-signatures) (sequence (composition midi-composition))
|
d@34
|
78 (setf (%midi-time-signatures composition) sequence))
|
d@34
|
79 (defmethod tempi ((composition midi-composition))
|
d@34
|
80 (%midi-tempi composition))
|
d@34
|
81 (defmethod (setf tempi) (sequence (composition midi-composition))
|
d@34
|
82 (setf (%midi-tempi composition) sequence))
|
d@115
|
83 (defmethod key-signatures ((composition midi-composition))
|
d@115
|
84 (%midi-key-signatures composition))
|
d@115
|
85 (defmethod (setf key-signatures) (sequence (composition midi-composition))
|
d@115
|
86 (setf (%midi-key-signatures composition) sequence))
|
d@34
|
87
|
j@281
|
88 (defgeneric midi-timebase (composition))
|
j@281
|
89 (defmethod midi-timebase ((composition midi-composition))
|
j@281
|
90 (%midi-timebase composition))
|
j@281
|
91
|
d@34
|
92 ;; FIXME: This ought to call-next-method and operate on the result,
|
d@34
|
93 ;; rather than calling internals from the other package
|
d@34
|
94 (defmethod copy-event ((event midi-pitched-event))
|
d@34
|
95 (with-slots (channel track (number amuse::number) (time amuse::time) (interval amuse::interval) velocity patch)
|
d@34
|
96 event
|
d@34
|
97 (make-instance 'midi-pitched-event
|
d@34
|
98 :channel channel
|
d@34
|
99 :track track
|
d@34
|
100 :number number
|
d@34
|
101 :time time
|
d@34
|
102 :interval interval
|
d@34
|
103 :velocity velocity
|
d@34
|
104 :patch patch)))
|
d@34
|
105 (defmethod copy-event ((event midi-percussive-event))
|
d@34
|
106 (with-slots (channel track (time amuse::time) (interval amuse::interval) velocity patch sound)
|
d@34
|
107 event
|
d@34
|
108 (make-instance 'midi-percussive-event
|
d@34
|
109 :channel channel
|
d@34
|
110 :track track
|
d@34
|
111 :time time
|
d@34
|
112 :interval interval
|
d@34
|
113 :velocity velocity
|
d@34
|
114 :patch patch
|
d@34
|
115 :sound sound)))
|
d@154
|
116 (defgeneric copy-time-signature (time-signature))
|
d@154
|
117 (defmethod copy-time-signature ((time-signature standard-time-signature))
|
d@154
|
118 (make-instance (class-of time-signature)
|
d@154
|
119 :numerator (time-signature-numerator time-signature)
|
d@154
|
120 :denominator (time-signature-denominator time-signature)))
|
d@154
|
121 (defmethod copy-time-signature ((time-signature-period standard-time-signature-period))
|
d@154
|
122 (let ((sig (call-next-method)))
|
d@154
|
123 (setf (timepoint sig) (timepoint time-signature-period)
|
d@154
|
124 (duration sig) (duration time-signature-period))
|
d@154
|
125 sig))
|
d@154
|
126 (defgeneric copy-tempo (tempo))
|
d@154
|
127 (defmethod copy-tempo ((tempo standard-tempo))
|
d@154
|
128 (make-instance (class-of tempo)
|
d@154
|
129 :bpm (bpm tempo)))
|
d@154
|
130 (defmethod copy-tempo ((tempo-period standard-tempo-period))
|
d@154
|
131 (let ((tp (call-next-method)))
|
d@154
|
132 (setf (timepoint tp) (timepoint tempo-period)
|
d@154
|
133 (duration tp) (duration tempo-period))
|
d@154
|
134 tp))
|
d@154
|
135 (defgeneric copy-key-signature (key-signature))
|
d@154
|
136 (defmethod copy-key-signature ((key-signature standard-key-signature))
|
d@154
|
137 (make-instance (class-of key-signature)
|
d@154
|
138 :sharp-count (key-signature-sharps key-signature)
|
d@154
|
139 :mode (key-signature-mode key-signature)))
|
d@154
|
140 (defmethod copy-key-signature ((key-signature-period standard-key-signature-period))
|
d@154
|
141 (let ((sig (call-next-method)))
|
d@154
|
142 (setf (timepoint sig) (timepoint key-signature-period)
|
d@154
|
143 (duration sig) (duration key-signature-period))
|
d@154
|
144 sig))
|
d@154
|
145
|
d@34
|
146
|
d@34
|
147
|
d@34
|
148 ;; Allow derived sequences from remove-if, etc. to preserve other slot
|
d@34
|
149 ;; info (timesigs, etc)
|
d@154
|
150 #+nil
|
d@34
|
151 (defmethod sequence:make-sequence-like :around ((o midi-composition) length
|
d@34
|
152 &key (initial-element nil iep)
|
d@34
|
153 (initial-contents nil icp))
|
d@34
|
154 (declare (ignore length initial-element initial-contents))
|
d@34
|
155 (let ((result (call-next-method)))
|
d@34
|
156 (cond
|
d@34
|
157 ((or iep icp)
|
d@34
|
158 (setf (timepoint result) (timepoint (elt result 0))
|
d@34
|
159 (duration result) (- (timepoint
|
d@34
|
160 (loop for e being the elements of result
|
d@34
|
161 maximize (cut-off e)))
|
d@34
|
162 (timepoint (elt result 0)))))
|
d@34
|
163 (t (setf (timepoint result) 0
|
d@34
|
164 (duration result) 0)))
|
d@34
|
165 (with-slots (time-signatures tempi misc-controllers)
|
d@34
|
166 o
|
d@34
|
167 (setf (%midi-time-signatures result) time-signatures
|
d@34
|
168 (%midi-tempi result) tempi
|
d@34
|
169 (%midi-misc-controllers result) misc-controllers))
|
d@34
|
170 result))
|
d@153
|
171
|
d@34
|
172
|
d@34
|
173 ;; useful little function
|
d@34
|
174
|
d@34
|
175 (defun microsecond-per-crotchet-to-bpm (mu-per-c)
|
d@34
|
176 (/ 60000000 mu-per-c))
|
d@34
|
177
|
d@34
|
178 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
d@34
|
179 ;;
|
d@34
|
180 ;; MIDI playback methods
|
d@34
|
181
|
d@34
|
182 (defmethod get-patch-for-midi ((event midi-pitched-event))
|
d@34
|
183 ;; FIXME
|
d@34
|
184 (midi-patch event))
|
d@34
|
185
|
d@34
|
186 (defmethod get-channel-for-midi ((event midi-message))
|
d@34
|
187 ;; FIXME 1- ??? I'm only doing this because of the Geerdes
|
d@34
|
188 ;; database. Looks like a recipe for disaster. Think should probably
|
d@34
|
189 ;; enforce 0-15.
|
d@34
|
190 (1- (midi-channel event)))
|
d@34
|
191
|
d@34
|
192 (defmethod get-velocity-for-midi ((event midi-message))
|
d@34
|
193 ;; FIXME: under-exclusive specialisation. Does this matter?
|
d@34
|
194 (midi-velocity event))
|
d@34
|
195
|
d@34
|
196 (defmethod get-pitch-for-midi ((event midi-percussive-event))
|
d@34
|
197 (midi-drum-sound event))
|
d@34
|
198
|
d@34
|
199 (defmethod get-pitch-for-midi ((event midi-pitched-event))
|
d@41
|
200 (midi-pitch-number event))
|
d@41
|
201
|
d@41
|
202 ;; Have avoided percussion vs pitched, as this is more obviously
|
d@41
|
203 ;; meaningless.
|
d@41
|
204 (defmethod significantly-louderp ((event1 midi-pitched-event) (event2 midi-pitched-event))
|
d@41
|
205 (>= (/ (midi-velocity event1)
|
d@41
|
206 (midi-velocity event2))
|
d@41
|
207 4/3))
|
d@41
|
208 (defmethod significantly-louderp ((event1 midi-percussive-event) (event2 midi-percussive-event))
|
d@41
|
209 (>= (/ (midi-velocity event1)
|
d@41
|
210 (midi-velocity event2))
|
d@41
|
211 4/3))
|
d@41
|
212 (defmethod substantially-louderp ((event1 midi-pitched-event) (event2 midi-pitched-event))
|
d@41
|
213 (>= (/ (midi-velocity event1)
|
d@41
|
214 (midi-velocity event2))
|
d@41
|
215 2))
|
d@41
|
216 (defmethod substantially-louderp ((event1 midi-percussive-event) (event2 midi-percussive-event))
|
d@41
|
217 (>= (/ (midi-velocity event1)
|
d@41
|
218 (midi-velocity event2))
|
d@41
|
219 2))
|
d@114
|
220
|
d@130
|
221 (defmethod crotchet ((object midi-object))
|
d@139
|
222 (make-standard-period 1))
|
d@157
|
223
|
d@157
|
224 (defmethod monody ((identifier midifile-identifier))
|
d@157
|
225 (monody (get-composition identifier)))
|
d@157
|
226
|
d@157
|
227 ;; TODO: improve this naive first-cut at MONODY for midi files which
|
d@157
|
228 ;; simply selects a track which is both monodic (if any monodic tracks
|
d@157
|
229 ;; exist) and contains the highest pitch of any monodic track.
|
d@157
|
230 (defmethod monody ((c midi-composition))
|
d@157
|
231 (flet ((not-overlapping (track)
|
d@157
|
232 (let ((result t)
|
d@157
|
233 (track (sort (copy-list track) #'amuse:time<)))
|
d@157
|
234 (dotimes (i (1- (length track)) result)
|
d@157
|
235 (let ((e1 (elt track i))
|
d@157
|
236 (e2 (elt track (1+ i))))
|
d@157
|
237 (unless (or (before e1 e2) (meets e1 e2))
|
d@157
|
238 (setf result nil)))))))
|
d@157
|
239 (let ((tracks (make-hash-table))
|
d@157
|
240 (result nil)
|
d@157
|
241 (max-pitch 0))
|
d@157
|
242 (sequence:dosequence (message c)
|
d@157
|
243 (let* ((tracknum (amuse-midi:midi-track message))
|
d@157
|
244 (track (gethash tracknum tracks)))
|
d@157
|
245 (setf (gethash tracknum tracks) (cons message track))))
|
d@157
|
246 (maphash #'(lambda (k v)
|
d@157
|
247 (declare (ignore k))
|
d@157
|
248 (let ((max (apply #'max (mapcar #'midi-pitch-number v))))
|
d@157
|
249 (when (and (not-overlapping v) (> max max-pitch))
|
d@157
|
250 (setf result (sort v #'amuse:time<)
|
d@157
|
251 max-pitch max))))
|
d@157
|
252 tracks)
|
d@157
|
253 (when result
|
d@157
|
254 (let ((monody (make-instance 'midi-monody
|
d@157
|
255 :time (amuse:timepoint c)
|
d@157
|
256 :interval (amuse:duration c)
|
d@157
|
257 :time-signatures (time-signatures c)
|
d@157
|
258 :key-signatures (key-signatures c)
|
d@157
|
259 :tempi (tempi c)
|
d@157
|
260 :controllers (%midi-misc-controllers c))))
|
d@157
|
261 (sequence:adjust-sequence monody (length result)
|
d@157
|
262 :initial-contents result)
|
d@157
|
263 monody)))))
|
d@157
|
264
|
d@157
|
265 (defmethod trim-enclosing-silence ((composition midi-composition))
|
d@157
|
266 (let ((start (timepoint (bar-before (onset (elt composition 0))
|
d@157
|
267 composition)))
|
d@157
|
268 (end)
|
d@157
|
269 (new-sequence) (new-composition))
|
d@157
|
270 ;; First attend to the events themselves - copy and slide
|
d@157
|
271 (sequence:dosequence (event composition)
|
d@157
|
272 (push (copy-event event) new-sequence)
|
d@157
|
273 (setf (timepoint (car new-sequence)) (- (timepoint event)
|
d@157
|
274 start))
|
d@157
|
275 (when (or (not end)
|
d@157
|
276 (> (timepoint (cut-off event)) end))
|
d@157
|
277 (setf end (timepoint (cut-off event)))))
|
d@157
|
278 ;; Make the new composition with slid events
|
d@157
|
279 ;; Should work, but doesn't
|
d@157
|
280 #+nil
|
d@157
|
281 (setf new-composition (sequence:make-sequence-like composition 0))
|
d@157
|
282 (setf new-composition (make-instance 'midi-composition
|
d@157
|
283 :time 0
|
d@157
|
284 :interval (- end start)))
|
d@157
|
285 (setf (amuse::%list-slot-sequence-data new-composition)
|
d@157
|
286 (reverse new-sequence))
|
d@157
|
287 ;; Time-sigs
|
d@157
|
288 (let ((sigs))
|
d@157
|
289 (dolist (sig (time-signatures composition))
|
d@157
|
290 ;; only include if signature affects window
|
d@157
|
291 (when (and (> (timepoint (cut-off sig))
|
d@157
|
292 start)
|
d@157
|
293 (< (timepoint sig)
|
d@157
|
294 end))
|
d@157
|
295 ;; copy the signature
|
d@157
|
296 (push (copy-time-signature sig)
|
d@157
|
297 sigs)
|
d@157
|
298 ;; adjust the timing
|
d@157
|
299 (setf (timepoint (car sigs))
|
d@157
|
300 (max 0 (- (timepoint (car sigs)) start))
|
d@157
|
301 (duration (car sigs))
|
d@157
|
302 (- (min (timepoint (cut-off (car sigs)))
|
d@157
|
303 (- end start))
|
d@157
|
304 (timepoint (car sigs))))))
|
d@157
|
305 (setf (time-signatures new-composition) (reverse sigs)))
|
d@157
|
306 (let ((sigs))
|
d@157
|
307 (dolist (sig (key-signatures composition))
|
d@157
|
308 ;; only include if signature affects window
|
d@157
|
309 (when (and (> (timepoint (cut-off sig))
|
d@157
|
310 start)
|
d@157
|
311 (< (timepoint sig)
|
d@157
|
312 end))
|
d@157
|
313 ;; copy the signature
|
d@157
|
314 (push (copy-key-signature sig)
|
d@157
|
315 sigs)
|
d@157
|
316 ;; adjust the timing
|
d@157
|
317 (setf (timepoint (car sigs))
|
d@157
|
318 (max 0 (- (timepoint (car sigs)) start))
|
d@157
|
319 (duration (car sigs))
|
d@157
|
320 (- (min (timepoint (cut-off (car sigs)))
|
d@157
|
321 (- end start))
|
d@157
|
322 (timepoint (car sigs))))))
|
d@157
|
323 (setf (key-signatures new-composition) (reverse sigs)))
|
d@157
|
324 (let ((tempi))
|
d@157
|
325 (dolist (tempo (tempi composition))
|
d@157
|
326 ;; only include if signature affects window
|
d@157
|
327 (when (and (> (timepoint (cut-off tempo))
|
d@157
|
328 start)
|
d@157
|
329 (< (timepoint tempo)
|
d@157
|
330 end))
|
d@157
|
331 ;; copy the signature
|
d@157
|
332 (push (copy-tempo tempo)
|
d@157
|
333 tempi)
|
d@157
|
334 ;; adjust the timing
|
d@157
|
335 (setf (timepoint (car tempi))
|
d@157
|
336 (max 0 (- (timepoint (car tempi)) start))
|
d@157
|
337 (duration (car tempi))
|
d@157
|
338 (- (min (timepoint (cut-off (car tempi)))
|
d@157
|
339 (- end start))
|
d@157
|
340 (timepoint (car tempi))))))
|
d@157
|
341 (setf (tempi new-composition) (reverse tempi)))
|
d@157
|
342 new-composition))
|
d@157
|
343
|
d@157
|
344
|
d@157
|
345 (defgeneric bar-before (moment composition))
|
d@157
|
346
|
d@157
|
347 (defmethod bar-before (moment (composition midi-composition))
|
d@157
|
348 "Returns the moment at which the containing bar begins"
|
d@157
|
349 (do ((time-sigs (time-signatures composition) (cdr time-sigs)))
|
d@157
|
350 ((null time-sigs) nil)
|
d@157
|
351 (let ((bar-period (make-standard-period
|
d@157
|
352 (crotchets-in-a-bar (car time-sigs)))))
|
d@157
|
353 (when (time> (cut-off (car time-sigs))
|
d@157
|
354 moment)
|
d@157
|
355 (do ((bar (time+ (onset (car time-sigs)) bar-period)
|
d@157
|
356 (time+ bar bar-period))
|
d@157
|
357 (prev-bar (onset (car time-sigs))))
|
d@157
|
358 ((time> bar moment) (return-from bar-before prev-bar))
|
d@165
|
359 (setf prev-bar bar))))))
|
d@165
|
360
|
d@165
|
361 (defmethod get-applicable-time-signatures ((anchored-period anchored-period)
|
d@165
|
362 (composition midi-composition))
|
d@165
|
363 (%find-overlapping anchored-period (time-signatures composition)))
|
d@165
|
364 (defmethod get-applicable-tempi ((anchored-period anchored-period)
|
d@165
|
365 (composition midi-composition))
|
d@165
|
366 (%find-overlapping anchored-period (tempi composition)))
|
d@165
|
367 (defmethod get-applicable-key-signatures ((anchored-period anchored-period)
|
d@165
|
368 (composition midi-composition))
|
d@165
|
369 (%find-overlapping anchored-period (key-signatures composition)))
|
d@165
|
370
|
d@165
|
371 (defun %find-overlapping (period1 period-list)
|
d@165
|
372 (let ((result-list))
|
d@165
|
373 (dolist (period2 period-list result-list)
|
d@165
|
374 (cond
|
d@165
|
375 ((time>= period2 (cut-off period1))
|
d@165
|
376 (return-from %find-overlapping (reverse result-list)))
|
d@165
|
377 ((time> (cut-off period2) period1)
|
j@278
|
378 (push period2 result-list))))))
|