diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/t/find.t | 159 |
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"); |