diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/t/Bbox.t | 136 |
1 files changed, 136 insertions, 0 deletions
diff --git a/Perl/t/Bbox.t b/Perl/t/Bbox.t new file mode 100644 index 0000000..c2d08cc --- /dev/null +++ b/Perl/t/Bbox.t @@ -0,0 +1,136 @@ +#!/usr/bin/perl -w + +# +# $Id: Bbox.t,v 1.1 2004-05-18 15:39:38 mertz Exp $ +# Author: Christophe Mertz +# + +# testing all the import + +BEGIN { + if (!eval q{ + use Test::More tests => 2; + 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; + use Tk::Font; + 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); +like ($zinc, qr/^Tk::Zinc=HASH/ , "zinc has been created"); + +my $coords = [ [10,10], [40, 40] ]; + + +my $font = $zinc->fontCreate('font20pixels', -size => -20); +my $t = $zinc->add('text', 1, + -font => 'font20pixels', + -alignment => 'center', + #-text => 'text', # an empty text + -position => [30,25], + ); + +ok(&similarFlatArray ([$zinc->bbox($t)], + [30, 25, 30, 25+20+3], + [4, 4, 4, 4], + ), + "bbox of empty text"); + +# print "bbox=(", join(',', $zinc->bbox($t)),")\n"; + +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("############## bbox test"); + + |