[mcclim-cvs] CVS mcclim

[ahefner]

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

Modified Files:
	regions.lisp 
Log Message:
Added internal helper, with-grown-rectangle*.



--- /project/mcclim/cvsroot/mcclim/regions.lisp	2006/05/05 10:24:02	1.33
+++ /project/mcclim/cvsroot/mcclim/regions.lisp	2007/02/05 03:07:22	1.34
@@ -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.33 2006/05/05 10:24:02 crhodes Exp $
+;;;       $Id: regions.lisp,v 1.34 2007/02/05 03:07:22 ahefner Exp $
 ;;; --------------------------------------------------------------------------------------
 ;;;  (c) copyright 1998,1999,2001 by Gilbert Baumann
 ;;;  (c) copyright 2001 by Arnaud Rouanet (rouanet at emi.u-bordeaux.fr)
@@ -2378,3 +2378,23 @@
   ;;    (and (<= u1 x2) (<= x1 u2)
   ;;         (<= v1 y2) (<= y1 v2))))
   )
+
+;;; Internal helpers
+
+(defmacro with-grown-rectangle* (((out-x1 out-y1 out-x2 out-y2)
+                                  (in-x1 in-y1 in-x2 in-y2)
+                                  &key
+                                  radius
+                                  (radius-x radius)
+                                  (radius-y radius)
+                                  (radius-left  radius-x)
+                                  (radius-right radius-x)
+                                  (radius-top    radius-y)
+                                  (radius-bottom radius-y))
+                                  &body body)
+  `(multiple-value-bind (,out-x1 ,out-y1 ,out-x2 ,out-y2)
+    (values (- ,in-x1 ,radius-left)
+     (- ,in-y1 ,radius-top)
+     (+ ,in-x2 ,radius-right)
+     (+ ,in-y2 ,radius-bottom))
+    , at body))