view implementations/midi/methods.lisp @ 139:ebfe054eea1c

Bug fixes from name changes

darcs-hash:20070918114952-f76cc-feb59725a2f67edd6242947a5c2311d0a724cc43.gz

(cl:in-package #:amuse-midi)

(defgeneric midi-channel (midi-message)
  (:documentation "MIDI channel. Also used for midi output"))
(defmethod midi-channel ((midi-message midi-message))
  (%midi-message-channel midi-message))

(defgeneric midi-track (midi-message)
  (:documentation "MIDI track. Also used for midi output"))
(defmethod midi-track ((midi-message midi-message))
  (%midi-message-track midi-message))

(defgeneric midi-velocity (event)
  (:documentation "MIDI velocity. Also used for midi output"))
(defmethod midi-velocity ((event midi-pitched-event))
  (%midi-pitched-event-velocity event))
(defmethod midi-velocity ((event midi-percussive-event))
  (%midi-percussive-event-velocity event))

(defgeneric midi-patch (event)
  (:documentation "MIDI patch (instrumental sound). Also used for
  midi output"))
(defmethod midi-patch ((event midi-pitched-event))
  (%midi-pitched-event-patch event))

(defgeneric midi-drum-sound (event)
  (:documentation "MIDI pitch for unpitched events (usually, drum
  sound for drum kits on channel 10, but also for semi-pitched
  SFX, etc). Also used for midi output"))
(defmethod midi-drum-sound ((event midi-percussive-event))
  (%midi-percussive-event-sound event))

(defmethod time-signatures ((composition midi-composition))
  (%midi-time-signatures composition))
(defmethod (setf time-signatures) (sequence (composition midi-composition))
  (setf (%midi-time-signatures composition) sequence))
(defmethod tempi ((composition midi-composition))
  (%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,
;; rather than calling internals from the other package
(defmethod copy-event ((event midi-pitched-event))
  (with-slots (channel track (number amuse::number) (time amuse::time) (interval amuse::interval) velocity patch)
      event
    (make-instance 'midi-pitched-event
		   :channel channel
		   :track track
		   :number number
		   :time time
		   :interval interval
		   :velocity velocity
		   :patch patch)))
(defmethod copy-event ((event midi-percussive-event)) 
  (with-slots (channel track (time amuse::time) (interval amuse::interval) velocity patch sound)
      event
    (make-instance 'midi-percussive-event
		   :channel channel 
		   :track track
		   :time time
		   :interval interval
		   :velocity velocity
		   :patch patch
		   :sound sound)))


;; Allow derived sequences from remove-if, etc. to preserve other slot
;; info (timesigs, etc)
(defmethod sequence:make-sequence-like :around ((o midi-composition) length
						&key (initial-element nil iep)
						(initial-contents nil icp))
  (declare (ignore length initial-element initial-contents)) 
  (let ((result (call-next-method)))
    (cond
      ((or iep icp)
       (setf (timepoint result) (timepoint (elt result 0))
	     (duration result) (- (timepoint
				   (loop for e being the elements of result
				      maximize (cut-off e)))
				  (timepoint (elt result 0)))))
      (t (setf (timepoint result) 0
	       (duration result) 0)))
    (with-slots (time-signatures tempi misc-controllers)
	o
      (setf (%midi-time-signatures result) time-signatures
	    (%midi-tempi result) tempi
	    (%midi-misc-controllers result) misc-controllers))
    result))


;; useful little function

(defun microsecond-per-crotchet-to-bpm (mu-per-c)
  (/ 60000000 mu-per-c))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MIDI playback methods

(defmethod get-patch-for-midi ((event midi-pitched-event))
  ;; FIXME
  (midi-patch event))

(defmethod get-channel-for-midi ((event midi-message))
  ;; FIXME 1- ??? I'm only doing this because of the Geerdes
  ;; database. Looks like a recipe for disaster. Think should probably
  ;; enforce 0-15.
  (1- (midi-channel event)))

(defmethod get-velocity-for-midi ((event midi-message))
  ;; FIXME: under-exclusive specialisation. Does this matter?
  (midi-velocity event))

(defmethod get-pitch-for-midi ((event midi-percussive-event))
  (midi-drum-sound event))

(defmethod get-pitch-for-midi ((event midi-pitched-event))
  (midi-pitch-number event))

;; Have avoided percussion vs pitched, as this is more obviously
;; meaningless.
(defmethod significantly-louderp ((event1 midi-pitched-event) (event2 midi-pitched-event))
  (>= (/ (midi-velocity event1)
	 (midi-velocity event2))
      4/3))
(defmethod significantly-louderp ((event1 midi-percussive-event) (event2 midi-percussive-event))
  (>= (/ (midi-velocity event1)
	 (midi-velocity event2))
      4/3))
(defmethod substantially-louderp ((event1 midi-pitched-event) (event2 midi-pitched-event))
  (>= (/ (midi-velocity event1)
	 (midi-velocity event2))
      2))
(defmethod substantially-louderp ((event1 midi-percussive-event) (event2 midi-percussive-event))
  (>= (/ (midi-velocity event1)
	 (midi-velocity event2))
      2))

(defmethod crotchet ((object midi-object))
  (make-standard-period 1))