From 960cdf29197bc3f5922110cf26627aa9709ac79b Mon Sep 17 00:00:00 2001 From: cvs2svn Date: Fri, 10 Jun 2005 10:29:11 +0000 Subject: This commit was manufactured by cvs2svn to create branch 'bogue40'. --- Perl/t/Transformations.t | 304 ----------------------------------------------- 1 file changed, 304 deletions(-) delete mode 100644 Perl/t/Transformations.t (limited to 'Perl/t/Transformations.t') diff --git a/Perl/t/Transformations.t b/Perl/t/Transformations.t deleted file mode 100644 index e736837..0000000 --- a/Perl/t/Transformations.t +++ /dev/null @@ -1,304 +0,0 @@ -#!/usr/bin/perl -w - -# -# $Id: Transformations.t,v 1.3 2004-04-02 12:03:34 mertz Exp $ -# Author: Christophe Mertz -# - -# testing all the import - -BEGIN { - if (!eval q{ -# use Test::More qw(no_plan); - use Test::More tests => 21; - 1; - }) { - print "# tests only work properly with installed Test::More module\n"; - print "1..1\n"; - print "ok 1\n"; - exit; - } - if (!eval q{ - use Tk::Zinc; - 1; - }) { - print "unable to load Tk::Zinc"; - print "1..1\n"; - print "ok 1\n"; - exit; - } - if (!eval q{ - MainWindow->new(); - 1; - }) { - print "# tests only work properly when it is possible to create a mainwindow in your env\n"; - print "1..1\n"; - print "ok 1\n"; - exit; - } -} - - -$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"); - -my $g = $zinc->add('group',1); -$zinc->scale($g,2,2); -my $rect1 = $zinc->add('rectangle', $g, [10,10,40,40]); - -# todo : add a test for the to-come method to get a transform! - -is_deeply([ $zinc->coords($rect1) ], - [ [10,10], [40, 40] ], - "coords are not modified by the group transform!"); - -is_deeply([ - $zinc->transform(1, $g, [100, 100, 300, 500] ) - ], - [ 50, 50, 150, 250 ], - "transform from window coordinates to group"); - -is_deeply([ - $zinc->transform($g, 1, [$zinc->coords($rect1)] ) - ], - [ [20,20], [80, 80] ], - "transform to window coordinates"); - - -# question suggested by D. Etienne (30 sept 2003): -# is it possible to get the window coordinate of a transformed item? -# the answer is of course yes and it is verified here. -my $rect2 = $zinc->add('rectangle', 1, [10,10,40,40]); - -# applying a transform to the rectangle: -$zinc->scale($rect2, 2,2); - -# todo : add a test for the to-come method to get a transform! - -is_deeply([ $zinc->coords($rect1) ], - [ [10,10], [40, 40] ], - "coords are not modified by the item transform!"); - -is_deeply([ - $zinc->transform(1, $rect2, [100, 100, 300, 500] ) - ], - [ 50, 50, 150, 250 ], - "transform window coordinates with same transform than rect2 "); -is_deeply([ - $zinc->transform($rect2, 1, [$zinc->coords($rect2)] ) - ], - [ [20,20], [80, 80] ], - "transform rect2 coordinates to window coordinates, with group 1"); - -is_deeply([ - $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] ) - ], - [ [20,20], [80, 80] ], - "transform rect2 coordinates to window coordinates with 'device'"); - -$zinc->scale(1, 0.5, 0.5); - -is_deeply([ - $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] ) - ], - [ [10,10], [40, 40] ], - "transform rect2 coordinates to window coordinates with 'device'"); - -# setting the top group transformation to the id, with a translation with tset -$zinc->tset(1, 1,0, 0,1, -20,-10); -is_deeply([ - $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] ) - ], - [ [0,10], [60, 70] ], - "rect2 window coordinates with 'device' after topgroup transfo setting"); - -# restting top group transformation -$zinc->treset(1); -is_deeply([ - $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] ) - ], - [ [20,20], [80, 80] ], - "rect2 window coordinates with 'device' after topgroup treset"); - -# resetting the rect2 trasnformation -$zinc->treset($rect2); -is_deeply([ - $zinc->transform($rect2, 'device', [$zinc->coords($rect2)] ) - ], - [ [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)] ) - ], - [ [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"); - - -- cgit v1.1