view implementations/viewpointable/viewpointable.lisp @ 193:c18f795f4463

rollback the amuse.asd generics/classes dependency fix

Ignore-this: be4e0351d31f24f5348cc8dc434477dc

Fix properly this time by moving the specialized get-constituents method from generics to methods.

rolling back:

Wed Jan 23 15:55:34 GMT 2008  Jamie Forth <[e-mail]>
  * Fixed amuse.asd dependency - generics depends on classes.

    M ./amuse.asd -2 +2

darcs-hash:20090524164116-16a00-2b561eab1a5829a251eb5e9b40357945af13e6a6.gz

(in-package #:amuse-viewpointing-implementation)

;; A set of classes and methods such that, if the amuse-form methods
;; are implemented, a viewpointable-composition can be made and have
;; viewpoint operations carried out without loss of context.

(defclass viewpointable-event (amuse::event)
  ((source-event :initarg :source-event
		 :accessor %viewpointable-event-source-event)
   (source-composition :initarg :source-composition
		       :accessor %viewpointable-event-source-composition)))

(defclass viewpointable-composition (monody) ())

(defmethod timepoint ((event viewpointable-event))
  (timepoint (%viewpointable-event-source-event event)))

(defmethod duration ((event viewpointable-event))
  (duration (%viewpointable-event-source-event event)))

(defmethod midi-pitch-number ((event viewpointable-event))
  (midi-pitch-number (%viewpointable-event-source-event event)))

(defmethod get-applicable-key-signatures ((event viewpointable-event) foo)
  (declare (ignore foo))
  (get-applicable-key-signatures (%viewpointable-event-source-event event)
				 (%viewpointable-event-source-composition event)))

(defmethod get-applicable-time-signatures ((event viewpointable-event) foo)
  (declare (ignore foo))
  (get-applicable-time-signatures (%viewpointable-event-source-event event)
				 (%viewpointable-event-source-composition event)))


(defmethod get-applicable-tempi ((event viewpointable-event) foo)
  (declare (ignore foo))
  (get-applicable-tempi (%viewpointable-event-source-event event)
			(%viewpointable-event-source-composition event)))

(defmethod crotchet ((event viewpointable-event))
  (crotchet (%viewpointable-event-source-event event)))

(defmethod diatonic-pitch ((event viewpointable-event))
  (diatonic-pitch (%viewpointable-event-source-event event)))

(defmethod amuse-segmentation:ground-truth-segmenter-after ((composition viewpointable-composition))
  (amuse-segmentation:ground-truth-segmenter-after composition))

(defmethod amuse-segmentation:ground-truth-segmenter-before ((composition viewpointable-composition))
  (amuse-segmentation:ground-truth-segmenter-before composition))

(defmethod amuse-segmentation:boundary-strength (segmenter (event viewpointable-event) (composition viewpointable-composition))
  (declare (ignore composition))
  (amuse-segmentation:boundary-strength segmenter
					(%viewpointable-event-source-event event)
					(%viewpointable-event-source-composition event)))

(defun make-viewpointable-composition (composition)
  (let ((new-comp (make-instance 'viewpointable-composition
				 :time (timepoint composition)
				 :interval (duration composition)))
	(event-list) (i 0))
    (sequence:dosequence (event composition)
      (push (make-instance 'viewpointable-event :source-event event
			   :source-composition composition)
	    event-list)
      (incf i))
    (sequence:adjust-sequence new-comp i :initial-contents (reverse event-list))
    new-comp))