[bknr-cvs] r2412 - branches/bos/projects/bos/m2

ksprotte at common-lisp.net ksprotte at common-lisp.net
Tue Jan 29 09:17:51 UTC 2008


Author: ksprotte
Date: Tue Jan 29 04:17:50 2008
New Revision: 2412

Modified:
   branches/bos/projects/bos/m2/geometry.lisp
   branches/bos/projects/bos/m2/packages.lisp
Log:
added DISTANCE and POINT-IN-CIRCLE-P to geometry.lisp


Modified: branches/bos/projects/bos/m2/geometry.lisp
==============================================================================
--- branches/bos/projects/bos/m2/geometry.lisp	(original)
+++ branches/bos/projects/bos/m2/geometry.lisp	Tue Jan 29 04:17:50 2008
@@ -1,8 +1,25 @@
-
 (in-package :geometry)
 
 ;; a point in this package is represented
 ;; as a list (x y)
+(defmacro with-point (point &body body)
+  (let* ((*package* (symbol-package point))
+	 (x (intern (format nil "~A-X" (symbol-name point))))
+	 (y (intern (format nil "~A-Y" (symbol-name point)))))
+    `(destructuring-bind (,x ,y) ,point
+       , at body)))
+
+(defmacro with-points ((&rest points) &body body)
+  (if (null points)
+      `(progn , at body)
+      `(with-point ,(car points)
+	 (with-points (,@(cdr points))
+	   , at body))))
+
+(defun distance (point-a point-b)
+  (with-points (point-a point-b)
+    (sqrt (+ (expt (- point-a-x point-b-x) 2)
+	     (expt (- point-a-y point-b-y) 2)))))
 
 ;; maybe change this function to take a
 ;; point as an argument?
@@ -22,6 +39,9 @@
 		pjy piy))
     result))
 
+(defun point-in-circle-p (point center radius)
+  (<= (distance point center) radius))
+
 ;;; directions
 
 ;; A direction can be represented either

Modified: branches/bos/projects/bos/m2/packages.lisp
==============================================================================
--- branches/bos/projects/bos/m2/packages.lisp	(original)
+++ branches/bos/projects/bos/m2/packages.lisp	Tue Jan 29 04:17:50 2008
@@ -2,7 +2,9 @@
 
 (defpackage :geometry
   (:use :cl :iterate :arnesi)
-  (:export #:point-in-polygon-p
+  (:export #:distance
+	   #:point-in-polygon-p
+	   #:point-in-circle-p
 	   #:find-boundary-point
 	   #:region-to-polygon))
 



More information about the Bknr-cvs mailing list