changeset 20:6eb54ad3b8b4

Bug fixes mostly, but also re-aliasing onset to moment rather than timepoint

darcs-hash:20061213162757-f76cc-39094b0c337efac30d8a957a9087436146ea2e82.gz

--- a/generics.lisp	Wed Dec 13 15:53:34 2006 +0000
+++ b/generics.lisp	Wed Dec 13 16:27:57 2006 +0000
@@ -27,9 +27,6 @@
 (defgeneric (setf duration) (value period-designator))
 (defgeneric timepoint (moment-designator))
 (defgeneric (setf timepoint) (value moment-designator))
-(defgeneric onset (anchored-period-designator)
-  (:method (apd) (timepoint apd)))
-(defgeneric (setf onset) (value anchored-period-designator))
 (defgeneric cut-off (anchored-period-designator) ; name?
   (:method (apd) (time+ (moment apd) (floating-period apd))))
 
@@ -70,6 +67,10 @@
 (defgeneric moment (moment-designator)
   (:method (md) (make-moment (timepoint md))))
 
+(defgeneric onset (anchored-period-designator)
+  (:method (apd) (momend apd)))
+(defgeneric (setf onset) (value anchored-period-designator))
+
 ;;; Time Protocol (or moments?)
 
 ;; negative times/durations -> ERROR? 

--- a/methods.lisp	Wed Dec 13 15:53:34 2006 +0000
+++ b/methods.lisp	Wed Dec 13 16:27:57 2006 +0000
@@ -165,28 +165,31 @@
 
 (defmethod meets ((object1 anchored-period)
 		  (object2 anchored-period))
-  (or (time= (cut-off object1) (onset object2))
-      (time= (cut-off object2) (onset object1))))
+  (or (time= (cut-off object1) object2)
+      (time= (cut-off object2) object1)))
 
 (defmethod before ((object1 anchored-period)
 		   (object2 anchored-period))
-  (time< (cut-off object1) (onset object2)))
+  (time> object2 (cut-off object1)))
 
 (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)))))
+  ;; FIXME: Is there a tidier method?
+  (or (and (time> object2 object1) ; object1 starts before object2
+	   (time> (cut-off object1) object2) ; object1 ends after object2 starts
+	   (time> (cut-off object2) (cut-off object1))) ; object1 ends before object2 does
+      (and (time> object1 object2) ; object1 starts after object2
+	   (time> (cut-off object2) object1) ; object1 starts before object2 ends
+	   (time> (cut-off object1) (cut-off object2))))) ; object1 ends after object2 does
 
 (defmethod during ((object1 anchored-period)
 		   (object2 anchored-period))
-  (and (time> (onset object1) (onset object2))
+  (and (time> object1 object2)
        (time< (cut-off object2) (cut-off object2))))
 
 (defmethod starts ((object1 anchored-period)
 		   (object2 anchored-period))
-  (time= (onset object1) (onset object2)))
+  (time= object1 object2))
 
 (defmethod ends ((object1 anchored-period)
 		 (object2 anchored-period))
@@ -202,8 +205,8 @@
      ;; period
      nil)
     (t
-     (let ((new-onset (max (onset object1)
-			   (onset object2))))
+     (let ((new-onset (max (timepoint object1)
+			   (timepoint object2))))
        (make-anchored-period new-onset
 			     (time- (min (cut-off object1)
 					 (cut-off object2))