changeset 16:5fac84ca066a

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

darcs-hash:20061212123452-f76cc-aff1150ac28333922f4d9746094f987c5746facb.gz

--- a/generics.lisp	Mon Dec 11 13:48:54 2006 +0000
+++ b/generics.lisp	Tue Dec 12 12:34:52 2006 +0000
@@ -14,12 +14,12 @@
 
 (defgeneric duration (period-designator))
 (defgeneric (setf duration) (value period-designator))
-(defgeneric time (moment-designator))
-(defgeneric (setf time) (value moment-designator))
+(defgeneric timepoint (moment-designator))
+(defgeneric (setf timepoint) (value moment-designator))
 (defgeneric onset (anchored-period-designator)
-  (:method (apd) (time apd)))
+  (:method (apd) (timepoint apd)))
 (defgeneric (setf onset) (value anchored-period-designator))
-(defgeneric end (anchored-period-designator); change name
+(defgeneric cut-off (anchored-period-designator) ; name?
   (:method (apd) (time+ (onset apd) (duration apd))))
 
 ;;; Coerce-type accessors
@@ -35,7 +35,7 @@
   (:method (pd) (make-floating-period (duration pd))))
 
 (defgeneric moment (moment-designator)
-  (:method (md) (make-moment (time md))))
+  (:method (md) (make-moment (timepoint md))))
 
 ;;; Time Protocol (or moments?)
 

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/methods.lisp	Tue Dec 12 12:34:52 2006 +0000
@@ -0,0 +1,116 @@
+(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))))))
+
+
+      
\ No newline at end of file