aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/path_tags.pl73
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;
+