aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/t/find.t159
1 files changed, 159 insertions, 0 deletions
diff --git a/Perl/t/find.t b/Perl/t/find.t
new file mode 100644
index 0000000..ad82493
--- /dev/null
+++ b/Perl/t/find.t
@@ -0,0 +1,159 @@
+#!/usr/bin/perl -w
+
+#
+# $Id: find.t,v 1.1 2003-10-16 12:10:03 mertz Exp $
+# Author: Christophe Mertz
+#
+
+# testing find methods
+
+# this script can be used with an optionnal argument, an integer giving
+# the delay in seconds during which the graphic updates will be displayed
+# this is usefull for visual inspection!
+
+BEGIN {
+ if (!eval q{
+ use Test::More qw(no_plan);
+# use Test::More tests => 31;
+ 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{
+ $mw = 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;
+ }
+}
+
+
+$zinc = $mw->Zinc(-render => 0,
+ -width => 400, -height => 400)->pack;
+
+like ($zinc, qr/^Tk::Zinc=HASH/ , "zinc has been created");
+
+
+### creating rectangles:
+$g1 = $zinc->add('group',1, -tags => "gr1");
+$text = $zinc->add('text', $g1, -position => [-100,-100]);
+$g2 = $zinc->add('group',$g1, -tags => "gr2");
+
+$rect11 = $zinc->add('rectangle', $g2, [ 10,10,40,40]);
+$rect12 = $zinc->add('rectangle', $g2, [ 50,10,80,40]);
+$rect13 = $zinc->add('rectangle', $g2, [ 90,10,120,40]);
+$rect21 = $zinc->add('rectangle', $g2, [ 10,50,40,80]);
+$rect22 = $zinc->add('rectangle', $g2, [ 50,50,80,80], -tags => 'middle');
+$rect23 = $zinc->add('rectangle', $g2, [ 90,50,120,80]);
+$rect31 = $zinc->add('rectangle', $g2, [ 10,90,40,120]);
+$rect32 = $zinc->add('rectangle', $g2, [ 50,90,80,120]);
+$rect33 = $zinc->add('rectangle', $g2, [ 90,90,120,120]);
+$zinc->update;
+
+my @list;
+
+@list = $zinc->find('overlapping', 20,20,110,110, $g2);
+&ok (&eq_array (\@list ,
+ [ $rect33, $rect32, $rect31, $rect23, $rect22, $rect21, $rect13, $rect12, $rect11, ]),
+ "find overlapping all rectangles");
+
+@list = $zinc->find('enclosed', 20,20,110,110, $g2);
+&ok (&eq_array (\@list ,
+ [ $rect22 ]),
+ "find enclosed the middle rectangle");
+
+@list = $zinc->find('enclosed', 0,0,110,110, $g2);
+&ok (&eq_array (\@list ,
+ [ $rect22 , $rect21, $rect12, $rect11 ]),
+ "find enclosed the 4 left up rectangles");
+
+@list = $zinc->find('ancestor', $rect33);
+&ok (&eq_array (\@list ,
+ [ $g2 , $g1, 1 ]),
+ "find ancestor of one rectangle");
+
+@list = $zinc->find('withtag', ".gr1.");
+#print "@list\n";
+&ok (&eq_array (\@list ,
+ [ $g2, $text, ]),
+ "find direct descendant of group tagged gr1");
+
+@list = $zinc->find('withtag', ".gr1*");
+#print "@list\n";
+&is_deeply ( [ @list ] ,
+ [ $g2, ($zinc->find('withtag', ".gr1.gr2*"), $text ) ],
+ "find all descendant of group tagged gr1");
+
+&is_deeply ( [ ($zinc->find('withtag', ".gr1.gr2*")) ],
+ [ ($zinc->find('withtag', "*gr2*")) ],
+ "comparing full pathtag and reduced pathtag to a group");
+
+&is_deeply ( [ ($zinc->find('withtag', ".gr1.gr2.middle")) ],
+ [ ($zinc->find('withtag', "*gr2.middle")) ],
+ "comparing full pathtag and reduced pathtag to a rectangle");
+
+&is_deeply ( [ ($zinc->find('withtag', ".gr1.gr2.middle")) ],
+ [ ($zinc->find('withtag', "*middle")) ],
+ "comparing full pathtag and reduced pathtag to a rectangle");
+
+&is_deeply ( [ ($zinc->find('withtag', ".gr1.gr2.middle")) ],
+ [ ($zinc->find('withtag', "middle")) ],
+ "comparing full pathtag and reduced pathtag to a rectangle");
+
+&is_deeply ( [ ($zinc->find('withtype', "group")) ],
+ [ $g1, $g2 ],
+ "find with type 'group'");
+
+&is_deeply ( [ ($zinc->find('withtype', "group", ".$g1.")) ],
+ [ $g2 ],
+ "find with type 'group' starting from g1");
+
+&is_deeply ( [ ($zinc->find('withtype', "group", ".$g1.")) ],
+ [ ($zinc->find('withtype', "group", ".$g1*")) ],
+ "find with type 'group' starting from g1");
+
+&is_deeply ( [ ($zinc->find('withtype', "rectangle")) ],
+ [ $rect33, $rect32, $rect31, $rect23, $rect22, $rect21, $rect13, $rect12, $rect11, ],
+ "find with type 'rectangle'");
+&is_deeply ( [ ($zinc->find('withtype', "rectangle", ".$g1*")) ],
+ [ ($zinc->find('withtype', "rectangle")) ],
+ "find with type 'rectangle' starting from .g1*");
+
+# Tk::MainLoop;
+
+
+
+sub wait {
+ $zinc->update;
+ ok (1, $_[0]);
+
+ my $delay = $ARGV[0];
+ if (defined $delay) {
+ $zinc->update;
+ if ($delay =~ /^\d+$/) {
+ sleep $delay;
+ } else {
+ sleep 1;
+ }
+ }
+
+}
+
+
+
+diag("############## Images test");