Author: ksprotte Date: Tue Jan 29 05:06:55 2008 New Revision: 2413 Modified: branches/bos/projects/bos/m2/geometry.lisp Log: added macro DORECT in 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 05:06:55 2008 @@ -2,6 +2,7 @@ ;; 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)))) @@ -21,6 +22,33 @@ (sqrt (+ (expt (- point-a-x point-b-x) 2) (expt (- point-a-y point-b-y) 2))))) +(defmacro dorect ((point (left top width height) &key test row-change) &body body) + "Iterate with POINT over all points in rect row per row. The list +containing x and y is intended for only extracting those +and not to be stored away (it will be modified). + +BODY is only executed, if TEST of the current point is true. + +For convenience, a null arg function ROW-CHANGE can be given +that will be called between the rows." + (check-type point symbol) + (rebinding (left top) + `(iter + (with ,point = (list nil nil)) + (for y from ,top to (1- (+ ,top ,height))) + ,(when row-change + `(unless (first-time-p) + (funcall ,row-change))) + (iter + (for x from ,left to (1- (+ ,left ,width))) + (setf (first ,point) x + (second ,point) y) + (when ,(if test + `(funcall ,test point) + t) + ,@body))))) + + ;; maybe change this function to take a ;; point as an argument? (defun point-in-polygon-p (x y polygon) @@ -42,6 +70,14 @@ (defun point-in-circle-p (point center radius) (<= (distance point center) radius)) +;;; for fun... +(defun point-in-circle-p-test () + (let ((center (list 4 4))) + (dorect (p (0 0 10 10) :row-change #'terpri) + (if (point-in-circle-p p center 3) + (princ "x") + (princ "."))))) + ;;; directions ;; A direction can be represented either