aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/t/Bbox.t136
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");
+
+