diff options
Diffstat (limited to 'Perl')
-rw-r--r-- | Perl/demos/Tk/demos/zinc_lib/path_tags.pl | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl new file mode 100644 index 0000000..2325594 --- /dev/null +++ b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl @@ -0,0 +1,73 @@ +#!/usr/bin/perl -w +# $Id$ +# these simple samples have been developped by C. Mertz mertz@cena.fr + +use Tk; +use Tk::Zinc; +use strict; + +#exit if $Tk::Zinc::VERSION lt "3.2.5b"; + +## this demo demonstrates the use of path tags to adress one or more items +## belonging to ha hierarchy of groups. +## This hierarchy is described just below, $gr_xxx designates a group +## (with a tag _xxx) and $i_yyy designates an non-group item (with a tag _yyy). + +my $hierarchy = ' +# $gr_top --- $gr_a --- $gr_aa --- $i_aaa +# | | | +# | | --- $i_aab +# | |-- $i_ab +# | | +# | ---$gr_ac --- $i_aca +# | | +# |-- $i_b --- $i_acb +# | +# --- $gr_c --- $gr_ca --- $i_caa +# | | +# | --- $i_cab +# |-- $i_cb +# | +# ---$gr_cc --- $i_cca +# | +# --- $i_ccb +'; + +## The following hash table gives for every path tag the expected +## list of items adressed by the path tag. + +my @addressee = ( "gr_top" => [ 'gr_top' ], + ".gr_top" => [ 'gr_a' , 'i_b', 'gr_c' ], + ); + +my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*'; +my $mw = MainWindow->new(); +my $zinc = $mw->Zinc(-width => 1, -height => 1, -borderwidth => 0)->pack; + +# creating the item hierarchy +my $gr_top = $zinc ->add('group', 1, -tags => ['_top']); +my $gr_a = $zinc->add('group', $gr_top, -tags => ['_a']); +my $i_b = $zinc->add('text', $gr_top, -tags => ['_b']); +my $gr_c = $zinc->add('group', $gr_top, -tags => ['_c']); + +my $gr_aa = $zinc->add('group', $gr_a, -tags => ['_aa']); +my $i_ab = $zinc->add('text', $gr_a, -tags => ['_ab']); +my $gr_ac = $zinc->add('group', $gr_a, -tags => ['_ac']); + +my $gr_ca = $zinc->add('group', $gr_c, -tags => ['_ca']); +my $i_cb = $zinc->add('text', $gr_c, -tags => ['_cb']); +my $gr_cc = $zinc->add('group', $gr_c, -tags => ['_cc']); + + +while (@addressee) { + my $pathtag = shift @addressee; + my @predicted_result = @{shift @addressee}; + my @result = $zinc->find('withtag', $pathtag); + + print "for pathtag $pathtag predicted= ", join (',',@predicted_result), "\nobserved= ", join (',', @result), "\n"; +} + +# TO BE COMPLETED XXXX + +MainLoop; + |