- ajoute des tests pour

  translate 'absolute'
  tget
  skew

1 files changed, 168 insertions, 6 deletions

diff --git a/Perl/t/Transformations.t b/Perl/t/Transformations.t
index 8d73060..e736837 100644
--- a/Perl/t/Transformations.t
+++ b/Perl/t/Transformations.t
@@ -1,7 +1,7 @@
 #!/usr/bin/perl -w
 
 #
-# $Id: Transformations.t,v 1.2 2003-12-11 12:11:41 mertz Exp $
+# $Id: Transformations.t,v 1.3 2004-04-02 12:03:34 mertz Exp $
 # Author: Christophe Mertz
 #
 
@@ -9,7 +9,8 @@
 
 BEGIN {
     if (!eval q{
-        use Test::More qw(no_plan);
+#        use Test::More qw(no_plan);
+        use Test::More tests => 21;
         1;
     }) {
         print "# tests only work properly with installed Test::More module\n";
@@ -40,6 +41,7 @@ BEGIN {
 
 $mw = MainWindow->new();
 $zinc = $mw->Zinc(-width => 100, -height => 100);
+my $coords = [ [10,10], [40, 40] ];
 
 like  ($zinc, qr/^Tk::Zinc=HASH/ , "zinc has been created");
 
@@ -129,13 +131,173 @@ is_deeply([
 	  [ [10,10], [40, 40] ],
 	  "rect2 window coordinates with 'device' after rect2 treset"); 
 
+$zinc->treset($rect2);
 $zinc->skew($rect2, 10,00);
 $zinc->skew($rect2, -10,00);
+ok(&similarPoints ([
+                    $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] )
+                   ],
+                   [ [10, 10], [40, 40] ]),
+   "rect2 window coordinates with 'device' after rect2 skew (back and forth)");
+
+
+$zinc->treset($rect2);
+$zinc->skew($rect2, -10,00);
+$zinc->skew($rect2, 10,00);
+ok(&similarPoints ([
+                    $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] )
+                   ],
+                   [ [10, 10], [40, 40] ]),
+   "rect2 window coordinates with 'device' after rect2 skew (forth and back)");
+
+
+$zinc->treset($rect2);
+$zinc->translate($rect2, 34,43);
+$zinc->translate($rect2, 15,15, 'absolute'); # the previous relative translation will be overridden
 is_deeply([
-	   $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] )
-	    ],
-	  [ [10,10], [40, 40] ],
-	  "rect2 window coordinates with 'device' after rect2 skew (back and forth)"); 
+           $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] )
+          ],
+	  [ [25,25], [55, 55] ],
+	  "rect2 window coordinates with 'device' after rect2 absolute translation"); 
+
+if (0) {
+$zinc->treset($rect2);
+print "0     ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 3.14159);
+print "+3.14 ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, -3.14159, 0);
+print "0     ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 180, 1);
+print "180   ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, -3.14159, 100, 200);
+print "0     ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, -3.14159, 0, 100, 200);
+print "3.14  ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 180, 1, 100, 200);
+print "0     ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 180, 1, 100, 200, 300);
+print "3.14  ", $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 180, 1, 100, 200, 300, 600);
+print $zinc->tget($rect2, 'rotation'), "\n";
+$zinc->rotate($rect2, 180, 1, 100, 200, 300, 600, 900);
+print $zinc->tget($rect2, 'rotation'), "\n";
+}
+
+$zinc->treset($rect2);
+$zinc->translate($rect2, 40,50);
+$zinc->scale($rect2, 2,3);
+$zinc->rotate($rect2, 3.1415/2);
+
+my ($m00, $m01, $m10, $m11, $m20, $m21) = $zinc->tget($rect2);
+#print "matrix: $m00, $m01, $m10, $m11, $m20, $m21\n";
+ok(&similarFlatArray ([$zinc->tget($rect2)],
+                      [0,     2,     -3,    0,     -150, 80],
+                      [0.001, 0.001, 0.001, 0.001, 1,    1]),
+   "tget of rect2");
+
+my ($xTranslate, $yTranslate, $xScale, $yScale, $angle, $skew) = $zinc->tget($rect2, 'all');
+#print "matrix: $xTranslate, $yTranslate, $xScale, $yScale, $angle, $skew\n";
+ok(&similarFlatArray ([$zinc->tget($rect2,'all')],
+                      [-150,   80,     2,     3,  3.14159/2, 0    ],
+                      [1,       1, 0.001, 0.001,  0.001,     0.001]),
+   "tget 'all' of rect2");
+
+
+($xTranslate, $yTranslate) = $zinc->tget($rect2, 'translation');
+#print "translate: $xTranslate, $yTranslate\n";
+ok(&similarFlatArray ([$zinc->tget($rect2,'translation')],
+                      [-150,   80],
+                      [1,      1 ]),
+   "tget 'translation' of rect2");
+
+($xScale, $yScale) = $zinc->tget($rect2, 'scale');
+#print "scale: $xScale, $yScale\n";
+ok(&similarFlatArray ([$zinc->tget($rect2,'scale')],
+                      [2,     3,   ],
+                      [0.001, 0.001]),
+   "tget 'scale' of rect2");
+
+($m00, $m01, $m10, $m11, $m20, $m21) = $zinc->tget($rect2, 'rotation');
+ok(&similarFlatArray ([$zinc->tget($rect2,'rotation')],
+                      [3.14159/2],
+                      [0.001    ]),
+   "tget 'rotation' of rect2");
+
+#$zinc->skew($rect2, 10,0);
+ok(&similarFlatArray ([$zinc->tget($rect2,'skew')],
+                      [0],
+                      [0.001    ]),
+   "tget 'skew' of rect2");
+
+
+sub similarPoints {
+  my ($ref1, $ref2)= @_;
+  diag ("waiting a reference for \$ref1" . ref ($ref1)), return 0 unless ref ($ref1) eq 'ARRAY';
+  diag ("waiting a reference for \$ref2"), return 0 unless ref ($ref2) eq 'ARRAY';
+
+  my @array1 = @{$ref1};
+  my @array2 = @{$ref2};
+
+  diag ("arrays for \$ref1 and \$ref2 are not of same length"), return 0 
+    unless scalar @array1 == @array2;
+
+  for my $i (0.. $#array1) {
+    my $pt1 = $array1[$i];
+    my $pt2 = $array2[$i];
+    diag ("waiting a reference to a point in elt $i \$ref1"), return 0 
+      unless ref $pt1 eq 'ARRAY';
+    my (@pt1) = @{$pt1};
+    diag ("waiting a reference to a point (x,y) in elt $i \$ref1"), return 0 
+      unless scalar @pt1 == 2 and &numerical($pt1[0]) and &numerical($pt1[1]) ;
+    
+    diag ("waiting a reference to a point in elt $i \$ref1"), return 0 
+      unless ref $pt2 eq 'ARRAY';
+    my (@pt2) = @{$pt2};
+    diag ("waiting a reference to a point (x,y) in elt $i \$ref2"), return 0 
+      unless scalar @pt2 == 2 and &numerical($pt2[0]) and &numerical($pt2[1]) ;
+    
+    diag ("delta > 0.001 between x of pt$i"), return 0 if abs($pt1[0]-$pt2[0]) > 0.001;
+    diag ("delta > 0.001 between y of pt$i"), return 0 if abs($pt1[1]-$pt2[1]) > 0.001;
+  }
+  return 1;
+}
+
+sub similarFlatArray {
+  my ($ref1, $ref2, $deltaref)= @_;
+  diag ("waiting a reference for \$ref1"), return 0 unless ref ($ref1) eq 'ARRAY';
+  diag ("waiting a reference for \$ref2"), return 0 unless ref ($ref2) eq 'ARRAY';
+  diag ("waiting a reference for \$deltaref"), return 0 unless ref ($deltaref) eq 'ARRAY';
+  
+  my @array1 = @{$ref1};
+  my @array2 = @{$ref2};
+  my @deltaarray = @{$deltaref};
+  diag ("arrays for \$ref1 and \$ref2 and \$deltaref are not of same length,".$#array1.",".$#array2.",".$#deltaarray), return 0 
+    unless ($#array1 == $#array2) and ($#array2 == $#deltaarray);
+  for my $i (0.. $#array1) {
+    my $a = $array1[$i];
+    my $b = $array2[$i];
+    my $delta = $deltaarray[$i];
+    diag ("waiting a numeric value for elt $i of \$ref1"), return 0 
+      unless &numerical($a);
+    diag ("waiting a numeric value for elt $i of \$ref2"), return 0 
+      unless &numerical($b);
+    diag ("waiting a numeric value for elt $i of \$deltaref"), return 0 
+      unless &numerical($delta);
+        
+    diag ("delta > $delta between elt $i of \$ref1 ($a) and \$ref2 ($b)"), return 0 
+      if (abs($a-$b) > $delta) ;
+  }
+  return 1;
+}
+
+
+sub numerical {
+  my ($v) = @_;
+  return 0 unless defined $v;
+  ### this really works!!
+  return $v eq $v*1;
+  }
+
 
 diag("############## transformations test");