view implementations/viewpointable/viewpointable.lisp @ 136:fd85f52d9f9d

Class revolution

* PITCH-DESIGNATOR -> PITCH (PITCH removed)
* MOMENT-DESIGNATOR -> MOMENT , MOMENT -> STANDARD-MOMENT
* PERIOD-DESIGNATOR -> PERIOD , PERIOD -> STANDARD-PERIOD
* ANCHORED-PERIOD-DESIGNATOR -> ANCHORED-PERIOD , ANCHORED-PERIOD -> STANDARD-ANCHORED-PERIOD
* FLOATING-PERIOD removed
* TIME-SIGNATURE-DESIGNATOR -> TIME-SIGNATURE & TIME-SIGNATURE-PERIOD
* TIME-SIGNATURE -> STANDARD-TIME-SIGNATURE & STANDARD-TIME-SIGNATURE-PERIOD
* KEY-SIGNATURE-DESIGNATOR -> KEY-SIGNATURE (& ...-PERIOD)
* KEY-SIGNATURE -> STANDARD-KEY-SIGNATURE (& ...-PERIOD)
* TEMPO now abstract (& TEMPO-PERIOD)
* STANDARD-TEMPO AND STANDARD-TEMPO-PERIOD
* COMPOSITION, CONSTITUENT & TIME-ORDERED-CONSTITUENT all have STANDARD- forms

make-x methods and specialisers changes appropriately

darcs-hash:20070831142943-f76cc-7be0d08963de06d87b36e4922076287d565c7ee2.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))