|
d@35
|
1 (cl:in-package #:amuse-midi)
|
|
d@35
|
2
|
|
d@130
|
3 (defclass midifile-identifier (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)
|
|
d@35
|
50 (push (make-event-from-on-off-pair (aref ons channel pitch)
|
|
d@35
|
51 t-off
|
|
d@35
|
52 division
|
|
d@35
|
53 track-no
|
|
d@35
|
54 (aref patches channel))
|
|
d@35
|
55 notes)
|
|
d@35
|
56 ;; if there's no matching on, wait until the beat
|
|
d@35
|
57 ;; is done.
|
|
d@35
|
58 (push event offs))))
|
|
d@35
|
59 ((typep event 'midi:note-on-message)
|
|
d@35
|
60 (let ((pitch (midi:message-key event))
|
|
d@36
|
61 (channel (midi:message-channel event))
|
|
d@35
|
62 (t-off (midi:message-time event)))
|
|
d@35
|
63 (when (aref ons channel pitch)
|
|
d@35
|
64 ;; there's a note already sounding. End it.
|
|
d@35
|
65 (push (make-event-from-on-off-pair (aref ons channel pitch)
|
|
d@35
|
66 t-off
|
|
d@35
|
67 division
|
|
d@35
|
68 track-no
|
|
d@35
|
69 (aref patches channel))
|
|
d@35
|
70 notes))
|
|
d@35
|
71 (setf (aref ons channel pitch) event)))
|
|
d@35
|
72 ((typep event 'midi:time-signature-message)
|
|
d@35
|
73 ;; FIXME: Should I make a midi version of this object,
|
|
d@35
|
74 ;; with track/channel?
|
|
d@35
|
75 (when time-sigs
|
|
d@35
|
76 (setf (duration (car time-sigs))
|
|
d@35
|
77 (- (/ (midi:message-time event)
|
|
d@35
|
78 division)
|
|
d@35
|
79 (timepoint (car time-sigs)))))
|
|
d@136
|
80 (push (make-instance 'standard-time-signature-period
|
|
d@35
|
81 :time (/ (midi:message-time event)
|
|
d@35
|
82 division)
|
|
d@35
|
83 :numerator (midi:message-numerator event)
|
|
d@36
|
84 :denominator (expt 2 (midi:message-denominator event)))
|
|
d@35
|
85 time-sigs))
|
|
d@115
|
86 ((typep event 'midi:key-signature-message)
|
|
d@115
|
87 ;; FIXME: Should I make a midi version of this object,
|
|
d@115
|
88 ;; with track/channel? [probably, yes]
|
|
d@115
|
89 (when key-sigs
|
|
d@115
|
90 (setf (duration (car time-sigs))
|
|
d@115
|
91 (- (/ (midi:message-time event)
|
|
d@115
|
92 division)
|
|
d@115
|
93 (timepoint (car time-sigs)))))
|
|
d@136
|
94 (push (make-instance 'midi-key-signature-period
|
|
d@115
|
95 :time (/ (midi:message-time event)
|
|
d@115
|
96 division)
|
|
d@119
|
97 :sharp-count (midi:message-sf event)
|
|
d@119
|
98 :mode (midi:message-mi event))
|
|
d@115
|
99 key-sigs))
|
|
d@35
|
100 ((typep event 'midi:tempo-message)
|
|
d@35
|
101 (when tempi
|
|
d@35
|
102 (setf (duration (car tempi))
|
|
d@35
|
103 (- (/ (midi:message-time event)
|
|
d@35
|
104 division)
|
|
d@35
|
105 (timepoint (car tempi)))))
|
|
d@136
|
106 (push (make-instance 'standard-tempo-period
|
|
d@35
|
107 :time (/ (midi:message-time event)
|
|
d@35
|
108 division)
|
|
d@35
|
109 :bpm (microsecond-per-crotchet-to-bpm (midi:message-tempo event)))
|
|
d@35
|
110 tempi))
|
|
d@35
|
111 ((typep event 'midi:program-change-message)
|
|
d@36
|
112 (setf (aref patches (midi:message-channel event))
|
|
d@35
|
113 (midi:message-program event)))
|
|
d@35
|
114 (t (incf misses))))))
|
|
d@35
|
115 (when tempi
|
|
d@35
|
116 (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi)))))
|
|
d@35
|
117 (when time-sigs
|
|
d@35
|
118 (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs)))))
|
|
d@115
|
119 (when key-sigs
|
|
d@115
|
120 (setf (duration (car key-sigs)) (- (/ last-time division) (timepoint (car key-sigs)))))
|
|
d@35
|
121 ;; make a midi object from notes, etc.
|
|
d@35
|
122 (let ((composition (make-instance 'midi-composition
|
|
d@35
|
123 :time 0
|
|
d@35
|
124 :interval (/ last-time division)
|
|
d@36
|
125 :time-signatures (if time-sigs
|
|
d@36
|
126 (sort time-sigs #'time<)
|
|
d@136
|
127 (list (make-standard-time-signature-period
|
|
d@136
|
128 4 4 0 (/ last-time division))))
|
|
d@115
|
129 :tempi (sort tempi #'time<)
|
|
d@119
|
130 :key-signatures (sort key-sigs #'time<))))
|
|
d@35
|
131 (sequence:adjust-sequence composition
|
|
d@35
|
132 (length notes)
|
|
d@35
|
133 :initial-contents (sort notes #'time<)))))
|
|
d@35
|
134
|
|
d@35
|
135 (defun make-event-from-on-off-pair (note-on cut-off divisions track patch)
|
|
d@35
|
136 (cond
|
|
d@35
|
137 ((or (= (midi:message-channel note-on) 9)
|
|
d@35
|
138 (> patch 111))
|
|
d@35
|
139 ;; percussive
|
|
d@35
|
140 (make-instance 'midi-percussive-event
|
|
d@35
|
141 :channel (1+ (midi:message-channel note-on))
|
|
d@35
|
142 :track track
|
|
d@35
|
143 :time (/ (midi:message-time note-on) divisions)
|
|
d@35
|
144 :interval (/ (- cut-off (midi:message-time note-on))
|
|
d@35
|
145 divisions)
|
|
d@35
|
146 :velocity (midi:message-velocity note-on)
|
|
d@35
|
147 :patch patch
|
|
d@35
|
148 :sound (midi:message-key note-on)))
|
|
d@35
|
149 (t
|
|
d@35
|
150 ;; pitched
|
|
d@35
|
151 (make-instance 'midi-pitched-event
|
|
d@35
|
152 :channel (1+ (midi:message-channel note-on))
|
|
d@35
|
153 :track track
|
|
d@35
|
154 :time (/ (midi:message-time note-on) divisions)
|
|
d@35
|
155 :interval (/ (- cut-off (midi:message-time note-on))
|
|
d@35
|
156 divisions)
|
|
d@35
|
157 :velocity (midi:message-velocity note-on)
|
|
d@35
|
158 :patch patch
|
|
d@35
|
159 :number (midi:message-key note-on))))) |
