some tests of the find method with 'overlaped', 'enclosing',

'wittype' and pathtags...

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");