Mercurial > hg > amuse
changeset 115:cf198383852d
Re-instated get-applicable-x for midi-related implementations and added key-sigs to midi
darcs-hash:20070726144704-f76cc-a24c9e6c07b43c4084a73218f76a0b345fac5369.gz
| author | David Lewis <d.lewis@gold.ac.uk> |
|---|---|
| date | Thu, 26 Jul 2007 15:47:04 +0100 |
| parents | 956f4c6f8571 |
| children | b4f4df48337d |
| files | implementations/geerdes/methods.lisp implementations/midi/classes.lisp implementations/midi/methods.lisp implementations/midi/midifile-import.lisp |
| diffstat | 4 files changed, 44 insertions(+), 3 deletions(-) [+] |
line wrap: on
line diff
--- a/implementations/geerdes/methods.lisp Thu Jul 26 12:41:09 2007 +0100 +++ b/implementations/geerdes/methods.lisp Thu Jul 26 15:47:04 2007 +0100 @@ -146,4 +146,20 @@ (= (midi-channel event) 4)) (defmethod crotchet ((identifier geerdes-identifier)) - (make-instance 'floating-period :interval 1)) \ No newline at end of file + (make-instance 'floating-period :interval 1)) + +(defmethod get-applicable-time-signatures ((anchored-period anchored-period) (composition midi-composition)) + (%find-overlapping anchored-period (time-signatures composition))) +(defmethod get-applicable-tempi ((anchored-period anchored-period) (composition midi-composition)) + (%find-overlapping anchored-period (tempi composition))) +(defmethod get-applicable-key-signatures ((anchored-period anchored-period) (composition midi-composition)) + (%find-overlapping anchored-period (key-signatures composition))) + +(defun %find-overlapping (period1 period-list) + (let ((result-list)) + (dolist (period2 period-list result-list) + (cond + ((before period1 period2) + (return-from %find-overlapping (reverse result-list))) + ((not (before period2 period1)) + (push period2 result-list)))))) \ No newline at end of file
--- a/implementations/midi/classes.lisp Thu Jul 26 12:41:09 2007 +0100 +++ b/implementations/midi/classes.lisp Thu Jul 26 15:47:04 2007 +0100 @@ -7,6 +7,9 @@ (tempi :initarg :tempi :initform 'nil :accessor %midi-tempi) + (key-signatures :initarg :key-signatures + :initform 'nil + :accessor %midi-key-signatures) (misc-controllers :initarg :controllers :initform 'nil :accessor %midi-misc-controllers)))
--- a/implementations/midi/methods.lisp Thu Jul 26 12:41:09 2007 +0100 +++ b/implementations/midi/methods.lisp Thu Jul 26 15:47:04 2007 +0100 @@ -30,6 +30,10 @@ (%midi-tempi composition)) (defmethod (setf tempi) (sequence (composition midi-composition)) (setf (%midi-tempi composition) sequence)) +(defmethod key-signatures ((composition midi-composition)) + (%midi-key-signatures composition)) +(defmethod (setf key-signatures) (sequence (composition midi-composition)) + (setf (%midi-key-signatures composition) sequence)) (defgeneric copy-event (event)) ;; FIXME: This ought to call-next-method and operate on the result,
--- a/implementations/midi/midifile-import.lisp Thu Jul 26 12:41:09 2007 +0100 +++ b/implementations/midi/midifile-import.lisp Thu Jul 26 15:47:04 2007 +0100 @@ -19,7 +19,8 @@ ;; FIXME: assumes controllers are global in scope and location (let ((tracks (midi:midifile-tracks midifile)) (division (midi:midifile-division midifile)) - (notes) (time-sigs) (tempi) (misses 0) (track-no -1) (last-time 0)) + (notes) (time-sigs) (key-sigs) (tempi) (misses 0) + (track-no -1) (last-time 0)) (dolist (track tracks) (incf track-no) (setf track (sort (copy-seq track) @@ -79,6 +80,20 @@ :numerator (midi:message-numerator event) :denominator (expt 2 (midi:message-denominator event))) time-sigs)) + ((typep event 'midi:key-signature-message) + ;; FIXME: Should I make a midi version of this object, + ;; with track/channel? [probably, yes] + (when key-sigs + (setf (duration (car time-sigs)) + (- (/ (midi:message-time event) + division) + (timepoint (car time-sigs))))) + (push (make-instance 'midi-key-signature + :time (/ (midi:message-time event) + division) + :sharp-count (message-sf event) + :mode (message-mi event)) + key-sigs)) ((typep event 'midi:tempo-message) (when tempi (setf (duration (car tempi)) @@ -98,6 +113,8 @@ (setf (duration (car tempi)) (- (/ last-time division) (timepoint (car tempi))))) (when time-sigs (setf (duration (car time-sigs)) (- (/ last-time division) (timepoint (car time-sigs))))) + (when key-sigs + (setf (duration (car key-sigs)) (- (/ last-time division) (timepoint (car key-sigs))))) ;; make a midi object from notes, etc. (let ((composition (make-instance 'midi-composition :time 0 @@ -109,7 +126,8 @@ :interval (/ last-time division) :numerator 4 :denominator 4))) - :tempi (sort tempi #'time<)))) + :tempi (sort tempi #'time<) + :key-signatures (sort key-signatures #'time<)))) (sequence:adjust-sequence composition (length notes) :initial-contents (sort notes #'time<)))))