diff options
Diffstat (limited to 'Perl')
-rw-r--r-- | Perl/Zinc/Debug.pm | 24 |
1 files changed, 19 insertions, 5 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 81bd6bf..cb84c54 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -507,7 +507,7 @@ sub buildCode { push(@code, 'use Tk::Zinc;'); push(@code, 'my $mw = MainWindow->new();'); push(@code, 'my $zinc = $mw->Zinc(-render => '.$zinc->cget(-render). - ')->pack(-expand => 1, -fill => both);'); + ')->pack(-expand => 1, -fill => "both");'); push(@code, '# hash %items : keys are original items ID, values are built items ID'); push(@code, 'my %items;'); push(@code, ''); @@ -525,7 +525,7 @@ sub buildCode { } else { push(@code, &buildItem($zinc, $item, 1)); } - push(@code, 'MainLoop;'); + push(@code, &buildend); my $file = $zinc->getSaveFile(-filetypes => [['Perl Files', '.pl'], ['All Files', '*']], @@ -543,6 +543,18 @@ sub buildCode { } # end buildCode +sub buildend { + + my @code; + push(@code, 'for (keys(%items)) {'); + push(@code, ' $zinc->addtag(\'orig\'.$_, "withtag", $items{$_});'); + push(@code, '}'); + push(@code, 'MainLoop;'); + return @code + +} # end buildend + + # build a node of tree (corresponding to a TkZinc group item) sub buildGroup { @@ -581,7 +593,7 @@ sub buildItem { my $numfields = 0; my $numcontours = 0; # type group and initargs - my $initstring = '$items{'.$item.'}=$zinc->add('.$type.', '.$group.', '; + my $initstring = '$items{'.$item.'}=$zinc->add("'.$type.'", '.$group.', '; if ($type eq 'tabular' or $type eq 'track' or $type eq 'waypoint') { $numfields = $zinc->itemcget($item, -numfields); $initstring .= $numfields.' ,'; @@ -683,7 +695,7 @@ sub buildOptions { push(@code, " ".$option.' => "'.$value.'", '); } elsif (ref($value) eq 'ARRAY') { - push(@code, " ".$option." => [qw(".join(',', @$value).")], "); + push(@code, " ".$option." => [qw/".join(' ', @$value)."/], "); } else { push(@code, " ".$option." => '".$value."', "); @@ -2301,7 +2313,9 @@ sub balloonhelp { "is selected, draw rectangle using \n". "left mouse button. "); $b->attach($button{tree}, -balloonmsg => - "Display the items hierarchy."); + "Display the items hierarchy. Can\n". + "build perl code corresponding to\n". + "a specific branch. "); $b->attach($button{item}, -balloonmsg => "Locate an item in the items tree. \n". "When this mode is on, select in \n". |