d@34: (cl:in-package #:amuse-midi)
d@34: 
d@34: (defgeneric midi-channel (midi-message))
d@34: (defmethod midi-channel ((midi-message midi-message))
d@34:   (%midi-message-channel midi-message))
d@34: 
d@34: (defgeneric midi-track (midi-message))
d@34: (defmethod midi-track ((midi-message midi-message))
d@34:   (%midi-message-track midi-message))
d@34: 
d@34: (defgeneric midi-velocity (event))
d@34: (defmethod midi-velocity ((event midi-pitched-event))
d@34:   (%midi-pitched-event-velocity event))
d@34: (defmethod midi-velocity ((event midi-percussive-event))
d@34:   (%midi-percussive-event-velocity event))
d@34: 
d@34: (defgeneric midi-patch (event))
d@34: (defmethod midi-patch ((event midi-pitched-event))
d@34:   (%midi-pitched-event-patch event))
d@34: 
d@34: (defgeneric midi-drum-sound (event))
d@34: (defmethod midi-drum-sound ((event midi-percussive-event))
d@34:   (%midi-percussive-event-sound event))
d@34: 
d@34: (defmethod time-signatures ((composition midi-composition))
d@34:   (%midi-time-signatures composition))
d@34: (defmethod (setf time-signatures) (sequence (composition midi-composition))
d@34:   (setf (%midi-time-signatures composition) sequence))
d@34: (defmethod tempi ((composition midi-composition))
d@34:   (%midi-tempi composition))
d@34: (defmethod (setf tempi) (sequence (composition midi-composition))
d@34:   (setf (%midi-tempi composition) sequence))
d@34: 
d@34: (defgeneric copy-event (event))
d@34: ;; FIXME: This ought to call-next-method and operate on the result,
d@34: ;; rather than calling internals from the other package
d@34: (defmethod copy-event ((event midi-pitched-event))
d@34:   (with-slots (channel track (number amuse::number) (time amuse::time) (interval amuse::interval) velocity patch)
d@34:       event
d@34:     (make-instance 'midi-pitched-event
d@34: 		   :channel channel
d@34: 		   :track track
d@34: 		   :number number
d@34: 		   :time time
d@34: 		   :interval interval
d@34: 		   :velocity velocity
d@34: 		   :patch patch)))
d@34: (defmethod copy-event ((event midi-percussive-event)) 
d@34:   (with-slots (channel track (time amuse::time) (interval amuse::interval) velocity patch sound)
d@34:       event
d@34:     (make-instance 'midi-percussive-event
d@34: 		   :channel channel 
d@34: 		   :track track
d@34: 		   :time time
d@34: 		   :interval interval
d@34: 		   :velocity velocity
d@34: 		   :patch patch
d@34: 		   :sound sound)))
d@34: 
d@34: 
d@34: ;; Allow derived sequences from remove-if, etc. to preserve other slot
d@34: ;; info (timesigs, etc)
d@34: (defmethod sequence:make-sequence-like :around ((o midi-composition) length
d@34: 						&key (initial-element nil iep)
d@34: 						(initial-contents nil icp))
d@34:   (declare (ignore length initial-element initial-contents)) 
d@34:   (let ((result (call-next-method)))
d@34:     (cond
d@34:       ((or iep icp)
d@34:        (setf (timepoint result) (timepoint (elt result 0))
d@34: 	     (duration result) (- (timepoint
d@34: 				   (loop for e being the elements of result
d@34: 				      maximize (cut-off e)))
d@34: 				  (timepoint (elt result 0)))))
d@34:       (t (setf (timepoint result) 0
d@34: 	       (duration result) 0)))
d@34:     (with-slots (time-signatures tempi misc-controllers)
d@34: 	o
d@34:       (setf (%midi-time-signatures result) time-signatures
d@34: 	    (%midi-tempi result) tempi
d@34: 	    (%midi-misc-controllers result) misc-controllers))
d@34:     result))
d@34: 
d@34: 
d@34: ;; useful little function
d@34: 
d@34: (defun microsecond-per-crotchet-to-bpm (mu-per-c)
d@34:   (/ 60000000 mu-per-c))
d@34: 
d@34: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
d@34: ;;
d@34: ;; MIDI playback methods
d@34: 
d@34: (defmethod get-patch-for-midi ((event midi-pitched-event))
d@34:   ;; FIXME
d@34:   (midi-patch event))
d@34: 
d@34: (defmethod get-channel-for-midi ((event midi-message))
d@34:   ;; FIXME 1- ??? I'm only doing this because of the Geerdes
d@34:   ;; database. Looks like a recipe for disaster. Think should probably
d@34:   ;; enforce 0-15.
d@34:   (1- (midi-channel event)))
d@34: 
d@34: (defmethod get-velocity-for-midi ((event midi-message))
d@34:   ;; FIXME: under-exclusive specialisation. Does this matter?
d@34:   (midi-velocity event))
d@34: 
d@34: (defmethod get-pitch-for-midi ((event midi-percussive-event))
d@34:   (midi-drum-sound event))
d@34: 
d@34: (defmethod get-pitch-for-midi ((event midi-pitched-event))
d@34:   (midi-pitch-number event))