Mercurial > hg > amuse
changeset 204:10d47e78a53d
Added support for most significant midi messages (some remain missing,
but these do not occur in a 1000-file test sample)
| author | David Lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Fri, 17 Sep 2010 10:28:27 +0100 |
| parents | 23b97270de8b |
| children | |
| files | implementations/midi/classes.lisp implementations/midi/midifile-import.lisp |
| diffstat | 2 files changed, 387 insertions(+), 36 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/midi/classes.lisp Wed Sep 08 13:06:57 2010 +0100 +++ b/implementations/midi/classes.lisp Fri Sep 17 10:28:27 2010 +0100 @@ -18,6 +18,15 @@ (key-signatures :initarg :key-signatures :initform 'nil :accessor %midi-key-signatures) + (pitch-bends :initarg :pitch-bends + :initform 'nil + :accessor %midi-pitch-bends) + (lyrics :initarg :lyrics + :initform 'nil + :accessor %midi-lyrics) + (texts :initarg :texts + :initform 'nil + :accessor %midi-texts) (misc-controllers :initarg :controllers :initform 'nil :accessor %midi-misc-controllers)) @@ -28,23 +37,196 @@ (defclass midi-monody (amuse:standard-monody midi-composition) ()) -(defclass midi-message (midi-object) ;? - ((channel :accessor %midi-message-channel :initarg :channel) - (track :accessor %midi-message-track :initarg :track))) +(defclass midi-message (midi-object) + ((track :accessor %midi-message-track :initarg :track :type integer))) -(defclass midi-pitched-event (standard-chromatic-pitched-event midi-message) +(defclass channel-message (midi-message) + ((channel :accessor %midi-message-channel :initarg :channel :type (integer 0 15)))) + + +(defclass midi-pitched-event (standard-chromatic-pitched-event channel-message) ((velocity :initarg :velocity - :accessor %midi-pitched-event-velocity) + :accessor %midi-pitched-event-velocity + :type (integer 0 127)) (patch :initarg :patch :accessor %midi-pitched-event-patch)) (:documentation "Adds MIDI information to chromatic-pitched-event")) -(defclass midi-percussive-event (standard-percussive-event midi-message) +(defclass midi-percussive-event (standard-percussive-event channel-message) ((velocity :initarg :velocity - :accessor %midi-percussive-event-velocity) + :accessor %midi-percussive-event-velocity + :type (integer 0 127)) (patch :initarg :patch :accessor %midi-percussive-event-patch) (sound :initarg :sound :accessor %midi-percussive-event-sound)) (:documentation "Adds MIDI information to percussive-event")) +(defclass pitch-bend-message (channel-message) + ((value :initarg :value :accessor %midi-pitch-bend-value + :type (integer 0 16383)))) +(defclass pitch-bend-period (pitch-bend-message standard-anchored-period) ()) + +;; FIXME: these moments should be anchored-periods +(defclass channel-aftertouch-message (channel-message) + ((pressure :initarg :pressure :accessor %channel-pressure + :type (integer 0 127)))) +(defclass channel-aftertouch-moment (channel-aftertouch-message standard-moment) ()) +#+nil #+nil +;; not used -- we put program information into the events +(defclass program-change-message (channel-message) + ((program :initarg :program :accessor %program-change-program + :type (integer 0 127)))) +(defclass program-change-moment (program-change-message standard-moment) ()) +(defclass aftertouch-message (channel-message) ;;`polyphonic key pressure' + ((pressure :initarg :pressure :accessor %aftertouch-pressure + :type (integer 0 127)) + (key :initarg :key :accessor key + :type (integer 0 127)))) +(defclass aftertouch-moment (aftertouch-message standard-moment) ()) + + +(defclass text-message (midi-message) + ((text :initarg :text :accessor %midi-text + :type string))) +(defclass text-moment (text-message standard-moment) ()) +(defclass lyric-moment (text-moment) ()) +(defclass copyright-moment (text-moment) ()) +(defclass sequence-or-track-moment (text-moment) + ((channel :accessor %midi-message-channel :initarg :channel :type (integer 0 15)))) +(defclass instrument-name-moment (text-moment) ()) +(defclass marker-moment (text-moment) ()) +(defclass cue-moment (text-moment) ()) +(defclass program-name-moment (text-moment) ()) +(defclass device-name-moment (text-moment) ()) + +(defclass parameter-message-set (channel-message) + ((lsb :initarg :lsb :accessor %value-lsb :initform nil + :type (integer 0 127)) + (msb :initarg :msb :accessor %value-msb :initform nil + :type (integer 0 127)))) +(defclass registered-parameter-message-set (parameter-message-set) ()) +(defclass non-registered-parameter-message-set (parameter-message-set) + ((parameter-lsb :initarg :nrpn-lsb :accessor %nrpn-lsb + :type (integer 0 127)) + (parameter-msb :initarg :nrpn-msb :accessor %nrpn-msb + :type (integer 0 127)))) +(defclass pitch-bend-sensitivity (registered-parameter-message-set) ()) +;; This may be moment or period, for now, moment +(defclass pitch-bend-sensitivity-moment (pitch-bend-sensitivity standard-moment) ()) +(defclass channel-fine-tuning-moment (registered-parameter-message-set standard-moment) ()) +(defclass channel-course-tuning-moment (registered-parameter-message-set standard-moment) ()) +(defclass tuning-program-moment (registered-parameter-message-set standard-moment) ()) +(defclass tuning-bank-moment (registered-parameter-message-set standard-moment) ()) +(defclass modulation-depth-moment (registered-parameter-message-set standard-moment) ()) +(defclass unknown-registered-parameter-moment (registered-parameter-message-set standard-moment) + ((register-lsb :initarg :reg-lsb :accessor %rpn-reg-lsb + :type (integer 0 127)) + (register-msb :initarg :reg-msb :accessor %rpn-reg-msb + :type (integer 0 127)))) +(defclass non-registered-parameter-moment (non-registered-parameter-message-set standard-moment) ()) + +(defclass system-exclusive-message (midi-message) + ((status :initarg :status :initform 240 :accessor %system-exclusive-status + :type (member 240 247)) + (value :initarg :value :accessor %system-exclusive-value + :type (array (integer 0 255) *)))) +(defclass system-exclusive-moment (system-exclusive-message standard-moment) ()) + +(defclass control-change-message (channel-message) + ;; c.f. HA's midi_param table + ((control-number :initarg :control :accessor %midi-control-number + :type (integer 0 127)) + (value :initarg :value :accessor %midi-control-value + :type (integer 0 127)))) +(defclass control-change-moment (control-change-message standard-moment) ()) + +;;;;;;;;;;;;;;;; +;; Necessary? don't really know, but still + +(defparameter *controllers* + #(;;0-7 + "Bank Select (MSB)" "Modulation Wheel (MSB)" + "Breath Controller (MSB)" :undefined + "Foot Controller (MSB)" "Portamento Time (MSB)" + "Data Entry (MSB)" "Channel Volume (MSB)" + ;; 8-15 + "Balance (MSB) " :undefined + "Pan (MSB)" "Expression (MSB)" + "Effect Control 1 (MSB)" "Effect Control 2 (MSB)" + :undefined :undefined + ;; 16-23 + "General Purpose Controller 1 (MSB)" + "General Purpose Controller 2 (MSB)" + "General Purpose Controller 3 (MSB)" + "General Purpose Controller 4 (MSB) " + :undefined :undefined :undefined :undefined + ;; 24-31 + :undefined :undefined :undefined :undefined + :undefined :undefined :undefined :undefined + ;; 32-39 + "Bank Select (LSB)" "Modulation Wheel (LSB)" + "Breath Controller (LSB)" :undefined + "Foot Controller (LSB)" "Portamento Time (LSB)" + "Data Entry (LSB) Channel" "Channel Volume (LSB)" + ;; 40-47 + "Balance (LSB)" :undefined + "Pan (LSB)" "Expression (LSB)" + "Effect Control 1 (LSB)" "Effect Control 2 (LSB) " + :undefined undefined + ;; 48-55 + "General Purpose Controller 1 (LSB)" + "General Purpose Controller 2 (LSB)" + "General Purpose Controller 3 (LSB)" + "General Purpose Controller 4 (LSB)" + :undefined :undefined :undefined :undefined + ;; 56-63 + :undefined :undefined :undefined :undefined + :undefined :undefined :undefined :undefined + ;; 64-71 + "Sustain Pedal" "Portamento On/Off" + "Sostenuto" "Soft Pedal" + "Legato Footswitch" "Hold 2" + "Sound Controller 1" "Sound Controller 2" + ;; 72-79 + "Sound Controller 3" "Sound Controller 4" + "Sound Controller 5" "Sound Controller 6" + "Sound Controller 7" "Sound Controller 8" + "Sound Controller 9" "Sound Controller 10 (GM2 default: Undefined)" + ;; 80-87 + "General Purpose Controller 5" + "General Purpose Controller 6" + "General Purpose Controller 7" + "General Purpose Controller 8" + "Portamento Control " + :undefined :undefined :undefined + ;; 88-95 + :undefined :undefined :undefined + "Effects 1 Depth (default: Reverb Send)" + "Effects 2 Depth (default: Tremolo Depth)" + "Effects 3 Depth (default: Chorus Send)" + "Effects 4 Depth (default: Celeste [Detune] Depth)" + "Effects 5 Depth (default: Phaser Depth)" + ;; 96-103 + "Data Increment" + "Data Decrement" + "Non-Registered Parameter Number (LSB)" + "Non-Registered Parameter Number (MSB)" + "Registered Parameter Number (LSB)" + "Registered Parameter Number (MSB)" + :undefined :undefined + ;; 104-111 + :undefined :undefined :undefined :undefined + :undefined :undefined :undefined :undefined + ;; 112-119 + :undefined :undefined :undefined :undefined + :undefined :undefined :undefined :undefined + ;; 120-127 + "All Sound Off" + "Reset All Controllers" + "Local Control On/Off" + "All Notes Off" + "Omni Mode Off" + "Omni Mode On" + "Poly Mode Off" + "Poly Mode On "))
--- a/implementations/midi/midifile-import.lisp Wed Sep 08 13:06:57 2010 +0100 +++ b/implementations/midi/midifile-import.lisp Fri Sep 17 10:28:27 2010 +0100 @@ -24,7 +24,11 @@ ;; FIXME: assumes controllers are global in scope and location (let ((tracks (midi:midifile-tracks midifile)) (division (midi:midifile-division midifile)) - (notes) (time-sigs) (key-sigs) (tempi) (misses 0) + (notes) (time-sigs) (key-sigs) (tempi) + (pitch-bends) (texts) (lyrics) + (rpn-lsb) (rpn-msb) + (nrpn-msb) (nrpn-lsb) + (misc-controllers) (track-no -1) (last-time 0)) (when *default-tempo* (push (make-instance 'standard-tempo-period @@ -43,19 +47,20 @@ (offs) (patches (make-array 16 :initial-element 0))) (dolist (event track) - (when (> (midi:message-time event) last-time) - (setf last-time (midi:message-time event))) - (cond - ((or (typep event 'midi:note-off-message) - (and (typep event 'midi:note-on-message) - (= (midi:message-velocity event) 0))) - (let ((pitch (midi:message-key event)) - (channel (midi:message-channel event)) - (t-off (midi:message-time event))) + (let* ((midi-time (midi:message-time event)) + (event-time (/ midi-time division))) + (when (> midi-time last-time) + (setf last-time midi-time)) + (cond + ((or (typep event 'midi:note-off-message) + (and (typep event 'midi:note-on-message) + (= (midi:message-velocity event) 0))) + (let ((pitch (midi:message-key event)) + (channel (midi:message-channel event))) (if (aref ons channel pitch) (progn (push (make-event-from-on-off-pair (aref ons channel pitch) - t-off + midi-time division track-no (aref patches channel)) @@ -66,12 +71,11 @@ (push event offs)))) ((typep event 'midi:note-on-message) (let ((pitch (midi:message-key event)) - (channel (midi:message-channel event)) - (t-off (midi:message-time event))) + (channel (midi:message-channel event))) (when (aref ons channel pitch) ;; there's a note already sounding. End it. (push (make-event-from-on-off-pair (aref ons channel pitch) - t-off + midi-time division track-no (aref patches channel)) @@ -82,12 +86,10 @@ ;; with track/channel? (when time-sigs (setf (duration (car time-sigs)) - (- (/ (midi:message-time event) - division) + (- event-time (timepoint (car time-sigs))))) (push (make-instance 'standard-time-signature-period - :time (/ (midi:message-time event) - division) + :time event-time :numerator (midi:message-numerator event) :denominator (expt 2 (midi:message-denominator event))) time-sigs)) @@ -96,18 +98,16 @@ ;; with track/channel? [probably, yes] (when key-sigs (setf (duration (car time-sigs)) - (- (/ (midi:message-time event) - division) + (- event-time (timepoint (car time-sigs))))) (push (make-instance 'midi-key-signature-period - :time (/ (midi:message-time event) - division) + :time event-time :sharp-count (midi:message-sf event) :mode (midi:message-mi event)) key-sigs)) ((typep event 'midi:tempo-message) (when tempi - (if (= (midi:message-time event) 0) + (if (= midi-time 0) ;; to allow for default tempo kludge. Nightingale ;; seems to happily export midi with no initial ;; tempo, but tempo changes later. Making this @@ -116,20 +116,79 @@ ;; answer) (setf tempi nil) (setf (duration (car tempi)) - (- (/ (midi:message-time event) - division) + (- event-time (timepoint (car tempi)))))) (push (make-instance 'standard-tempo-period - :time (/ (midi:message-time event) - division) + :time event-time :bpm (microsecond-per-crotchet-to-bpm (midi:message-tempo event))) tempi)) ((typep event 'midi:program-change-message) (setf (aref patches (midi:message-channel event)) (midi:message-program event))) - (t (incf misses)))))) + ((typep event 'midi:pitch-bend-message) + (when pitch-bends + (setf (duration (car pitch-bends)) + (- event-time + (timepoint (car pitch-bends))))) + (push (make-controller-moment event track-no event-time) + pitch-bends)) + ((typep event 'midi::lyric-message) + (push (make-controller-moment event track-no event-time) + lyrics)) + ((typep event 'midi::text-message) + (push (make-controller-moment event track-no event-time) + texts)) + ((and (typep event 'midi::control-change-message) + (< 97 (slot-value event 'midi::controller) 102) + (= (slot-value event 'midi::controller) 127)) + ;; this can only be part of an end-of-this-rpn/nrpn message, + ;; and these don't really nest because of shared controllers. + (setf rpn-lsb nil + rpn-msb nil + nrpn-lsb nil + nrpn-msb nil)) + ((and (typep event 'midi::control-change-message) + (< 99 (slot-value event 'midi::controller) 102)) + ;; setting rpn, not nrpn + (setf nrpn-lsb nil + nrpn-msb nil) + (if (= (slot-value event 'midi::controller) 100) + (setf rpn-lsb (slot-value event 'midi::value)) + (setf rpn-msb (slot-value event 'midi::value)))) + ((and (typep event 'midi::control-change-message) + (< 97 (slot-value event 'midi::controller) 100)) + ;; setting nrpn, not rpn + (setf rpn-lsb nil + rpn-msb nil) + (if (= (slot-value event 'midi::controller) 98) + (setf nrpn-lsb (slot-value event 'midi::value)) + (setf nrpn-msb (slot-value event 'midi::value)))) + ((and (typep event 'midi::control-change-message) + (= (slot-value event 'midi::controller) 38)) + (push (make-parameter-moment (slot-value event 'midi::value) nil + event-time track-no + rpn-lsb rpn-msb nrpn-lsb nrpn-msb) + misc-controllers)) + ((and (typep event 'midi::control-change-message) + (= (slot-value event 'midi::controller) 6)) + (push (make-parameter-moment nil (slot-value event 'midi::value) + event-time track-no + rpn-lsb rpn-msb nrpn-lsb nrpn-msb) + misc-controllers)) + ((typep event 'midi::channel-prefix-message) + ;; I think this is basically a channel specifying hack for a + ;; preceding instrument name. If I'm wrong, I'll need to + ;; FIXME + (when texts + (setf (%midi-message-channel (car texts)) + (slot-value event 'midi::channel)))) + (t + (push (make-controller-moment event event-time track-no) + misc-controllers))))))) (when tempi (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi))))) + (when pitch-bends + (setf (duration (car pitch-bends)) (- (/ last-time division) (timepoint (car pitch-bends))))) (when time-sigs (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs))))) (when key-sigs @@ -143,7 +202,11 @@ (list (make-standard-time-signature-period 4 4 0 (/ last-time division)))) :tempi (sort tempi #'time<) - :key-signatures (sort key-sigs #'time<)))) + :key-signatures (sort key-sigs #'time<) + :pitch-bends (sort pitch-bends #'time<) + :texts (sort texts #'time<) + :lyrics (sort lyrics #'time<) + :controllers (sort misc-controllers #'time<)))) (sequence:adjust-sequence composition (length notes) :initial-contents (sort notes #'time<))))) @@ -173,3 +236,109 @@ :velocity (midi:message-velocity note-on) :patch patch :number (midi:message-key note-on))))) + + +(macrolet ((rpn (m-type) `(make-instance ,m-type :lsb value-lsb :msb value-msb + :time time :track track-no))) + (defun make-parameter-moment (value-lsb value-msb time track-no rpn-lsb rpn-msb nrpn-lsb nrpn-msb) + (cond + ((and nrpn-lsb nrpn-msb) + (make-instance 'non-registered-parameter-moment + :lsb value-lsb :msb value-msb + :nrpn-lsb nrpn-lsb :nrpn-msb nrpn-msb + :time time :track track-no)) + ((or (not rpn-lsb) (not rpn-msb) (= rpn-lsb 0)) + ;; default behaviour + (rpn 'pitch-bend-sensitivity-moment)) + ((= rpn-lsb 1) + (rpn 'channel-fine-tuning-moment)) + ((= rpn-lsb 2) + (rpn 'channel-course-tuning-moment)) + ((= rpn-lsb 3) + (rpn 'tuning-program-moment)) + ((= rpn-lsb 4) + (rpn 'tuning-bank-moment)) + ((= rpn-lsb 5) + (rpn 'modulation-depth-moment)) + (t + (make-instance 'unknown-registered-parameter-moment + :lsb value-lsb :msb value-msb + :reg-lsb rpn-lsb :reg-msb rpn-msb + :time time :track track-no))))) + +(defgeneric control-number (message) + (:method ((m midi::reset-all-controllers-message)) 121) + (:method ((m midi::local-control-message)) 122) + (:method ((m midi::all-notes-off-message)) 123) + (:method ((m midi::omni-mode-off-message)) 123) + (:method ((m midi::omni-mode-on-message)) 124) + (:method ((m midi::mono-mode-on-message)) 125) + (:method ((m midi::mono-mode-off-message)) 126) + (:method ((m midi::poly-mode-on-message)) 127)) + +(defgeneric control-value (message) + (:method ((m midi::reset-all-controllers-message)) 0) + (:method ((m midi::local-control-message)) + (slot-value m 'midi::mode)) + (:method ((m midi::all-notes-off-message)) 0) + (:method ((m midi::omni-mode-off-message)) 0) + (:method ((m midi::omni-mode-on-message)) 0) + (:method ((m midi::mono-mode-on-message)) + (slot-value m 'midi::nb-channels)) + (:method ((m midi::mono-mode-off-message)) 0) + (:method ((m midi::poly-mode-on-message)) 0)) + + +(defgeneric make-controller-moment (event track time)) +(defgeneric channel-messagep (event) + (:method ((e channel-message)) t) + (:method (e) nil)) +;; There's a lot in common between controller making instances, so +;; let's automate a bit +(macrolet ((controller-maker (midi-class amuse-class &rest slots-and-options) + `(defmethod make-controller-moment ((event ,midi-class) track time) + (if (channel-messagep event) + (make-instance ,amuse-class :time time + :track track :channel (midi::message-channel event) + ,@slots-and-options) + (make-instance ,amuse-class :time time + :track track ,@slots-and-options))))) + ;; Both of these are control change messages. The latter set are more + ;; specifically defined ones in the MIDI library (omni off, for + ;; example). We may want to separate these, but I see no reason to + ;; yet. We may also want to consider having more types made explicit + ;; in the library, but again, there's no obvious functionality gain. + (controller-maker midi::control-change-message 'control-change-moment + :value (slot-value event 'midi::value) + :control (slot-value event 'midi::controller)) + (controller-maker midi::mode-message 'control-change-moment + :value (control-value event) + :control (control-number event)) + ;; I think that MIDI.LISP treats sysexs as two very distinct +;; things. I'm not sure that's true, so I'm treating them as the same + ;; thing for now. + (controller-maker midi::system-exclusive-message 'system-exclusive-moment + :status 240 :value (slot-value event 'midi::data)) + (controller-maker midi::authorization-system-exclusive-message 'system-exclusive-moment + :status 247 :value (slot-value event 'midi::data)) + (controller-maker midi::polyphonic-key-pressure-message 'aftertouch-moment + :key (slot-value event 'midi::key) + :pressure (slot-value event 'midi::pressure)) + (controller-maker midi::channel-pressure-message 'channel-aftertouch-moment + :pressure (slot-value event 'midi::pressure)) + ;; This is a period, but we add duration later anyway + (controller-maker midi:pitch-bend-message 'pitch-bend-period :value (midi::message-value event)) + ;; Text messages + (controller-maker midi::lyric-message 'lyric-moment :text (slot-value event 'midi::text)) + (controller-maker midi::general-text-message 'text-moment :text (slot-value event 'midi::text)) + (controller-maker midi::copyright-message 'copyright-moment :text (slot-value event 'midi::text)) + (controller-maker midi::sequence/track-name-message 'sequence-or-track-moment :text (slot-value event 'midi::text)) + (controller-maker midi::instrument-message 'instrument-name-moment :text (slot-value event 'midi::text)) + (controller-maker midi::marker-message 'marker-moment :text (slot-value event 'midi::text)) + (controller-maker midi::cue-point-message 'cue-moment :text (slot-value event 'midi::text)) + (controller-maker midi::program-name-message 'program-name-moment :text (slot-value event 'midi::text)) + (controller-maker midi::device-name-message 'device-name-moment :text (slot-value event 'midi::text)) + + ;; Not used: + (controller-maker midi::program-change-message 'program-change-moment + :program (midi::message-program event)))