- display of an explanation when the user select a predefined pathtag

- groups title and frames are now correctly highlighted

1 files changed, 86 insertions, 29 deletions

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('<Key-Return>', 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('<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 => \&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");
 	    }