[mcclim-cvs] CVS update: mcclim/Tests/regions.lisp

[Robert Strandh]

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))))
+
+