comparison methods.lisp @ 18:70e76c1c87b7

Bug fixes and exports in package.lisp

darcs-hash:20061213114049-f76cc-4c4175a1ad8b24e1c5df82c9fb67445ac32977d9.gz

 (defmethod timepoint ((moment-designator moment))
   (%moment-time moment-designator))
 
 (defmethod span ((pitch-interval-designator pitch-interval))
   (%pitch-interval-span pitch-interval-designator))
+
+(defmethod chromatic-pitch ((pitch-designator chromatic-pitch))
+  pitch-designator)
+
+(defmethod chromatic-pitch-number ((pitch-designator chromatic-pitch))
+  (%chromatic-pitch-number pitch-designator))
+
+(defmethod chromatic-pitch-number ((pitch-designator pitch))
+  (%chromatic-pitch-number (chromatic-pitch pitch-designator)))
 
 ;; Time protocol
 
 (defmethod time+ ((object1 moment) (object2 period))
   (make-moment (+ (timepoint object1) (duration object2))))

 
 (defmethod time+ ((object1 moment) (object2 moment))
   (error 'undefined-action :operation 'time+ :datatype (list (class-of object1) (class-of object2))))
 
 (defmethod time- ((object1 moment) (object2 moment))
-  (make-anchored-period object1
-			(- (duration object2)
-			   (duration object1))))
+  (make-anchored-period (timepoint object2)
+			(- (timepoint object1)
+			   (timepoint object2))))
 
 (defmethod time- ((object1 moment) (object2 period))
   (make-moment (- (timepoint object1) (duration object2))))
 
 (defmethod time- ((object1 period) (object2 moment)) ;?

 
 (defmethod time- ((object1 period) (object2 period))
   (make-floating-period (- (duration object2)
 			   (duration object1))))
 
+;; these ones are less certain. I've just put them in, but think I
+;; should remove them and force the user to specify what they mean
+;; when they give objects that are both moments *and* periods to these
+;; functions.
+
+(defmethod time- ((object1 anchored-period) (object2 anchored-period)) ;? 
+  (time- (moment object1) (moment object2)))
+
+(defmethod time- (object1 (object2 anchored-period)) ;?
+  (time- object1 (moment object2)))
+
+(defmethod time- ((object1 anchored-period) object2) ;?
+  (time- (moment object1) object2))
 
 (defmethod time> ((object1 moment) (object2 moment))
   (> (timepoint object1) (timepoint object2)))
 
 (defmethod time= ((object1 moment) (object2 moment))

 
 (defmethod duration= ((object1 period) (object2 period))
   (= (duration object1) (duration object2)))
 
 (defmethod duration* ((object1 period) (object2 number))
-  (* (duration object1) object2))
+  (make-floating-period (* (duration object1) object2)))
 
 (defmethod duration* ((object1 number) (object2 period))
   (duration* object2 object1))
 
 (defmethod duration/ ((object1 period) (object2 number))
-  (/ (duration object1) object2))
+  (make-floating-period (/ (duration object1) object2)))
 
 ;; Pitch protocol
 
 (defmethod pitch+ ((object1 pitch-designator)
 		   (object2 pitch-designator))