version qui fonctionne... il ne reste plus qu'� la rendre graphique

et � l'int�grer � zinc-demos!

1 files changed, 104 insertions, 18 deletions

diff --git a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
index 2325594..6d68717 100644
--- a/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
+++ b/Perl/demos/Tk/demos/zinc_lib/path_tags.pl
@@ -14,8 +14,8 @@ use strict;
 ## (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
-#          |         |          |
+#  $gr_top --- $gr_a --- $gr_aa --- $gr_aaa --- $gr_aaaa --- $i_aaaaa
+#          |         |          |           |-- $i_aaab  |-- $i_aaaab
 #          |         |          --- $i_aab
 #          |         |-- $i_ab
 #          |         |
@@ -31,14 +31,36 @@ my $hierarchy = '
 #                    ---$gr_cc --- $i_cca
 #                              |
 #                              --- $i_ccb
+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  = ( "gr_top" => [ 'gr_top' ],
-		  ".gr_top" => [ 'gr_a' , 'i_b', 'gr_c' ],
-		  );
+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 $mw = MainWindow->new();
@@ -46,28 +68,92 @@ 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']);
+&create_subhierarchy ($gr_top);
+
+# parallel hierarchy
+my $other_top = $zinc ->add('group', 1, -tags => ['_other_top']);
+&create_subhierarchy ($other_top);
+
+
+sub create_subhierarchy {
+    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']);
+    
+    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']);
+    
+    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']);
+    
+    my $i_aca = $zinc->add('group', $gr_ac, -tags => ['_aca']);
+    my $i_acb = $zinc->add('text',  $gr_ac, -tags => ['_acb', 'text']);
+    
+    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']);
+    
+    my $i_caa = $zinc->add('text',  $gr_ca, -tags => ['_caa', 'text']);
+    my $i_cab = $zinc->add('text',  $gr_ca, -tags => ['_cab', 'text']);
+
+    my $i_cca = $zinc->add('text',  $gr_cc, -tags => ['_cca', 'text']);
+    my $i_ccb = $zinc->add('text',  $gr_cc, -tags => ['_ccb', 'text']);
+}
 
-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 @predicted_result = sort @{shift @addressee};
     my @result = $zinc->find('withtag', $pathtag);
 
-    print "for pathtag $pathtag   predicted= ", join (',',@predicted_result), "\nobserved= ", join (',', @result), "\n";
+    my @result_tags = &items2tags (@result);
+
+    if (&equiv (\@predicted_result , \@result_tags)) {
+	print "Path tags $pathtag returns : ", join (' ', @result_tags), "\n";
+    }
+    else {
+	print "for pathtag $pathtag a Bug?!\n  predicted= ", join (',',@predicted_result), "\n  observed= ", join (',', @result_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;
+	    }
+	}
+	push @selected_tags, $selected_tag;
+    }
+    return sort @selected_tags;
+}
+
+sub equiv {
+    my ($refarray1, $refarray2) = @_;
+    my @array1 = sort @{$refarray1};
+    my @array2 = sort @{$refarray2};
+
+    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;