From 2a14c7b0d663c58efabe4c34bde63638cdf7a73c Mon Sep 17 00:00:00 2001 From: mertz Date: Thu, 13 Mar 2003 16:13:53 +0000 Subject: - display of an explanation when the user select a predefined pathtag - groups title and frames are now correctly highlighted --- Perl/demos/Tk/demos/zinc_lib/path_tags.pl | 115 ++++++++++++++++++++++-------- 1 file changed, 86 insertions(+), 29 deletions(-) (limited to 'Perl/demos/Tk') diff --git a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl index f9d81fa..ad1d7a8 100644 --- a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl +++ b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl @@ -47,7 +47,7 @@ $text->pack(-expand => 'yes', -fill => 'both'); $text->insert('0.0', 'This represents a group hierarchy: - - groups are represented by a rectangle and a Title. + - 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'); @@ -77,23 +77,57 @@ 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, + -text => '...', + -justify => 'left', +# -anchor => 'w', + -wraplength => '16c', + )->pack(-side => 'left'); + + @pl = qw/-side top -pady 2 -anchor w/; -foreach my $p qw(top .top .top. .top* .top*cca .5.) { - $left->Radiobutton(-text => "$p", +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 => \&displayPathtag, + -command => sub { &displayPathtag ($explan)}, -variable => \$pathtag, -relief => 'flat', - -value => $p, + -value => $tag, )->pack(@pl); } -foreach my $p qw(.top*aa .top*aa. .top*aa* .top*aaa .top*aaa. .5*) { - $middle->Radiobutton(-text => "$p", +@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 => \&displayPathtag, + -command => sub { &displayPathtag ($explan)}, -variable => \$pathtag, -relief => 'flat', - -value => $p, + -value => $tag, )->pack(@pl); } @@ -102,27 +136,45 @@ $rtop->Label(-font => "10x20", -relief => 'flat', -text => 'your own tag :', )->pack(-side => 'left'); -$rtop->Entry(-font => "10x20", -width => 15)->pack(-side => 'left') - ->bind('', sub {$pathtag = $_[0]->get(); &displayPathtag}); - - -foreach my $p qw(.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .other_top*aa* .5*ca*) { - $rbot_left->Radiobutton(-text => "$p", +$rtop->Entry(-font => "10x20", -width => 15) + ->pack(-side => 'left')->bind('', 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 => \&displayPathtag, + -command => sub { &displayPathtag ($explan)}, -variable => \$pathtag, -relief => 'flat', - -value => $p, + -value => $tag, )->pack(@pl); } -foreach my $p (qw(*aa*aaaa *aaa ) , "aa || ca", qw( none all) ) { - $rbot_right->Radiobutton(-text => "$p", +@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 => $p, + -value => $tag, )->pack(@pl); } @@ -244,9 +296,12 @@ sub extractTextAndFrames { ## 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"; +# print "selected: @tags\n"; + $explan_txt->configure(-text => $explanation ? "$explanation\n" : ""); + # print "selected= "; # foreach (@selected) { print $_, " ", $zinc->type($_), " ", # join (",",$zinc->gettags($_)), " / ";} @@ -269,15 +324,17 @@ sub displayPathtag { $zinc->itemconfigure($item, -linecolor => "black"); } elsif ($type eq 'group') { my $tag = ($zinc->gettags($item))[0]; - my $grandFather = ($zinc->find('ancestors',$item))[1]; - if (defined $grandFather) { - ## has, there is 2 // hierachy, we must refine the tag used - ## to restrict to the proper hierarchy - $zinc->itemconfigure("*$grandFather*frame_$tag", -linecolor => "black"); - $zinc->itemconfigure("*$grandFather*title_$tag", -color => "black"); + ## 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 => "black"); + $zinc->itemconfigure(".top*title_$tag", -color => "black"); + } elsif ($zinc->find('ancestors',$item,'other_top')) { + $zinc->itemconfigure(".other_top*frame_$tag", -linecolor => "black"); + $zinc->itemconfigure(".other_top*title_$tag", -color => "black"); } else { - ## when a group as no grandfather it can only be top or other_top - ## as their tags are non-ambiguous, no need to refine! $zinc->itemconfigure("frame_$tag", -linecolor => "black"); $zinc->itemconfigure("title_$tag", -color => "black"); } -- cgit v1.1