[mcclim-cvs] CVS mcclim

thenriksen thenriksen at common-lisp.net
Wed Jan 23 22:37:09 UTC 2008


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

Modified Files:
	regions.lisp 
Log Message:
Added support for zero-radius ellipses. I hope I didn't break anything...


--- /project/mcclim/cvsroot/mcclim/regions.lisp	2008/01/21 01:34:13	1.37
+++ /project/mcclim/cvsroot/mcclim/regions.lisp	2008/01/23 22:37:08	1.38
@@ -4,7 +4,7 @@
 ;;;   Created: 1998-12-02 19:26
 ;;;    Author: Gilbert Baumann <unk6 at rz.uni-karlsruhe.de>
 ;;;   License: LGPL (See file COPYING for details).
-;;;       $Id: regions.lisp,v 1.37 2008/01/21 01:34:13 ahefner Exp $
+;;;       $Id: regions.lisp,v 1.38 2008/01/23 22:37:08 thenriksen Exp $
 ;;; --------------------------------------------------------------------------------------
 ;;;  (c) copyright 1998,1999,2001 by Gilbert Baumann
 ;;;  (c) copyright 2001 by Arnaud Rouanet (rouanet at emi.u-bordeaux.fr)
@@ -633,15 +633,17 @@
                       (xn (- (/ yc d)))
                       (yn (/ xc d)))
                  (transform-distance tr xn yn)))))
-      (multiple-value-bind (vdx vdy) (contact-radius* 1 0)
-        (declare (ignore vdx))
-        (multiple-value-bind (hdx hdy) (contact-radius* 0 1)
-          (declare (ignore hdy))
-          (multiple-value-bind (cx cy) (ellipse-center-point* region)
-            (let ((rx (abs hdx))
-                  (ry (abs vdy)))
-              (values (- cx rx) (- cy ry)
-                      (+ cx rx) (+ cy ry)))))))))
+      (multiple-value-bind (cx cy) (ellipse-center-point* region)
+        (if (zerop (ellipse-radii region))
+            (values cx cy cx cy)
+            (multiple-value-bind (vdx vdy) (contact-radius* 1 0)
+              (declare (ignore vdx))
+              (multiple-value-bind (hdx hdy) (contact-radius* 0 1)
+                (declare (ignore hdy))
+                (let ((rx (abs hdx))
+                      (ry (abs vdy)))
+                  (values (- cx rx) (- cy ry)
+                          (+ cx rx) (+ cy ry))))))))))
 
 (defun intersection-line/unit-circle (x1 y1 x2 y2)
   "Computes the intersection of the line from (x1,y1) to (x2,y2) and the unit circle.




More information about the Mcclim-cvs mailing list