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

[Robert Strandh]

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

Modified Files:
	regions.lisp 
Log Message:
Tests for ellipses and elliptical arcs.  This addition means that
regions are mostly covered.

Date: Mon Sep 12 23:23:57 2005
Author: rstrandh

Index: mcclim/Tests/regions.lisp
diff -u mcclim/Tests/regions.lisp:1.3 mcclim/Tests/regions.lisp:1.4
--- mcclim/Tests/regions.lisp:1.3	Sun Sep 11 23:44:42 2005
+++ mcclim/Tests/regions.lisp	Mon Sep 12 23:23:56 2005
@@ -227,4 +227,67 @@
   (assert (region-equal (make-point x1 y2) (rectangle-min-point r1)))
   (assert (region-equal (make-point x2 y1) (rectangle-max-point r1))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; ellipse
 
+(assert (subtypep 'ellipse 'area))
+(assert (subtypep 'standard-ellipse 'ellipse))
+
+(let* ((xc 234) (yc 345) (xdr1 -858) (ydr1 44) (xdr2 -55) (ydr2 5)
+       (sa 10) (ea 270)
+       (pc (make-point xc yc))
+       (e1 (make-ellipse* xc yc xdr1 ydr1 xdr2 ydr2 :start-angle sa :end-angle ea))
+       (e2 (make-ellipse pc xdr1 ydr1 xdr2 ydr2 :start-angle sa :end-angle ea))
+       (e3 (make-ellipse pc xdr1 ydr1 xdr2 ydr2)))
+  (assert (typep e1 'standard-ellipse))
+  (assert (ellipsep e1))
+;;; this test fails
+;;;  (assert (region-equal e1 e2))
+  (multiple-value-bind (x y) (ellipse-center-point* e1)
+    (assert (= (coordinate xc) x))
+    (assert (= (coordinate yc) y))
+    (assert (region-equal (make-point x y) (ellipse-center-point e2))))
+  (multiple-value-bind (xr11 yr11 xr12 yr12) (ellipse-radii e1)
+    (multiple-value-bind (xr21 yr21 xr22 yr22) (ellipse-radii e2)
+      (assert (= xr11 xr21))
+      (assert (= yr11 yr21))
+      (assert (= xr12 xr22))
+      (assert (= yr12 yr22))))
+  (assert (= (coordinate sa) (coordinate (ellipse-start-angle e1))))
+  (assert (= (coordinate ea) (coordinate (ellipse-end-angle e1))))
+  (assert (null (ellipse-start-angle e3)))
+  (assert (null (ellipse-end-angle e3))))
+  
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; elliptical arc
+
+(assert (subtypep 'elliptical-arc 'path))
+(assert (subtypep 'standard-elliptical-arc 'elliptical-arc))
+
+(let* ((xc 234) (yc 345) (xdr1 -858) (ydr1 44) (xdr2 -55) (ydr2 5)
+       (sa 10) (ea 270)
+       (pc (make-point xc yc))
+       (ea1 (make-elliptical-arc* xc yc xdr1 ydr1 xdr2 ydr2 :start-angle sa :end-angle ea))
+       (ea2 (make-elliptical-arc pc xdr1 ydr1 xdr2 ydr2 :start-angle sa :end-angle ea))
+       (ea3 (make-elliptical-arc pc xdr1 ydr1 xdr2 ydr2)))
+  (assert (typep ea1 'standard-elliptical-arc))
+  (assert (elliptical-arc-p ea1))
+;;; this test fails
+;;;  (assert (region-equal ea1 ea2))
+  (multiple-value-bind (x y) (ellipse-center-point* ea1)
+    (assert (= (coordinate xc) x))
+    (assert (= (coordinate yc) y))
+    (assert (region-equal (make-point x y) (ellipse-center-point ea2))))
+  (multiple-value-bind (xr11 yr11 xr12 yr12) (ellipse-radii ea1)
+    (multiple-value-bind (xr21 yr21 xr22 yr22) (ellipse-radii ea2)
+      (assert (= xr11 xr21))
+      (assert (= yr11 yr21))
+      (assert (= xr12 xr22))
+      (assert (= yr12 yr22))))
+  (assert (= (coordinate sa) (coordinate (ellipse-start-angle ea1))))
+  (assert (= (coordinate ea) (coordinate (ellipse-end-angle ea1))))
+  (assert (null (ellipse-start-angle ea3)))
+  (assert (null (ellipse-end-angle ea3))))