diff options
Diffstat (limited to 'Perl/t')
| -rw-r--r-- | Perl/t/Transformations.t | 174 |
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"); |