d@35: (cl:in-package #:amuse-midi) d@35: d@35: (defun midifile-id (pathname) d@134: "Creates an identifier for MIDI files, based on a pathname" d@35: (make-instance 'midifile-identifier :path pathname)) d@35: d@35: (defmethod get-composition ((identifier midifile-identifier)) d@35: (%initialise-midifile-composition (midi:read-midi-file j@281: (midifile-identifier-pathname identifier)) j@281: identifier)) d@35: j@281: (defun %initialise-midifile-composition (midifile identifier) d@35: ;; Takes a midifile object (from the "MIDI" package) d@35: ;; and returns an amuse midi object d@35: ;; FIXME: gets it wrong if patch changes in mid-note d@35: ;; FIXME: assumes controllers are global in scope and location d@35: (let ((tracks (midi:midifile-tracks midifile)) d@35: (division (midi:midifile-division midifile)) d@115: (notes) (time-sigs) (key-sigs) (tempi) (misses 0) d@115: (track-no -1) (last-time 0)) d@35: (dolist (track tracks) d@35: (incf track-no) d@35: (setf track (sort (copy-seq track) d@35: #'(lambda (x y) d@35: (or (< (midi:message-time x) d@35: (midi:message-time y)) d@35: (and (= (midi:message-time x) d@35: (midi:message-time y)) d@35: (typep x 'midi:note-off-message)))))) d@36: (let ((ons (make-array '(16 128) :initial-element nil)) d@35: (offs) d@36: (patches (make-array 16 :initial-element 0))) d@35: (dolist (event track) d@35: (when (> (midi:message-time event) last-time) d@35: (setf last-time (midi:message-time event))) d@35: (cond d@35: ((or (typep event 'midi:note-off-message) d@35: (and (typep event 'midi:note-on-message) d@35: (= (midi:message-velocity event) 0))) d@35: (let ((pitch (midi:message-key event)) d@36: (channel (midi:message-channel event)) d@35: (t-off (midi:message-time event))) d@35: (if (aref ons channel pitch) m@145: (progn m@145: (push (make-event-from-on-off-pair (aref ons channel pitch) m@145: t-off m@145: division m@145: track-no m@145: (aref patches channel)) m@145: notes) m@145: (setf (aref ons channel pitch) nil)) d@35: ;; if there's no matching on, wait until the beat d@35: ;; is done. d@35: (push event offs)))) d@35: ((typep event 'midi:note-on-message) d@35: (let ((pitch (midi:message-key event)) d@36: (channel (midi:message-channel event)) d@35: (t-off (midi:message-time event))) d@35: (when (aref ons channel pitch) d@35: ;; there's a note already sounding. End it. d@35: (push (make-event-from-on-off-pair (aref ons channel pitch) d@35: t-off d@35: division d@35: track-no d@35: (aref patches channel)) d@35: notes)) d@35: (setf (aref ons channel pitch) event))) d@35: ((typep event 'midi:time-signature-message) d@35: ;; FIXME: Should I make a midi version of this object, d@35: ;; with track/channel? d@35: (when time-sigs d@35: (setf (duration (car time-sigs)) d@35: (- (/ (midi:message-time event) d@35: division) d@35: (timepoint (car time-sigs))))) d@136: (push (make-instance 'standard-time-signature-period d@35: :time (/ (midi:message-time event) d@35: division) d@35: :numerator (midi:message-numerator event) d@36: :denominator (expt 2 (midi:message-denominator event))) d@35: time-sigs)) d@115: ((typep event 'midi:key-signature-message) d@115: ;; FIXME: Should I make a midi version of this object, d@115: ;; with track/channel? [probably, yes] d@115: (when key-sigs d@115: (setf (duration (car time-sigs)) d@115: (- (/ (midi:message-time event) d@115: division) d@115: (timepoint (car time-sigs))))) d@136: (push (make-instance 'midi-key-signature-period d@115: :time (/ (midi:message-time event) d@115: division) d@119: :sharp-count (midi:message-sf event) d@119: :mode (midi:message-mi event)) d@115: key-sigs)) d@35: ((typep event 'midi:tempo-message) d@35: (when tempi d@35: (setf (duration (car tempi)) d@35: (- (/ (midi:message-time event) d@35: division) d@35: (timepoint (car tempi))))) d@136: (push (make-instance 'standard-tempo-period d@35: :time (/ (midi:message-time event) d@35: division) d@35: :bpm (microsecond-per-crotchet-to-bpm (midi:message-tempo event))) d@35: tempi)) d@35: ((typep event 'midi:program-change-message) d@36: (setf (aref patches (midi:message-channel event)) d@35: (midi:message-program event))) d@35: (t (incf misses)))))) d@35: (when tempi d@35: (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi))))) d@35: (when time-sigs d@35: (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs))))) d@115: (when key-sigs d@115: (setf (duration (car key-sigs)) (- (/ last-time division) (timepoint (car key-sigs))))) d@35: ;; make a midi object from notes, etc. d@35: (let ((composition (make-instance 'midi-composition d@35: :time 0 d@35: :interval (/ last-time division) d@36: :time-signatures (if time-sigs d@36: (sort time-sigs #'time<) d@136: (list (make-standard-time-signature-period d@136: 4 4 0 (/ last-time division)))) d@115: :tempi (sort tempi #'time<) j@281: :key-signatures (sort key-sigs #'time<) j@281: :identifier identifier j@281: :midi-timebase division))) d@35: (sequence:adjust-sequence composition d@35: (length notes) d@35: :initial-contents (sort notes #'time<))))) d@35: d@35: (defun make-event-from-on-off-pair (note-on cut-off divisions track patch) d@35: (cond d@35: ((or (= (midi:message-channel note-on) 9) d@35: (> patch 111)) d@35: ;; percussive d@35: (make-instance 'midi-percussive-event d@35: :channel (1+ (midi:message-channel note-on)) d@35: :track track d@35: :time (/ (midi:message-time note-on) divisions) d@35: :interval (/ (- cut-off (midi:message-time note-on)) d@35: divisions) d@35: :velocity (midi:message-velocity note-on) d@35: :patch patch d@35: :sound (midi:message-key note-on))) d@35: (t d@35: ;; pitched d@35: (make-instance 'midi-pitched-event d@35: :channel (1+ (midi:message-channel note-on)) d@35: :track track d@35: :time (/ (midi:message-time note-on) divisions) d@35: :interval (/ (- cut-off (midi:message-time note-on)) d@35: divisions) d@35: :velocity (midi:message-velocity note-on) d@35: :patch patch m@145: :number (midi:message-key note-on)))))