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

[Robert Strandh]

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

Modified Files:
	transformations.lisp 
Log Message:
more tests on transformations.

Date: Wed Sep 21 22:18:09 2005
Author: rstrandh

Index: mcclim/Tests/transformations.lisp
diff -u mcclim/Tests/transformations.lisp:1.1 mcclim/Tests/transformations.lisp:1.2
--- mcclim/Tests/transformations.lisp:1.1	Mon Sep 19 00:12:04 2005
+++ mcclim/Tests/transformations.lisp	Wed Sep 21 22:18:06 2005
@@ -54,3 +54,71 @@
     (assert (typep (make-3-point-transformation p1 p2 p3 p4 p5 p6) 'transformation))
     (assert (typep (make-3-point-transformation* x1 y1 x2 y2 x3 y3 x4 y4 x5 y5 x6 y6)
 		   'transformation))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; transformation protocol
+
+(let* ((t1 (make-rotation-transformation 0))
+       (t2 (make-scaling-transformation 1 1)))
+  (assert (identity-transformation-p t1))
+  (assert (identity-transformation-p t2))
+  (assert (transformation-equal t1 t2))
+  (assert (invertible-transformation-p t1))
+  (assert (invertible-transformation-p t2))
+  (assert (translation-transformation-p t1))
+  (assert (translation-transformation-p t2))
+;;; tests fail
+;;;  (assert (reflection-transformation-p t1))
+;;;  (assert (reflection-transformation-p t2))
+  (assert (rigid-transformation-p t1))
+  (assert (rigid-transformation-p t2))
+  (assert (even-scaling-transformation-p t1))
+  (assert (even-scaling-transformation-p t2))
+  (assert (scaling-transformation-p t1))
+  (assert (scaling-transformation-p t2))
+  (assert (rectilinear-transformation-p t1))
+  (assert (rectilinear-transformation-p t2))
+  (assert (transformation-equal t1 (compose-transformations t1 t2)))
+  (assert (transformation-equal t1 (invert-transformation t1)))
+  (assert (transformation-equal t1 (compose-translation-with-transformation t1 0 0)))
+  (assert (transformation-equal t1 (compose-rotation-with-transformation t1 0)))
+  (assert (transformation-equal t1 (compose-scaling-with-transformation t1 1 1)))
+;;; tests fail
+;;;  (assert (transformation-equal t1 (compose-transformation-with-translation t1 0 0)))
+  (assert (transformation-equal t1 (compose-transformation-with-rotation t1 0)))
+  (assert (transformation-equal t1 (compose-transformation-with-scaling t1 1 1))))
+  
+  
+(let ((tr (make-rotation-transformation 0))
+      (r (make-rectangle* 10 20 30 40))
+      (x 10) (y 20))
+  (assert (region-equal r (transform-region tr r)))
+  (assert (region-equal r (untransform-region tr r)))
+  (multiple-value-bind (xx yy) (transform-position tr x y)
+    (assert (= (coordinate x) xx))
+    (assert (= (coordinate y) yy)))
+  (multiple-value-bind (xx yy) (untransform-position tr x y)
+    (assert (= (coordinate x) xx))
+    (assert (= (coordinate y) yy)))
+  (multiple-value-bind (xx yy) (transform-distance tr x y)
+    (assert (= (coordinate x) xx))
+    (assert (= (coordinate y) yy)))
+  (multiple-value-bind (xx yy) (untransform-distance tr x y)
+    (assert (= (coordinate x) xx))
+    (assert (= (coordinate y) yy)))
+  (let ((x2 55) (y2 -20))
+    (multiple-value-bind (xx1 yy1 xx2 yy2) (transform-rectangle* tr x y x2 y2)
+      (assert (= xx1 (min (coordinate x) (coordinate x2))))
+      (assert (= yy1 (min (coordinate y) (coordinate y2))))
+      (assert (= xx2 (max (coordinate x) (coordinate x2))))
+      (assert (= yy2 (max (coordinate y) (coordinate y2)))))
+    (multiple-value-bind (xx1 yy1 xx2 yy2) (untransform-rectangle* tr x y x2 y2)
+      (assert (= xx1 (min (coordinate x) (coordinate x2))))
+      (assert (= yy1 (min (coordinate y) (coordinate y2))))
+      (assert (= xx2 (max (coordinate x) (coordinate x2))))
+      (assert (= yy2 (max (coordinate y) (coordinate y2)))))))
+
+
+
+