aboutsummaryrefslogtreecommitdiff
path: root/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl/demos/Tk/demos/zinc_lib/path_tags.pl')
-rw-r--r--Perl/demos/Tk/demos/zinc_lib/path_tags.pl357
1 files changed, 0 insertions, 357 deletions
diff --git a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
deleted file mode 100644
index 30272d8..0000000
--- a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
+++ /dev/null
@@ -1,357 +0,0 @@
-#!/usr/bin/perl -w
-# $Id$
-# this pathtatg demo have been developped by C. Mertz mertz@cena.fr
-# with the help of Daniel Etienne etienne@cena.fr
-
-use vars qw( $VERSION );
-($VERSION) = sprintf("%d.%02d", q$Revision$ =~ /(\d+)\.(\d+)/);
-
-use Tk;
-use Tk::Zinc;
-use strict;
-
-#This demo only works with Tk::Zinc > "3.2.5b";
-
-## this demo demonstrates the use of path tags to address one or more items
-## belonging to a 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).
-
-# gr_top --- gr_a --- gr_aa --- gr_aaa --- gr_aaaa --- i_aaaaa
-# | | | |-- i_aaab |-- i_aaaab
-# | | -- 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 same objects are cloned and put in an other hierarchy where
-#gr_top is replaced by gr_other_top
-
-my $defaultForecolor = "grey80";
-my $selectedColor = "yellow";
-my $mw = MainWindow->new();
-
-###########################################
-# Text zone
-###########################################
-
-my $text = $mw->Text(-relief => 'sunken', -borderwidth => 2,
- -height => 5, -font => "10x20");
-$text->pack(-expand => 'yes', -fill => 'both');
-
-$text->insert('0.0',
-'This represents a group hierarchy:
- - groups are represented by a rectangle and an underlined title.
- - non-group items are represented by a text.
-Select a pathTag or a tag with one of the radio-button
-or experiment your own tags in the input field');
-
-###########################################
-# Zinc creation
-###########################################
-
-my $zinc = $mw->Zinc(-width => 850, -height => 360, -font => "10x20",
- -borderwidth => 0, -backcolor => "black",
- -forecolor => $defaultForecolor,
- )->pack;
-
-###########################################
-# Creation of a bunch of radiobutton and a text input
-###########################################
-
-my $tagsfm = $mw->Frame()->pack();
-my $pathtag;
-
-my @pl = qw/-side left -expand 1 -padx .5c -pady .2c/;
-my $left = $tagsfm->Frame->pack(@pl);
-my $middle = $tagsfm->Frame->pack(@pl);
-my $right = $tagsfm->Frame->pack(@pl);
-my $rtop = $right->Frame->pack(-side => 'top');
-my $rbottom = $right->Frame->pack(-side => 'top');
-my $rbot_left = $rbottom->Frame->pack(-side => 'left');
-my $rbot_right = $rbottom->Frame->pack(-side => 'left');
-
-my $resultfm = $mw->Frame()->pack();
-$resultfm->Label(-font => "10x20",
- -relief => 'flat',
- -text => 'explanation:',
- )->pack(-side => 'left');
-my $explan_txt = $resultfm->Label(-font => "10x20",
- -relief => 'flat',
- -width => 70,
- -height => 3.5,
- -text => '...',
- -justify => 'left',
- -wraplength => '16c',
- )->pack(-side => 'left');
-
-
-@pl = qw/-side top -pady 2 -anchor w/;
-my @tags_explan;
-@tags_explan = ("top" => "a simple tag for the top group",
- ".top" => "all items in the root group with the tag 'top'",
- ".top." => "direct children of a group in the root group with the tag 'top'",
- ".top*" => "descendance of ONE group in the root group with the tag 'top'",
- ".top*cca" => "items with a tag 'cca' in ONE direct group of root group with tag 'top'",
- ".5." => "direct content of THE group with id 5");
-while (@tags_explan) {
- my $tag = shift @tags_explan;
- my $explan = shift @tags_explan;
- $left->Radiobutton(-text => $tag,
- -font => "10x20",
- -command => sub { &displayPathtag ($explan)},
- -variable => \$pathtag,
- -relief => 'flat',
- -value => $tag,
- )->pack(@pl);
-}
-@tags_explan = (".top*aa" => "items with a tag 'aa' in a direct group of root group with tag 'top'",
- ".top*aa." => "direct children of ONE group with a tag 'aa', descending from a direct group of root group with tag 'top'",
- ".top*aa*" => "descendance of ONE group with a tag 'aa', descending from a direct group of root group with tag 'top'",
- ".top.a" => "items with a tag 'a' in a direct group of root group with tag 'top'",
- ".top.a." => "direct children of ONE group with a tag 'a' in a direct group of root group with tag 'top'",
- ".5*" => "descendance of THE group with id 5",
- );
-while (@tags_explan) {
- my $tag = shift @tags_explan;
- my $explan = shift @tags_explan;
- $middle->Radiobutton(-text => $tag,
- -font => "10x20",
- -command => sub { &displayPathtag ($explan)},
- -variable => \$pathtag,
- -relief => 'flat',
- -value => $tag,
- )->pack(@pl);
-}
-
-
-$rtop->Label(-font => "10x20",
- -relief => 'flat',
- -text => 'your own tag :',
- )->pack(-side => 'left');
-$rtop->Entry(-font => "10x20", -width => 15)
- ->pack(-side => 'left')->bind('<Key-Return>', sub {$pathtag = $_[0]->get();
- &displayPathtag("sorry, I am not smart enough to explain your pathTag ;-)")});
-
-
-@tags_explan = (".top*aa*aaa" => "all items with a tag 'aaa' descending from ONE group with a tag 'aa' descending from ONE group with a tag 'top' child of the root group",
- ".top*aa*aaa." => "children of ONE group with a tag 'aaa' descending from ONE group with a tag 'aa' descending from ONE group with a tag 'top' child of the root group",
- ".top*aa*aaa*" => "descendance of ONE group with a tag 'aaa' descending from ONE group with a tag 'aa' descending from ONE group with a tag 'top' child of the root group",
- ".other_top*aa*" => "descendance of ONE group with a tag 'aa' descending from ONE group with a tag 'other_top' child of the root group",
- ".5*ca*" => "descendance of ONE group with a tag 'ca' descending from THE group with id 5",
- );
-while (@tags_explan) {
- my $tag = shift @tags_explan;
- my $explan = shift @tags_explan;
- $rbot_left->Radiobutton(-text => $tag,
- -font => "10x20",
- -command => sub { &displayPathtag ($explan)},
- -variable => \$pathtag,
- -relief => 'flat',
- -value => $tag,
- )->pack(@pl);
-}
-
-@tags_explan = ("*aa*aaaa" => "all items with a tag 'aaaa' descending from a group with a tag 'aa'",
- "*aaa" => "all items with a tag 'aaa'",
- "aa || ca" => "items with tag 'aa' or tag 'ca'",
- "none" => "no items, as none has the tag 'none'",
- "all" => "all items",
- );
-while (@tags_explan) {
- my $tag = shift @tags_explan;
- my $explan = shift @tags_explan;
- $rbot_right->Radiobutton(-text => $tag,
- -font => "10x20",
- -command => sub { &displayPathtag ($explan)},
- -command => \&displayPathtag,
- -variable => \$pathtag,
- -relief => 'flat',
- -value => $tag,
- )->pack(@pl);
-}
-
-# creating the item hierarchy
-$zinc ->add('group', 1, -tags => ['top']);
-&createSubHierarchy ('top');
-
-# creating a parallel hierarchy
-$zinc ->add('group', 1, -tags => ['other_top']);
-&createSubHierarchy ('other_top');
-
-### Here we create the genuine hierarchy of groups and items
-### Later we will create graphical objects to display groups
-sub createSubHierarchy {
- my ($gr) = @_;
- $zinc->add('group', $gr, -tags => ['a']);
- $zinc->add('text', $gr, -tags => ['b', 'text'], -text => 'b',
- -position => [270,150]);
- $zinc->add('group', $gr, -tags => ['c']);
-
- $zinc->add('group', 'a', -tags => ['aa']);
- $zinc->add('text', 'a', -tags => ['ab', 'text'], -text => 'ab'
- , -position => [60,220]);
- $zinc->add('group', 'a', -tags => ['ac']);
-
- $zinc->add('group', 'aa', -tags => ['aaa']);
- $zinc->add('text', 'aa', -tags => ['aab', 'text'], -text => 'aab',
- -position => [90,190]);
- $zinc->add('group', 'aaa', -tags => ['aaaa']);
- $zinc->add('text', 'aaaa', -tags => ['aaaaa', 'text'], -text => 'aaaaa',
- -position => [150,110]);
- $zinc->add('text', 'aaaa', -tags => ['aaaab', 'text'], -text => 'aaaab',
- -position => [150,130]);
- $zinc->add('text', 'aaa', -tags => ['aaab', 'text'], -text => 'aaab',
- -position => [120,160]);
-
- $zinc->add('text', 'ac', -tags => ['aca'], -text => 'aca',
- -position => [90,260]);
- $zinc->add('text', 'ac', -tags => ['acb', 'text'], -text => 'acb',
- -position => [90,290]);
-
- $zinc->add('group', 'c', -tags => ['ca']);
- $zinc->add('text', 'c', -tags => ['cb', 'text'], -text => 'cb',
- -position => [330,160]);
- $zinc->add('group', 'c', -tags => ['cc']);
-
- $zinc->add('text', 'ca', -tags => ['caa', 'text'], -text => 'caa',
- -position => [360,110]);
- $zinc->add('text', 'ca', -tags => ['cab', 'text'], -text => 'cab',
- -position => [360,130]);
-
- $zinc->add('text', 'cc', -tags => ['cca', 'text'], -text => 'cca',
- -position => [360,200]);
- $zinc->add('text', 'cc', -tags => ['ccb', 'text'], -text => 'ccb',
- -position => [360,220]);
-}
-
-## modifying the priority so that all rectangles and text will be visible
-map { $_, $zinc->itemconfigure($_,-priority => 20)} ($zinc->find('withtype', 'text', ".top*"));
-map { $_, $zinc->itemconfigure($_,-priority => 20)} ($zinc->find('withtype', 'text', ".other_top*"));
-map { $_, $zinc->itemconfigure($_,-priority => 20)} ($zinc->find('withtype', 'group', ".top*"));
-map { $_, $zinc->itemconfigure($_,-priority => 20)} ($zinc->find('withtype', 'group', ".other_top*"));
-
-# converts a list of items ids in a list of sorted tags (the first tag of each item)
-sub items2tags {
- my @items = @_;
- my @selected_tags;
- foreach my $item (@items) {
- my @tags = $zinc->itemcget ($item, -tags);
- next if $tags[0] =~ /frame|title/ ; # to remove group titles frame
- push @selected_tags, $tags[0];
- }
- return sort @selected_tags;
-}
-
-### drawing :
-#### a rectangle item for showing the bounding box of each group,
-### a text item for the group name (i.e. its first tag)
-
-## backgrounds used to fill rectangles representing groups
-my @backgrounds = qw(grey25 grey35 grey43 grey50 grey55);
-
-sub drawHierarchy {
- my ($group,$level) = @_;
- my @tags = $zinc->gettags($group);
-# print "level=$level (", $tags[0],")\n";
- foreach my $g ($zinc->find('withtype', 'group', ".$group.")) {
- &drawHierarchy ($g,$level+1);
- }
- my ($x,$y,$x2,$y2) = $zinc->bbox($group);
- $zinc->add('text',$group, -position => [$x-5,$y-4],
- -text => $tags[0], -anchor => "w", -alignment => "left",
- -underlined => 1,
- -priority => 20,
- -tags => ["title_".$tags[0], 'group_title'],
- );
- ($x,$y,$x2,$y2) = $zinc->bbox($group);
- if (defined $x) {
- my $background = $backgrounds[$level];
- $zinc->add('rectangle', $group, [$x+0,$y+5,$x2+5,$y2+2],
- -filled => 1,
- -fillcolor => $background,
- -priority => $level,
- -tags => ["frame_".$tags[0], 'group_frame'],
- );
- } else {
- print "undefined bbox for $group : @tags\n";
- }
-}
-
-### this sub extracts out of groups both text and frame representing
-### each group. This is necessary to avoid unexpected selection of
-### rectangles and titles inside groups
-sub extractTextAndFrames {
- foreach my $group_title ($zinc->find('withtag', 'group_title || group_frame')) {
- my @ancestors = $zinc->find('ancestor',$group_title);
-# print "$group_title, @ancestors\n";
- my $grandFather = $ancestors[1];
- $zinc->chggroup($group_title,$grandFather,1);
- }
-}
-
-## this sub modifies the color/line color of texts and rectangles
-## representing selected items.
-sub displayPathtag {
-# print "var=@_ $pathtag\n";
- my $explanation = shift;
- my @selected = $zinc->find('withtag', $pathtag);
- my @tags = &items2tags(@selected);
-# print "selected: @tags\n";
- $explan_txt->configure(-text => $explanation ? "$explanation\n" : "");
-
- ## unselecting all items
- foreach my $item ($zinc->find('withtype', 'text')) {
- $zinc->itemconfigure($item, -color => $defaultForecolor);
- }
- foreach my $item ($zinc->find('withtype', 'rectangle')) {
- $zinc->itemconfigure($item, -linecolor => $defaultForecolor);
- }
-
- ## highlighting selected items
- foreach my $item (@selected) {
- my $type = $zinc->type($item);
-# print $item, " ", $zinc->type($item), " ", join (",",$zinc->gettags($item)), "\n";
- if ($type eq 'text') {
- $zinc->itemconfigure($item, -color => $selectedColor);
- } elsif ($type eq 'rectangle') {
- $zinc->itemconfigure($item, -linecolor => $selectedColor);
- } elsif ($type eq 'group') {
- my $tag = ($zinc->gettags($item))[0];
- ## as there is 2 // hierachy, we must refine the tag used
- ## to restrict to the proper hierarchy
- ## NB: this is due to differences between the group hierarchy
- ## and the graphical object hierarchy used for this demo
- if ($zinc->find('ancestors',$item,'top')) {
- $zinc->itemconfigure(".top*frame_$tag", -linecolor => $selectedColor);
- $zinc->itemconfigure(".top*title_$tag", -color => $selectedColor);
- } elsif ($zinc->find('ancestors',$item,'other_top')) {
- $zinc->itemconfigure(".other_top*frame_$tag", -linecolor => $selectedColor);
- $zinc->itemconfigure(".other_top*title_$tag", -color => $selectedColor);
- } else {
- $zinc->itemconfigure("frame_$tag", -linecolor => $selectedColor);
- $zinc->itemconfigure("title_$tag", -color => $selectedColor);
- }
- }
- }
-}
-
-&drawHierarchy('top',0);
-&drawHierarchy('other_top',0);
-$zinc->translate('other_top', 400,0);
-&extractTextAndFrames;
-
-
-
-MainLoop;
-
generated by cgit v1.1 at 2024-05-18 17:57:55 +0000