From 7af0e51ec99988007b3eee4d37d27391e3c6e591 Mon Sep 17 00:00:00 2001 From: mertz Date: Mon, 27 May 2002 16:31:16 +0000 Subject: version qui fonctionne... il ne reste plus qu'� la rendre graphique et � l'int�grer � zinc-demos! --- Perl/demos/Tk/demos/zinc_lib/path_tags.pl | 122 +++++++++++++++++++++++++----- 1 file changed, 104 insertions(+), 18 deletions(-) (limited to 'Perl') 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; -- cgit v1.1