[mcclim-cvs] CVS mcclim

[ahefner]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv28221

Modified Files:
	recording.lisp 
Log Message:
Fix the zero coordinate kludge in output-record-children in the case
where a a max coordinate is less than zero, which previously resulted
in an invalid rectangle.


--- /project/mcclim/cvsroot/mcclim/recording.lisp	2008/02/03 22:54:13	1.140
+++ /project/mcclim/cvsroot/mcclim/recording.lisp	2008/04/13 07:32:40	1.141
@@ -991,23 +991,24 @@
   (remhash entry (%tree-record-children-cache record)))
 
 (defmethod output-record-children ((record standard-tree-output-record))
-  (map 'list
-       #'tree-output-record-entry-record
-       (spatial-trees:search 
-        (%record-to-spatial-tree-rectangle record)
-        ;; The form below intends to fix output-record-children not
-        ;; reporting empty children, which may lie outside the reported
-        ;; bounding rectangle of their parent.
-        ;; Assumption: null bounding records are always at the origin.
-        ;; I've never noticed this violated, but it's out of line with
-        ;; what null-bounding-rectangle-p checks, and setf of
-        ;; output-record-position may invalidate it. Seems to work, but
-        ;; fix that and try again later.
-        #+NIL
-        (rectangles:make-rectangle
-         :lows (list 0 0) #| `(,(bounding-rectangle-min-x r) ,(bounding-rectangle-min-y r)) |#
-         :highs `(,(bounding-rectangle-max-x record) ,(bounding-rectangle-max-y record)))
-       (%tree-record-children record))))
+  (with-bounding-rectangle* (min-x min-y max-x max-y) record
+    (map 'list
+         #'tree-output-record-entry-record
+         (spatial-trees:search 
+          ;; Originally, (%record-to-spatial-tree-rectangle record).
+          ;; The form below intends to fix output-record-children not
+          ;; reporting empty children, which may lie outside the reported
+          ;; bounding rectangle of their parent.
+          ;; Assumption: null bounding records are always at the origin.
+          ;; I've never noticed this violated, but it's out of line with
+          ;; what null-bounding-rectangle-p checks, and setf of
+          ;; output-record-position may invalidate it. Seems to work, but
+          ;; fix that and try again later.
+          ;; Note that max x or y may be less than zero..
+          (rectangles:make-rectangle
+           :lows  (list (min 0 min-x) (min 0 min-y))
+           :highs (list (max 0 max-x) (max 0 max-y)))
+          (%tree-record-children record)))))
 
 (defmethod add-output-record (child (record standard-tree-output-record))
   (let ((entry (make-tree-output-record-entry child (incf (last-insertion-nr record)))))