Adding a graphic demo of pathTags

1 files changed, 209 insertions, 92 deletions

diff --git a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
index 6d68717..695335b 100644
--- a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
+++ b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
@@ -11,7 +11,7 @@ use strict;
 ## 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).
+## (with a tag xxx) and $i_yyy designates an non-group item (with a tag yyy).
 
 my $hierarchy = '
 #  $gr_top --- $gr_a --- $gr_aa --- $gr_aaa --- $gr_aaaa --- $i_aaaaa
@@ -35,125 +35,242 @@ the same objects are cloned and put in an other hierarchy where
 $gr_top is replace by $other_top
 ';
 
-## The following hash table gives for every path tag the expected
-## list of items adressed by the path tag.
-
-my @addressee  =
-    ("_top"  => [ qw( _top )],
-     "._top"  => [ qw( _top )],
-     "._top." => [ qw( _a _b _c )],
-     "._top*" => [ qw( _a _aa _aaa _aaaa _aaaaa _aaaab _aaab _aab _ab _ac _aca _acb
-		       _b
-		       _c _ca _caa _cab _cb _cc _cca _ccb)],
-     "._top*_cca" => [ qw( _cca )],
-     "._other_top*_cca" => [ qw( _cca )],
-     "*_cca" => [ qw( _cca _cca )],   # 2 items
-     "*_a*_cca" => [ qw( _cca )],   # 1, 2 or 0 items
-     "._top*_ac"  => [ qw( _ac )],
-     "._top*text" => [ qw( _aaaaa _aaaab _aaab _aab _ab _acb
-		       _b
-		       _caa _cab _cb _cca _ccb)],
-     "._top*_aa" =>  [ qw( _aa )],
-     "._top*_aa." =>  [ qw( _aaa _aab )],
-     "._top*_aa*" =>  [ qw( _aaa _aab _aaaa _aaaaa _aaaab _aaab )],
-     "._top*_aa*_aaa" =>  [ qw( _aaa )],
-     "._top*_aa*_aaa." =>  [ qw( _aaaa _aaab )],  
-     "._top*_aa*_aaa*" =>  [ qw( _aaaa _aaab _aaaaa _aaaab)],
-   );
-
-
-my $defaultfont = '-adobe-helvetica-bold-r-normal-*-120-*-*-*-*-*-*';
+my $defaultForecolor = "sienna";
 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']);
-&create_subhierarchy ($gr_top);
+###########################################
+# 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 a Title.
+  - non-group items are represtend 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 => "white",
+		     -forecolor => $defaultForecolor,
+		     )->pack;
+my $row = $mw->Frame()->pack();
+my @pl = qw/-side left -expand 1 -padx .5c -pady .2c/;
+my $left = $row->Frame->pack(@pl);
+my $middleleft = $row->Frame->pack(@pl);
+my $middleright = $row->Frame->pack(@pl);
+my $right = $row->Frame->pack(@pl);
+
+my $pathtag;
+@pl = qw/-side top -pady 2 -anchor w/;
+foreach my $p qw(top .top .top. .top* .top*cca .5.) {
+    $left->Radiobutton(-text     => "$p",
+		       -font => "10x20",
+		       -command => \&displayPathtag,
+		       -variable => \$pathtag,
+		       -relief   => 'flat',
+		       -value    => $p,
+		       )->pack(@pl);
+}
+foreach my $p qw(.top*aa .top*aa. .top*aa* .top*aaa .top*aaa. .5*) {
+    $middleleft->Radiobutton(-text     => "$p",
+			 -font => "10x20",
+			 -command => \&displayPathtag,
+			 -variable => \$pathtag,
+			 -relief   => 'flat',
+			 -value    => $p,
+			 )->pack(@pl);
+}
+
+foreach my $p qw(.top*aa*aaa .top*aa*aaa. .top*aa*aaa* .other_top*aa* .5*ca*) {
+    $middleright->Radiobutton(-text     => "$p",
+			-font => "10x20",
+			-command => \&displayPathtag,
+			-variable => \$pathtag,
+			-relief   => 'flat',
+			-value    => $p,
+			)->pack(@pl);
+}
+
+foreach my $p (qw(*aa*aaaa *aaa ) , "aa || ca", qw( none all) ) {
+    $right->Radiobutton(-text     => "$p",
+			-font => "10x20",
+			-command => \&displayPathtag,
+			-variable => \$pathtag,
+			-relief   => 'flat',
+			-value    => $p,
+			)->pack(@pl);
+}
 
-# parallel hierarchy
-my $other_top = $zinc ->add('group', 1, -tags => ['_other_top']);
-&create_subhierarchy ($other_top);
 
+# 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');
 
