Update of /project/mcclim/cvsroot/mcclim/Tests In directory common-lisp.net:/tmp/cvs-serv5189

Modified Files: regions.lisp Log Message: tests for lines and rectangles

Date: Sun Sep 11 23:44:42 2005 Author: rstrandh

Index: mcclim/Tests/regions.lisp diff -u mcclim/Tests/regions.lisp:1.2 mcclim/Tests/regions.lisp:1.3 --- mcclim/Tests/regions.lisp:1.2 Thu Sep 8 23:43:22 2005 +++ mcclim/Tests/regions.lisp Sun Sep 11 23:44:42 2005 @@ -143,7 +143,9 @@ (push (make-point x y) points)) pl1) (assert (null (set-difference (list p1 p2 p3) points :test #'region-equal))) - (assert (null (set-difference points (list p1 p2 p3) :test #'region-equal)))) + (assert (null (set-difference points (list p1 p2 p3) :test #'region-equal))) + (assert (polyline-closed pl3)) + (assert (not (polyline-closed pl2))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; @@ -172,3 +174,57 @@ pg1) (assert (null (set-difference (list p1 p2 p3) points :test #'region-equal))) (assert (null (set-difference points (list p1 p2 p3) :test #'region-equal)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; line + +(assert (subtypep 'line 'polyline)) +(assert (subtypep 'standard-line 'line)) + +(let* ((x1 234) (y1 876) (x2 345) (y2 -55) + (p1 (make-point x1 y1)) (p2 (make-point x2 y2)) + (l1 (make-line p1 p2)) (l2 (make-line* x1 y1 x2 y2))) + (assert (typep l1 'standard-line)) + (assert (linep l1)) + (assert (region-equal l1 l2)) + (multiple-value-bind (xx1 yy1) (line-start-point* l1) + (assert (= (coordinate x1) xx1)) + (assert (= (coordinate y1) yy1))) + (multiple-value-bind (xx2 yy2) (line-end-point* l1) + (assert (= (coordinate x2) xx2)) + (assert (= (coordinate y2)yy2))) + (assert (region-equal p1 (line-start-point l1))) + (assert (region-equal p2 (line-end-point l1)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; rectangle + +(assert (subtypep 'rectangle 'polygon)) +(assert (subtypep 'standard-rectangle 'rectangle)) + +(let* ((x1 234) (y1 876) (x2 345) (y2 -55) + (p1 (make-point x1 y1)) (p2 (make-point x2 y2)) + (r1 (make-rectangle p1 p2)) (r2 (make-rectangle* x1 y1 x2 y2))) + (assert (typep r1 'standard-rectangle)) + (assert (rectanglep r1)) + (assert (region-equal r1 r2)) + (multiple-value-bind (min-x min-y max-x max-y) (rectangle-edges* r1) + (assert (= (rectangle-min-x r1) min-x)) + (assert (= (rectangle-min-y r1) min-y)) + (assert (= (rectangle-max-x r1) max-x)) + (assert (= (rectangle-max-y r1) max-y)) + (assert (= (coordinate x1) min-x)) + (assert (= (coordinate y1) max-y)) + (assert (= (coordinate x2) max-x)) + (assert (= (coordinate y2) min-y)) + (multiple-value-bind (width height) (rectangle-size r1) + (assert (= width (rectangle-width r1))) + (assert (= height (rectangle-height r1))) + (assert (= width (- max-x min-x))) + (assert (= height (- max-y min-y))))) + (assert (region-equal (make-point x1 y2) (rectangle-min-point r1))) + (assert (region-equal (make-point x2 y1) (rectangle-max-point r1)))) + +