Index: coordinates.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/coordinates.lisp,v
retrieving revision 1.6
diff -u -r1.6 coordinates.lisp
--- coordinates.lisp	31 May 2003 18:18:43 -0000	1.6
+++ coordinates.lisp	3 Jan 2005 16:21:32 -0000
@@ -25,52 +25,27 @@
 
 (in-package :clim-internals)
 
-#||
 (deftype coordinate () 'double-float)
 
 (defun coordinate (n)
   "Coerces N to be a coordinate."
   (declare (type number n))
-  (coerce n 'coordinate))
+  (typecase n
+    (coordinate n)
+    (t (coerce n 'coordinate))))
 
 (defun coordinate-epsilon ()
   ;; tweak if you like
   (* #.(expt 2 10) double-float-epsilon))
 
 (defun coordinate= (x y)
+  (declare (type coordinate x y))
   (< (abs (- x y)) (coordinate-epsilon)))
 
 (defun coordinate<= (x y)
+  (declare (type coordinate x y))
   (<= (- x y) (coordinate-epsilon)))
 
 (defun coordinate/= (x y)
+  (declare (type coordinate x y))
   (not (coordinate= x y)))
-||#
-
-(deftype coordinate () 'real)
-
-(declaim (inline coordinate))
-(defun coordinate (n) n)
-
-(declaim (inline coordinate-epsilon))
-(defun coordinate-epsilon ()
-  0)
-
-(declaim (inline coordinate=))
-(defun coordinate= (x y)
-  (= x y))
-
-(declaim (inline coordinate<=))
-(defun coordinate<= (x y)
-  (<= x y))
-
-(declaim (inline coordinate/=))
-(defun coordinate/= (x y)
-  (/= x y))
-
-;; $Log: coordinates.lisp,v $
-;; Revision 1.6  2003/05/31 18:18:43  gilbert
-;; Took the easy route: I switched COORDINATE to being just REAL in an
-;; attempt to keep McCLIM running using the latest CMUCL. This is however
-;; a questionable thing as it hides the real type errors.
-;;
Index: incremental-redisplay.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/incremental-redisplay.lisp,v
retrieving revision 1.40
diff -u -r1.40 incremental-redisplay.lisp
--- incremental-redisplay.lisp	24 Oct 2004 15:47:02 -0000	1.40
+++ incremental-redisplay.lisp	3 Jan 2005 16:21:32 -0000
@@ -292,9 +292,11 @@
 				       &key (cursor-x 0 x-supplied-p)
 				       (cursor-y 0 y-supplied-p))
   (and (or (not x-supplied-p)
-	   (coordinate= (slot-value state 'cursor-x) cursor-x))
+	   (coordinate= (coordinate (slot-value state 'cursor-x))
+                        (coordinate cursor-x)))
        (or (not y-supplied-p)
-	   (coordinate= (slot-value state 'cursor-y) cursor-y))))
+	   (coordinate= (coordinate (slot-value state 'cursor-y))
+                        (coordinate cursor-y)))))
 
 (defmethod set-medium-graphics-state :after
     ((state updating-stream-state) (stream updating-output-stream-mixin))
Index: recording.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/recording.lisp,v
retrieving revision 1.115
diff -u -r1.115 recording.lisp
--- recording.lisp	14 Oct 2004 06:30:11 -0000	1.115
+++ recording.lisp	3 Jan 2005 16:21:33 -0000
@@ -442,10 +442,10 @@
                                        &key (x-position 0.0d0) (y-position 0.0d0))
   (declare (ignore args))
   (with-slots (x1 y1 x2 y2) record
-    (setq x1 x-position
-	  y1 y-position
-	  x2 x-position
-	  y2 y-position)))
+    (setq x1 (coordinate x-position)
+	  y1 (coordinate y-position)
+	  x2 (coordinate x-position)
+	  y2 (coordinate y-position))))
 
 (defclass compound-output-record (basic-output-record)
   ((x :initarg :x-position
@@ -460,14 +460,16 @@
 
 ;;; 16.2.1. The Basic Output Record Protocol
 (defmethod output-record-position ((record basic-output-record))
-  (bounding-rectangle-position record))
+  (multiple-value-bind (x1 y1)
+      (bounding-rectangle-position record)
+    (values (rational x1) (rational y1))))
 
 (defmethod* (setf output-record-position) (nx ny (record basic-output-record))
   (with-slots (x1 y1 x2 y2) record
     (let ((dx (- nx x1))
           (dy (- ny y1)))
-      (setf x1 nx  y1 ny
-            x2 (+ x2 dx)  y2 (+ y2 dy))))
+      (setf x1 (coordinate nx) y1 (coordinate ny)
+            x2 (coordinate (+ x2 dx))  y2 (coordinate (+ y2 dy)))))
   (values nx ny))
 
 (defmethod* (setf output-record-position) :around
@@ -768,10 +770,10 @@
 
 (defmethod %tree-recompute-extent* ((record compound-output-record))
   ;; Internal helper function
-  (let ((new-x1 0)
-	(new-y1 0)
-	(new-x2 0)
-	(new-y2 0)
+  (let ((new-x1 (coordinate 0))
+	(new-y1 (coordinate 0))
+	(new-x2 (coordinate 0))
+	(new-y2 (coordinate 0))
 	(first-time t))
     (map-over-output-records
      (lambda (child)
@@ -788,7 +790,9 @@
      record)
     (if first-time
 	(with-slots (x y) record
-	  (values x y x y))
+          ;; FIXME
+	  (values (coordinate x) (coordinate y)
+                  (coordinate x) (coordinate y)))
 	(values new-x1 new-y1 new-x2 new-y2))))
 
 (defgeneric tree-recompute-extent-aux (record))
@@ -797,10 +801,10 @@
   (bounding-rectangle* record))
 
 (defmethod tree-recompute-extent-aux ((record compound-output-record))
-  (let ((new-x1 0)
-	(new-y1 0)
-	(new-x2 0)
-	(new-y2 0)
+  (let ((new-x1 (coordinate 0))
+	(new-y1 (coordinate 0))
+	(new-x2 (coordinate 0))
+	(new-y2 (coordinate 0))
 	(first-time t))
     (map-over-output-records
      (lambda (child)
@@ -1170,10 +1174,10 @@
       (minf min-y y)
       (maxf max-x x)
       (maxf max-y y))
-    (values (floor (- min-x border))
-            (floor (- min-y border))
-            (ceiling (+ max-x border))
-            (ceiling (+ max-y border)))))
+    (values (coordinate (floor (- min-x border)))
+            (coordinate (floor (- min-y border)))
+            (coordinate (ceiling (+ max-x border)))
+            (coordinate (ceiling (+ max-y border))))))
 
 ;;; x1, y1 slots must exist in class...
 
@@ -1466,7 +1470,8 @@
 		   (minf min-y (- y border))
 		   (maxf max-x (+ x border))
 		   (maxf max-y (+ y border)))))
-	     (values min-x min-y max-x max-y)))))
+	     (values (coordinate min-x) (coordinate min-y)
+                     (coordinate max-x) (coordinate max-y))))))
 
 (def-grecording draw-polygon ((coord-seq-mixin gs-line-style-mixin)
 			      coord-seq closed filled) ()
@@ -1589,7 +1594,8 @@
         (height (pattern-height pattern))
 	(transform (medium-transformation medium)))
     (setf (values x y) (transform-position transform x y))
-    (values x y (+ x width) (+ y height))))
+    (values (coordinate x) (coordinate y)
+            (coordinate (+ x width)) (coordinate (+ y height)))))
 
 (defmethod* (setf output-record-position) :around (nx ny (record draw-pattern-output-record))
   (with-slots (x1 y1 x y)
@@ -1688,7 +1694,7 @@
 ;;; 16.3.3. Text Displayed Output Record
 
 (defclass styled-string (gs-text-style-mixin gs-clip-mixin gs-ink-mixin)
-  ((start-x :initarg :start-x)
+  ((start-x :initarg :start-x :type coordinate)
    (string :initarg :string :reader styled-string-string)))
 
 (defmethod output-record-equal and ((record styled-string)
@@ -1700,16 +1706,16 @@
 
 (defclass standard-text-displayed-output-record
     (text-displayed-output-record standard-displayed-output-record)
-  ((initial-x1 :initarg :start-x)
-   (initial-y1 :initarg :start-y)
+  ((initial-x1 :initarg :start-x :type coordinate)
+   (initial-y1 :initarg :start-y :type coordinate)
    (strings :initform nil)
    (baseline :initform 0)
    (width :initform 0)
    (max-height :initform 0)
-   (start-x :initarg :start-x)
-   (start-y :initarg :start-y)
-   (end-x :initarg :start-x)
-   (end-y :initarg :start-y)
+   (start-x :initarg :start-x :type coordinate)
+   (start-y :initarg :start-y :type coordinate)
+   (end-x :initarg :start-x :type coordinate)
+   (end-y :initarg :start-y :type coordinate)
    (wrapped :initform nil
 	    :accessor text-record-wrapped)
    (medium :initarg :medium :initform nil)))
@@ -1736,8 +1742,8 @@
 	 (coordinate= (slot-value record 'end-x) end-x)
 	 (coordinate= (slot-value record 'end-y) end-y)
 	 (eq (slot-value record 'wrapped) wrapped)
-	 (coordinate= (slot-value record 'baseline)
-		      (slot-value record2 'baseline))
+         ;; FIXME: coordinate or not?
+	 (= (slot-value record 'baseline) (slot-value record2 'baseline))
 	 (eql (length (slot-value record 'strings)) (length strings));XXX
 	 (loop for s1 in (slot-value record 'strings)
 	       for s2 in strings
@@ -1964,8 +1970,10 @@
     (unless (and record (typep record 'standard-text-displayed-output-record))
       (multiple-value-bind (cx cy) (stream-cursor-position stream)
         (setf record (make-instance 'standard-text-displayed-output-record
-                                    :x-position cx :y-position cy
-                                    :start-x cx :start-y cy
+                                    :x-position (coordinate cx)
+                                    :y-position (coordinate cy)
+                                    :start-x (coordinate cx)
+                                    :start-y (coordinate cy)
 				    :stream stream)
               (stream-current-text-output-record stream) record)))
     record))
Index: sheets.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/sheets.lisp,v
retrieving revision 1.47
diff -u -r1.47 sheets.lisp
--- sheets.lisp	5 Dec 2004 19:37:52 -0000	1.47
+++ sheets.lisp	3 Jan 2005 16:21:33 -0000
@@ -950,9 +950,9 @@
                                              my2
                                              (floor (+ ph (min my2 (+ #x8000 y1) #x8000)) 2))))
                                 (when (and (< (- x2 x1) #x8000)
-                                           (or (<= (max (- pw #x8000) mx1) x1 0) (coordinate= x1 mx1))
+                                           (or (<= (max (- pw #x8000) mx1) x1 0) (coordinate= (coordinate x1) mx1))
                                            (< (- y2 y1) #x8000)
-                                           (or (<= (max (- pw #x8000) my1) y1 0) (coordinate= y1 my1))
+                                           (or (<= (max (- pw #x8000) my1) y1 0) (coordinate= (coordinate y1) my1))
                                            (> (round (- x2 x1)) 0)
                                            (> (round (- y2 y1)) 0))
                                   (values t (make-rectangle* 0 0 (round (- x2 x1)) (round (- y2 y1)))))))))
Index: transforms.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/transforms.lisp,v
retrieving revision 1.28
diff -u -r1.28 transforms.lisp
--- transforms.lisp	6 Oct 2004 12:03:56 -0000	1.28
+++ transforms.lisp	3 Jan 2005 16:21:34 -0000
@@ -147,12 +147,12 @@
     (let ((s (coerce (sin angle) 'coordinate))
           (c (coerce (cos angle) 'coordinate)))
       ;; This clamping should be done more sensible -- And: is this actually a good thing?
-      (when (coordinate= s 0) (setq s 0))
-      (when (coordinate= c 0) (setq c 0))
-      (when (coordinate= s 1) (setq s 1))
-      (when (coordinate= c 1) (setq c 1))
-      (when (coordinate= s -1) (setq s -1))
-      (when (coordinate= c -1) (setq c -1))
+      (when (coordinate= s (coordinate 0)) (setq s (coordinate 0)))
+      (when (coordinate= c (coordinate 0)) (setq c (coordinate 0)))
+      (when (coordinate= s (coordinate 1)) (setq s (coordinate 1)))
+      (when (coordinate= c (coordinate 1)) (setq c (coordinate 1)))
+      (when (coordinate= s (coordinate -1)) (setq s (coordinate -1)))
+      (when (coordinate= c (coordinate -1)) (setq c (coordinate -1)))
       ;; Wir stellen uns hier mal ganz dumm:
       (make-3-point-transformation* origin-x origin-y  (+ origin-x 1) origin-y        origin-x (+ origin-y 1)
                                     origin-x origin-y  (+ origin-x c) (+ origin-y s)  (- origin-x s) (+ origin-y c)) )))
@@ -201,7 +201,7 @@
   ;; These matrices are small enough to simply calculate A^-1 = |A|^-1 (adj A).
   ;; 
   (let ((det (+ (* x1 y2) (* y1 x3) (* x2 y3) (- (* y2 x3)) (- (* y1 x2)) (- (* x1 y3)))))
-    (if (coordinate/= 0 det)
+    (if (coordinate/= (coordinate 0) (coordinate det))
         (let* ((/det (/ det))
                ;; a thru' i is (adj A) 
                (a (- y2 y3))                (b (- y3 y1))               (c (- y1 y2))               
@@ -299,16 +299,16 @@
     (- (* mxx myy) (* mxy myx))))
 
 (defmethod invertible-transformation-p ((transformation standard-transformation))
-  (coordinate/= 0 (transformation-determinant transformation)))
+  (coordinate/= (coordinate 0) (transformation-determinant transformation)))
 
 (defmethod reflection-transformation-p ((transformation standard-transformation))
   (< (transformation-determinant transformation) 0))
 
 (defmethod rigid-transformation-p ((transformation standard-transformation))
   (multiple-value-bind (a b c d) (get-transformation transformation)
-    (and (coordinate= 1 (+ (* a a) (* c c)))            ; |A(1,0)| = 1
-         (coordinate= 1 (+ (* b b) (* d d)))            ; |A(0,1)| = 1
-         (coordinate= 0 (+ (* a b) (* c d))))))         ; (A(1,0))(A(0,1)) = 0
+    (and (coordinate= (coordinate 1) (+ (* a a) (* c c)))            ; |A(1,0)| = 1
+         (coordinate= (coordinate 1) (+ (* b b) (* d d)))            ; |A(0,1)| = 1
+         (coordinate= (coordinate 0) (+ (* a b) (* c d))))))         ; (A(1,0))(A(0,1)) = 0
 
 (defmethod even-scaling-transformation-p ((transformation standard-transformation))
   (and (scaling-transformation-p transformation)
@@ -322,24 +322,24 @@
   ;; I think it would be strange if (s-t-p (make-s-t* 2 1 1 0)) is not T. -- APD
   (multiple-value-bind (mxx mxy myx myy tx ty) (get-transformation transformation)
     (declare (ignore tx ty))
-    (and (coordinate= 0 mxy) (coordinate= 0 myx)
-         (coordinate/= 0 mxx) (coordinate/= 0 myy)))) ; ?
+    (and (coordinate= (coordinate 0) mxy) (coordinate= (coordinate 0) myx)
+         (coordinate/= (coordinate 0) mxx) (coordinate/= (coordinate 0) myy)))) ; ?
 
 (defmethod rectilinear-transformation-p ((transformation standard-transformation))
   ;; Das testen wir einfach ganz brutal
   ;;; ist das auch richtig?
   (multiple-value-bind (mxx mxy myx myy) (get-transformation transformation)
-    (or (and (coordinate= mxx 0) (coordinate/= mxy 0)
-             (coordinate/= myx 0) (coordinate= myy 0))
-        (and (coordinate/= mxx 0) (coordinate= mxy 0)
-             (coordinate= myx 0) (coordinate/= myy 0)))))
+    (or (and (coordinate= mxx (coordinate 0)) (coordinate/= mxy (coordinate 0))
+             (coordinate/= myx (coordinate 0)) (coordinate= myy (coordinate 0)))
+        (and (coordinate/= mxx (coordinate 0)) (coordinate= mxy (coordinate 0))
+             (coordinate= myx (coordinate 0)) (coordinate/= myy (coordinate 0))))))
 
 (defmethod y-inverting-transformation-p ((transformation standard-transformation))
   (multiple-value-bind (mxx mxy myx myy) (get-transformation transformation)
-    (and (coordinate= mxx 1)
-         (coordinate= mxy 0)
-         (coordinate= myx 0)
-         (coordinate= myy -1))))
+    (and (coordinate= mxx (coordinate 1))
+         (coordinate= mxy (coordinate 0))
+         (coordinate= myx (coordinate 0))
+         (coordinate= myy (coordinate -1)))))
 
 (defmethod compose-transformations ((transformation2 standard-transformation)
                                     (transformation1 standard-transformation))
@@ -368,7 +368,7 @@
        (handler-case
            (multiple-value-bind (mxx mxy myx myy tx ty) (get-transformation transformation)
              (let ((det (- (* mxx myy) (* myx mxy))))
-               (if (coordinate= 0 det)
+               (if (coordinate= (coordinate 0) det)
                    nil
                    (let ((/det (/ det)))
                      (let ((mxx (* /det myy))
@@ -593,9 +593,9 @@
   ;; returns a function, which transforms its arguments
   (multiple-value-bind (mxx mxy myx myy tx ty) (get-transformation transformation)
     (labels ((s* (x y)
-               (cond ((coordinate= 0 x) nil)
-                     ((coordinate= 1 x) (list y))
-                     ((coordinate= -1 x) (list `(- ,y)))
+               (cond ((coordinate= (coordinate 0) x) nil)
+                     ((coordinate= (coordinate 1) x) (list y))
+                     ((coordinate= (coordinate -1) x) (list `(- ,y)))
                      ((list `(* ,x ,y)))))
              (s+ (args)
                (cond ((null args)
@@ -612,10 +612,10 @@
                   (values
                    ,(s+ (nconc (s* mxx 'x)
                                (s* mxy 'y)
-                               (if (coordinate/= 0 tx) (list tx) nil)))
+                               (if (coordinate/= (coordinate 0) tx) (list tx) nil)))
                    ,(s+ (nconc (s* myx 'x)
                                (s* myy 'y)
-                               (if (coordinate/= 0 ty) (list ty) nil))))) ))))
+                               (if (coordinate/= (coordinate 0) ty) (list ty) nil))))) ))))
 
 (defmethod transformation-transformator ((transformation transformation) &optional (input-type 'real))
   (declare (ignore input-type))
Index: Goatee/clim-area.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Goatee/clim-area.lisp,v
retrieving revision 1.28
diff -u -r1.28 clim-area.lisp
--- Goatee/clim-area.lisp	24 Oct 2004 15:47:02 -0000	1.28
+++ Goatee/clim-area.lisp	3 Jan 2005 16:21:34 -0000
@@ -77,8 +77,8 @@
       (setf (cursor area)
 	  (make-instance 'screen-area-cursor
 			 :sheet (area-stream area)
-			 :x-position x
-			 :y-position y))))
+			 :x-position (coordinate x)
+			 :y-position (coordinate y)))))
   (when (not (slot-boundp area 'max-width))
     (setf (max-width area) (if area-stream
 			       (- (stream-text-margin area-stream)
@@ -205,7 +205,8 @@
     (multiple-value-bind (x y)
 	(output-record-position obj)
       (declare (ignore x))
-      (setf (slot-value obj 'climi::y2) (+ y (ascent obj) (descent obj)))
+      (setf (slot-value obj 'climi::y2) (coordinate
+                                         (+ y (ascent obj) (descent obj))))
       (setf (baseline obj) (+ y (ascent obj))))))
 
 (defmethod map-over-output-records (function (record screen-line)
@@ -335,8 +336,8 @@
 	       for prev-area-line = (lines area) then area-line
 	       for y = parent-y then (+ y ascent descent vertical-spacing)
 	       for area-line = (make-instance 'screen-line
-					      :x-position parent-x
-					      :y-position y
+					      :x-position (coordinate parent-x)
+					      :y-position (coordinate y)
 					      :parent area
 					      :buffer-line buffer-line
 					      :last-tick (tick buffer-line)
Index: Goatee/editing-stream.lisp
===================================================================
RCS file: /project/mcclim/cvsroot/mcclim/Goatee/editing-stream.lisp,v
retrieving revision 1.20
diff -u -r1.20 editing-stream.lisp
--- Goatee/editing-stream.lisp	24 Oct 2004 15:47:02 -0000	1.20
+++ Goatee/editing-stream.lisp	3 Jan 2005 16:21:34 -0000
@@ -77,8 +77,8 @@
 					    :newline-character (if single-line
 								   nil
 								   #\Newline))
-		     :x-position cx
-		     :y-position cy
+		     :x-position (coordinate cx)
+		     :y-position (coordinate cy)
 		     :cursor-visibility cursor-visibility
 		     :max-width max-width
 		     :allow-other-keys t