annotate methods.lisp @ 16:5fac84ca066a

Add methods.lisp, change names for time (->timepoint) and end (cut-off)

darcs-hash:20061212123452-f76cc-aff1150ac28333922f4d9746094f987c5746facb.gz

(cl:in-package #:amuse) 

(defmethod duration ((period-designator period))
  (%period-interval period-designator))

(defmethod timepoint ((moment-designator moment))
  (%moment-time moment-designator))

;; Time protocol

(defmethod time+ ((object1 moment) (object2 period))
  (make-moment (+ (timepoint object1) (duration object2))))

(defmethod time+ ((object1 period) (object2 moment)) ;?
  (time+ object2 object1))

(defmethod time+ ((object1 period) (object2 period))
  (make-floating-period (+ (duration object1)
			   (duration object2))))

(defmethod time+ ((object1 moment) (object2 moment))
  (error 'undefined-action :operation 'time+ :datatype (list 'moment 'moment)))

(defmethod time- ((object1 moment) (object2 moment))
  (make-anchored-period object1
			(- (duration object2)
			   (duration object1))))

(defmethod time- ((object1 moment) (object2 period))
  (make-moment (- (timepoint object1) (duration object2))))

(defmethod time- ((object1 period) (object2 moment)) ;?
  (error 'undefined-action
	 :operation 'time-
	 :datatype (list 'period 'moment)))

(defmethod time- ((object1 period) (object2 period))
  (make-floating-period (- (duration object2)
			   (duration object1))))


(defmethod time> ((object1 moment) (object2 moment))
  (> (timepoint object1) (timepoint object2)))

(defmethod time= ((object1 moment) (object2 moment))
  (= (timepoint object1) (timepoint object2)))

(defmethod duration> ((object1 period) (object2 period))
  (> (duration object1) (duration object2)))

(defmethod duration= ((object1 period) (object2 period))
  (= (duration object1) (duration object2)))

(defmethod duration* ((object1 period) (object2 number))
  (* (duration object1) object2))

(defmethod duration* ((object1 number) (object2 period))
  (duration* object2 object1))

(defmethod duration/ ((object1 period) (object2 number))
  (/ (duration object1) object2))

;; Pitch protocol

; How do we do this?

;; Allen

(defmethod meets ((object1 anchored-period)
		  (object2 anchored-period))
  (or (time= (cut-off object1) (onset object2))
      (time= (cut-off object2) (onset object1))))

(defmethod before ((object1 anchored-period)
		   (object2 anchored-period))
  (time< (cut-off object1) (onset object2)))

(defmethod overlaps ((object1 anchored-period)
		     (object2 anchored-period))
  (or (and (time> (cut-off object1) (onset object2))
	   (time< (onset object1) (onset object2)))
      (and (time> (cut-off object1) (cut-off object2))
	   (time< (onset object1) (cut-off object2)))))

(defmethod during ((object1 anchored-period)
		   (object2 anchored-period))
  (and (time> (onset object1) (onset object2))
       (time< (cut-off object2) (cut-off object2))))

(defmethod starts ((object1 anchored-period)
		   (object2 anchored-period))
  (time= (onset object1) (onset object2)))

(defmethod ends ((object1 anchored-period)
		 (object2 anchored-period))
  (time= (cut-off object1) (cut-off object2)))

;; ...and

(defmethod period-intersection ((object1 anchored-period)
				(object2 anchored-period))
  (cond
    ((disjoint object1 object2)
     ;; if they don't overlap, return nil, not a negative-valued
     ;; period
     nil)
    (t
     (let ((new-onset (max (onset object1)
			   (onset object2))))
       (make-anchored-period new-onset
			     (time- (min (cut-off object1)
					 (cut-off object2))
				    new-onset))))))