view implementations/viewpointable/viewpointable.lisp @ 217:d8f650e3796e

Rationalise base and geerdes classes, constructors and methods.

Ignore-this: d9d4d88566a6d110844d91d4c70513cd

Towards a more standardised interface. Some of these changes (generalised
constructors and reader functions) are necessary for amuse-database-admin
functionality and some other CHARM-like things.

darcs-hash:20090716154406-16a00-8a9b4fb1fc1f5ba75af66a1bbd87e1bb68e02493.gz

committer: Jamie Forth <[e-mail]>

(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) ())

(defclass standard-viewpointable-composition (standard-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-standard-viewpointable-composition (composition)
  (let ((new-comp (make-instance 'standard-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))