Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv2997
Modified Files:
regions.lisp
Log Message:
Fix a couple of region bugs
* the infinite loop in point/point intersection noted in the tests
* isum-member was broken for more than one rectangle in the same
horizontal band. Add test for this case.
--- /project/mcclim/cvsroot/mcclim/regions.lisp 2005/02/11 10:05:57 1.30
+++ /project/mcclim/cvsroot/mcclim/regions.lisp 2006/03/06 16:09:12 1.31
@@ -4,7 +4,7 @@
;;; Created: 1998-12-02 19:26
;;; Author: Gilbert Baumann <unk6(a)rz.uni-karlsruhe.de>
;;; License: LGPL (See file COPYING for details).
-;;; $Id: regions.lisp,v 1.30 2005/02/11 10:05:57 crhodes Exp $
+;;; $Id: regions.lisp,v 1.31 2006/03/06 16:09:12 crhodes Exp $
;;; --------------------------------------------------------------------------------------
;;; (c) copyright 1998,1999,2001 by Gilbert Baumann
;;; (c) copyright 2001 by Arnaud Rouanet (rouanet(a)emi.u-bordeaux.fr)
@@ -1042,6 +1042,11 @@
(t
(make-instance 'standard-region-union :regions (list a b)))))
+(defmethod region-intersection ((a point) (b point))
+ (cond
+ ((region-equal a b) a)
+ (t +nowhere+)))
+
(defmethod region-equal ((a point) (b point))
(and (coordinate= (point-x a) (point-x b))
(coordinate= (point-y a) (point-y b))))
@@ -1316,8 +1321,8 @@
(defun isum-member (elt isum)
(cond ((null isum) nil)
- ((<= (car isum) elt (cadr isum)) t)
- ((> elt (cadr isum)) nil)
+ ((< elt (car isum)) nil)
+ ((<= elt (cadr isum)) t)
(t (isum-member elt (cddr isum)))))
(defun rectangle->standard-rectangle-set (rect)
@@ -1563,13 +1568,13 @@
(defmethod region-intersection ((b region) (a standard-polyline))
(region-intersection a b))
-(defmethod region-intersection ((a region) (p standard-point))
+(defmethod region-intersection ((a region) (p point))
(multiple-value-bind (x y) (point-position p)
(if (region-contains-position-p a x y)
p
+nowhere+)))
-(defmethod region-intersection ((p standard-point) (a region))
+(defmethod region-intersection ((p point) (a region))
(region-intersection a p))
(defmethod region-intersection ((a standard-region-union) (b region))
@@ -1656,7 +1661,7 @@
x)
res))
-(defmethod region-difference ((x standard-point) (y region))
+(defmethod region-difference ((x point) (y region))
(multiple-value-bind (px py) (point-position x)
(if (region-contains-position-p y px py)
+nowhere+
@@ -2186,7 +2191,7 @@
(region-union (region-difference a b) (region-difference b a)))
-(defmethod region-contains-region-p ((a region) (b standard-point))
+(defmethod region-contains-region-p ((a region) (b point))
(region-contains-position-p a (point-x b) (point-y b)))
;; xxx was ist mit (region-contains-region-p x +nowhere+) ?
