Navigation

Changeset 2632

Timestamp:

02/26/08 19:10:56 (11 months ago)

Author:

ksprotte

Message:

merge geometry chs from bos to trunk [2630]

Files:

r2499	r2632
77	77	(<= (distance point center) radius))
78	78
	79	(defun point-in-rect-p (point left top width height)
	80	(with-point point
	81	(and (<= left point-x (1- (+ left width)))
	82	(<= top point-y (1- (+ top height))))))
	83
79	84	;;; for fun...
80	85	(defun point-in-circle-p-test ()
…	…
84	89	(princ "x")
85	90	(princ ".")))))
	91
	92	(defun bounding-box (objects &key (key #'identity))
	93	(let (min-x min-y max-x max-y)
	94	(dolist (obj objects)
	95	(let ((point (funcall key obj)))
	96	(with-point point
	97	(setf min-x (min point-x (or min-x point-x)))
	98	(setf min-y (min point-y (or min-y point-y)))
	99	(setf max-x (max point-x (or max-x point-x)))
	100	(setf max-y (max point-y (or max-y point-y))))))
	101	(list min-x min-y (1+ (- max-x min-x)) (1+ (- max-y min-y)))))
	102
	103	(defmacro with-bounding-box-collect ((collect) &body body)
	104	`(let (min-x min-y max-x max-y)
	105	(flet ((,collect (point)
	106	(with-point point
	107	(setf min-x (min point-x (or min-x point-x)))
	108	(setf min-y (min point-y (or min-y point-y)))
	109	(setf max-x (max point-x (or max-x point-x)))
	110	(setf max-y (max point-y (or max-y point-y))))))
	111	,@body)
	112	(list min-x min-y (1+ (- max-x min-x)) (1+ (- max-y min-y)))))
86	113
87	114	;;; directions