|
d@35
|
1 (cl:in-package #:amuse-midi)
|
|
d@35
|
2
|
|
d@35
|
3 (defun midifile-id (pathname)
|
|
d@134
|
4 "Creates an identifier for MIDI files, based on a pathname"
|
|
d@35
|
5 (make-instance 'midifile-identifier :path pathname))
|
|
d@35
|
6
|
|
d@35
|
7 (defmethod get-composition ((identifier midifile-identifier))
|
|
d@35
|
8 (%initialise-midifile-composition (midi:read-midi-file
|
|
j@281
|
9 (midifile-identifier-pathname identifier))
|
|
j@281
|
10 identifier))
|
|
d@35
|
11
|
|
j@281
|
12 (defun %initialise-midifile-composition (midifile identifier)
|
|
d@35
|
13 ;; Takes a midifile object (from the "MIDI" package)
|
|
d@35
|
14 ;; and returns an amuse midi object
|
|
d@35
|
15 ;; FIXME: gets it wrong if patch changes in mid-note
|
|
d@35
|
16 ;; FIXME: assumes controllers are global in scope and location
|
|
d@35
|
17 (let ((tracks (midi:midifile-tracks midifile))
|
|
d@35
|
18 (division (midi:midifile-division midifile))
|
|
d@115
|
19 (notes) (time-sigs) (key-sigs) (tempi) (misses 0)
|
|
d@115
|
20 (track-no -1) (last-time 0))
|
|
d@35
|
21 (dolist (track tracks)
|
|
d@35
|
22 (incf track-no)
|
|
d@35
|
23 (setf track (sort (copy-seq track)
|
|
d@35
|
24 #'(lambda (x y)
|
|
d@35
|
25 (or (< (midi:message-time x)
|
|
d@35
|
26 (midi:message-time y))
|
|
d@35
|
27 (and (= (midi:message-time x)
|
|
d@35
|
28 (midi:message-time y))
|
|
d@35
|
29 (typep x 'midi:note-off-message))))))
|
|
d@36
|
30 (let ((ons (make-array '(16 128) :initial-element nil))
|
|
d@35
|
31 (offs)
|
|
d@36
|
32 (patches (make-array 16 :initial-element 0)))
|
|
d@35
|
33 (dolist (event track)
|
|
d@35
|
34 (when (> (midi:message-time event) last-time)
|
|
d@35
|
35 (setf last-time (midi:message-time event)))
|
|
d@35
|
36 (cond
|
|
d@35
|
37 ((or (typep event 'midi:note-off-message)
|
|
d@35
|
38 (and (typep event 'midi:note-on-message)
|
|
d@35
|
39 (= (midi:message-velocity event) 0)))
|
|
d@35
|
40 (let ((pitch (midi:message-key event))
|
|
d@36
|
41 (channel (midi:message-channel event))
|
|
d@35
|
42 (t-off (midi:message-time event)))
|
|
d@35
|
43 (if (aref ons channel pitch)
|
|
m@145
|
44 (progn
|
|
m@145
|
45 (push (make-event-from-on-off-pair (aref ons channel pitch)
|
|
m@145
|
46 t-off
|
|
m@145
|
47 division
|
|
m@145
|
48 track-no
|
|
m@145
|
49 (aref patches channel))
|
|
m@145
|
50 notes)
|
|
m@145
|
51 (setf (aref ons channel pitch) nil))
|
|
d@35
|
52 ;; if there's no matching on, wait until the beat
|
|
d@35
|
53 ;; is done.
|
|
d@35
|
54 (push event offs))))
|
|
d@35
|
55 ((typep event 'midi:note-on-message)
|
|
d@35
|
56 (let ((pitch (midi:message-key event))
|
|
d@36
|
57 (channel (midi:message-channel event))
|
|
d@35
|
58 (t-off (midi:message-time event)))
|
|
d@35
|
59 (when (aref ons channel pitch)
|
|
d@35
|
60 ;; there's a note already sounding. End it.
|
|
d@35
|
61 (push (make-event-from-on-off-pair (aref ons channel pitch)
|
|
d@35
|
62 t-off
|
|
d@35
|
63 division
|
|
d@35
|
64 track-no
|
|
d@35
|
65 (aref patches channel))
|
|
d@35
|
66 notes))
|
|
d@35
|
67 (setf (aref ons channel pitch) event)))
|
|
d@35
|
68 ((typep event 'midi:time-signature-message)
|
|
d@35
|
69 ;; FIXME: Should I make a midi version of this object,
|
|
d@35
|
70 ;; with track/channel?
|
|
d@35
|
71 (when time-sigs
|
|
d@35
|
72 (setf (duration (car time-sigs))
|
|
d@35
|
73 (- (/ (midi:message-time event)
|
|
d@35
|
74 division)
|
|
d@35
|
75 (timepoint (car time-sigs)))))
|
|
d@136
|
76 (push (make-instance 'standard-time-signature-period
|
|
d@35
|
77 :time (/ (midi:message-time event)
|
|
d@35
|
78 division)
|
|
d@35
|
79 :numerator (midi:message-numerator event)
|
|
d@36
|
80 :denominator (expt 2 (midi:message-denominator event)))
|
|
d@35
|
81 time-sigs))
|
|
d@115
|
82 ((typep event 'midi:key-signature-message)
|
|
d@115
|
83 ;; FIXME: Should I make a midi version of this object,
|
|
d@115
|
84 ;; with track/channel? [probably, yes]
|
|
d@115
|
85 (when key-sigs
|
|
d@115
|
86 (setf (duration (car time-sigs))
|
|
d@115
|
87 (- (/ (midi:message-time event)
|
|
d@115
|
88 division)
|
|
d@115
|
89 (timepoint (car time-sigs)))))
|
|
d@136
|
90 (push (make-instance 'midi-key-signature-period
|
|
d@115
|
91 :time (/ (midi:message-time event)
|
|
d@115
|
92 division)
|
|
d@119
|
93 :sharp-count (midi:message-sf event)
|
|
d@119
|
94 :mode (midi:message-mi event))
|
|
d@115
|
95 key-sigs))
|
|
d@35
|
96 ((typep event 'midi:tempo-message)
|
|
d@35
|
97 (when tempi
|
|
d@35
|
98 (setf (duration (car tempi))
|
|
d@35
|
99 (- (/ (midi:message-time event)
|
|
d@35
|
100 division)
|
|
d@35
|
101 (timepoint (car tempi)))))
|
|
d@136
|
102 (push (make-instance 'standard-tempo-period
|
|
d@35
|
103 :time (/ (midi:message-time event)
|
|
d@35
|
104 division)
|
|
d@35
|
105 :bpm (microsecond-per-crotchet-to-bpm (midi:message-tempo event)))
|
|
d@35
|
106 tempi))
|
|
d@35
|
107 ((typep event 'midi:program-change-message)
|
|
d@36
|
108 (setf (aref patches (midi:message-channel event))
|
|
d@35
|
109 (midi:message-program event)))
|
|
d@35
|
110 (t (incf misses))))))
|
|
d@35
|
111 (when tempi
|
|
d@35
|
112 (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi)))))
|
|
d@35
|
113 (when time-sigs
|
|
d@35
|
114 (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs)))))
|
|
d@115
|
115 (when key-sigs
|
|
d@115
|
116 (setf (duration (car key-sigs)) (- (/ last-time division) (timepoint (car key-sigs)))))
|
|
d@35
|
117 ;; make a midi object from notes, etc.
|
|
d@35
|
118 (let ((composition (make-instance 'midi-composition
|
|
d@35
|
119 :time 0
|
|
d@35
|
120 :interval (/ last-time division)
|
|
d@36
|
121 :time-signatures (if time-sigs
|
|
d@36
|
122 (sort time-sigs #'time<)
|
|
d@136
|
123 (list (make-standard-time-signature-period
|
|
d@136
|
124 4 4 0 (/ last-time division))))
|
|
d@115
|
125 :tempi (sort tempi #'time<)
|
|
j@281
|
126 :key-signatures (sort key-sigs #'time<)
|
|
j@281
|
127 :identifier identifier
|
|
j@281
|
128 :midi-timebase division)))
|
|
d@35
|
129 (sequence:adjust-sequence composition
|
|
d@35
|
130 (length notes)
|
|
d@35
|
131 :initial-contents (sort notes #'time<)))))
|
|
d@35
|
132
|
|
d@35
|
133 (defun make-event-from-on-off-pair (note-on cut-off divisions track patch)
|
|
d@35
|
134 (cond
|
|
d@35
|
135 ((or (= (midi:message-channel note-on) 9)
|
|
d@35
|
136 (> patch 111))
|
|
d@35
|
137 ;; percussive
|
|
d@35
|
138 (make-instance 'midi-percussive-event
|
|
d@35
|
139 :channel (1+ (midi:message-channel note-on))
|
|
d@35
|
140 :track track
|
|
d@35
|
141 :time (/ (midi:message-time note-on) divisions)
|
|
d@35
|
142 :interval (/ (- cut-off (midi:message-time note-on))
|
|
d@35
|
143 divisions)
|
|
d@35
|
144 :velocity (midi:message-velocity note-on)
|
|
d@35
|
145 :patch patch
|
|
d@35
|
146 :sound (midi:message-key note-on)))
|
|
d@35
|
147 (t
|
|
d@35
|
148 ;; pitched
|
|
d@35
|
149 (make-instance 'midi-pitched-event
|
|
d@35
|
150 :channel (1+ (midi:message-channel note-on))
|
|
d@35
|
151 :track track
|
|
d@35
|
152 :time (/ (midi:message-time note-on) divisions)
|
|
d@35
|
153 :interval (/ (- cut-off (midi:message-time note-on))
|
|
d@35
|
154 divisions)
|
|
d@35
|
155 :velocity (midi:message-velocity note-on)
|
|
d@35
|
156 :patch patch
|
|
m@145
|
157 :number (midi:message-key note-on)))))
|
