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