-sub create_subhierarchy {
+sub createSubHierarchy {
     my ($gr) = @_;
-    my $gr_a = $zinc->add('group', $gr, -tags => ['_a']);
-    my $i_b  = $zinc->add('text',  $gr, -tags => ['_b', 'text']);
-    my $gr_c = $zinc->add('group', $gr, -tags => ['_c']);
+    $zinc->add('group', $gr, -tags => ['a']);
+    $zinc->add('text',  $gr, -tags => ['b', 'text'], -text => 'b',
+	       -position => [270,150]);
+    $zinc->add('group', $gr, -tags => ['c']);
     
-    my $gr_aa = $zinc->add('group', $gr_a, -tags => ['_aa']);
-    my $i_ab  = $zinc->add('text',  $gr_a, -tags => ['_ab', 'text']);
-    my $gr_ac = $zinc->add('group', $gr_a, -tags => ['_ac']);
+    $zinc->add('group', 'a', -tags => ['aa']);
+    $zinc->add('text',  'a', -tags => ['ab', 'text'], -text => 'ab'
+	       , -position => [60,220]);
+    $zinc->add('group', 'a', -tags => ['ac']);
     
-    my $gr_aaa = $zinc->add('group', $gr_aa, -tags => ['_aaa']);
-    my $i_aab  = $zinc->add('text',  $gr_aa, -tags => ['_aab', 'text']);
-    my $gr_aaaa = $zinc->add('group',  $gr_aaa, -tags => ['_aaaa']);
-    my $i_aaaaa = $zinc->add('text',  $gr_aaaa, -tags => ['_aaaaa', 'text']);
-    my $i_aaaab = $zinc->add('text',  $gr_aaaa, -tags => ['_aaaab', 'text']);
-    my $i_aaab = $zinc->add('text',  $gr_aaa, -tags => ['_aaab', 'text']);
+    $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]);
     
-    my $i_aca = $zinc->add('group', $gr_ac, -tags => ['_aca']);
-    my $i_acb = $zinc->add('text',  $gr_ac, -tags => ['_acb', 'text']);
+    $zinc->add('text', 'ac', -tags => ['aca'], -text => 'aca',
+	       -position => [90,260]);
+    $zinc->add('text',  'ac', -tags => ['acb', 'text'], -text => 'acb',
+	       -position => [90,290]);
     
-    my $gr_ca = $zinc->add('group', $gr_c, -tags => ['_ca']);
-    my $i_cb  = $zinc->add('text',  $gr_c, -tags => ['_cb', 'text']);
-    my $gr_cc = $zinc->add('group', $gr_c, -tags => ['_cc']);
+    $zinc->add('group', 'c', -tags => ['ca']);
+    $zinc->add('text',  'c', -tags => ['cb', 'text'], -text => 'cb',
+	       -position => [330,160]);
+    $zinc->add('group', 'c', -tags => ['cc']);
     
-    my $i_caa = $zinc->add('text',  $gr_ca, -tags => ['_caa', 'text']);
-    my $i_cab = $zinc->add('text',  $gr_ca, -tags => ['_cab', 'text']);
+    $zinc->add('text',  'ca', -tags => ['caa', 'text'], -text => 'caa',
+	       -position => [360,110]);
+    $zinc->add('text',  'ca', -tags => ['cab', 'text'], -text => 'cab',
+	       -position => [360,130]);
 
-    my $i_cca = $zinc->add('text',  $gr_cc, -tags => ['_cca', 'text']);
-    my $i_ccb = $zinc->add('text',  $gr_cc, -tags => ['_ccb', 'text']);
+    $zinc->add('text',  'cc', -tags => ['cca', 'text'], -text => 'cca',
+	       -position => [360,200]);
+    $zinc->add('text',  'cc', -tags => ['ccb', 'text'], -text => 'ccb',
+	       -position => [360,220]);
 }
 
 
+# convert 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;
+}
 
-while (@addressee) {
-    my $pathtag = shift @addressee;
-    my @predicted_result = sort @{shift @addressee};
-    my @result = $zinc->find('withtag', $pathtag);
+### drawing :
+####   a rectangle for each group, with the group name (i.e. its first tag)
+###    a text for each item which is not a group
 
-    my @result_tags = &items2tags (@result);
+## backgrounds used to fill rectangles representing groups
+my @backgrounds = qw(grey90 grey82 grey75 grey68 grey60 grey52 grey45);
 
-    if (&equiv (\@predicted_result , \@result_tags)) {
-	print "Path tags $pathtag returns : ", join (' ', @result_tags), "\n";
+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);
     }
-    else {
-	print "for pathtag $pathtag a Bug?!\n  predicted= ", join (',',@predicted_result), "\n  observed= ", join (',', @result_tags), "\n";
+    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";
     }
 }
 
-# convert a list of items ids in a list of sorted tags (one tag starting with _ for each item)
-sub items2tags {
-    my @items = @_;
-    my @selected_tags;
-    foreach my $item (@items) {
-	my @tags = $zinc->itemcget ($item, -tags);
-	my $selected_tag = $item; 
-	foreach my $tag (@tags) {
-	    if ($tag =~ /^_\w*/) {
-		$selected_tag = $tag;
-		last;
+## this sub extracts out of groups both text and frame representing each group
+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 @selected = $zinc->find('withtag', $pathtag);
+    my @tags = &items2tags(@selected);
+    print "selected: @tags\n";
+#    print "selected= ";
+#    foreach (@selected) { print $_, " ", $zinc->type($_), " ",
+#			  join (",",$zinc->gettags($_)), " / ";}
+#    print "\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 => "black");
+	} elsif ($type eq 'rectangle') {
+	    $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");
+	    } 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");
 	    }
 	}
-	push @selected_tags, $selected_tag;
     }
-    return sort @selected_tags;
 }
 
-sub equiv {
-    my ($refarray1, $refarray2) = @_;
-    my @array1 = sort @{$refarray1};
-    my @array2 = sort @{$refarray2};
+&drawHierarchy('top',0);
+&drawHierarchy('other_top',0);
+$zinc->translate('other_top', 400,0);
+&extractTextAndFrames;
 
-    return 0 if $#array1 != $#array2;
 
-    for (my $i = 0; $i < $#array1; $i++) {
-	return 0 if ($array1[$i] ne $array2[$i]);
-    }
-    return 1;
-}
-# TO BE COMPLETED XXXX
 
-#MainLoop;
+MainLoop;