From dd9b1712d84f89bddd96770f0b294238c49f82a8 Mon Sep 17 00:00:00 2001 From: etienne Date: Thu, 7 Oct 2004 12:49:44 +0000 Subject: Windows management. Added the -expandTagsField options to configure the tags display in attributes window. Code cleanup. --- Perl/Zinc/Debug.pm | 479 +++++++++++++++++++---------------------------------- 1 file changed, 175 insertions(+), 304 deletions(-) (limited to 'Perl') diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 711faa2..57f5923 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -29,8 +29,8 @@ use Tk::Balloon; @EXPORT_OK = qw(finditems snapshot tree init); my ($itemstyle, $groupstyle, $step); -my ($result_tl, $result_fm, $search_tl, $helptree_tl, $coords_tl, $transfo_tl, - $helpcoords_tl, $searchtree_tl, $tree_tl, $alloptions_tl, $tree); +my (%result_tl, $result_fm, $search_tl, $helptree_tl, %coords_tl, %transfo_tl, + $helpcoords_tl, $searchtree_tl, $tree_tl, %alloptions_tl, $tree); my $showitemflag; my ($x0, $y0); my ($help_print, $imagecounter, $saving) = (0, 0, 0); @@ -69,7 +69,7 @@ BEGIN { require Getopt::Long; Getopt::Long::Configure('pass_through'); Getopt::Long::GetOptions(\%cmdoptions, 'optionsToDisplay=s', 'optionsFormat=s', - 'snapshotBasename=s'); + 'snapshotBasename=s', 'expandTagsField=i'); # save current Tk::Zinc::InitObject function; it will be invoked in # overloaded one (see below) use Tk; @@ -107,7 +107,7 @@ sub init { for my $opt (keys(%options)) { carp "in Tk::Zinc::Debug initialisation function, unknown option $opt\n" unless $opt eq '-optionsToDisplay' or $opt eq '-optionsFormat' - or $opt eq '-snapshotBasename' ; + or $opt eq '-snapshotBasename' or $opt eq '-expandTagsField' ; } $cmdoptions{optionsToDisplay} = $options{-optionsToDisplay} if not defined $cmdoptions{optionsToDisplay} and @@ -118,6 +118,9 @@ sub init { $cmdoptions{snapshotBasename} = $options{-snapshotBasename} if not defined $cmdoptions{snapshotBasename} and defined $options{-snapshotBasename}; + $cmdoptions{expandTagsField} = $options{-expandTagsField} if + not defined $cmdoptions{expandTagsField} and + defined $options{-expandTagsField}; &newinstance($zinc); return if Tk::Exists($control_tl); @@ -172,7 +175,8 @@ sub init { 'sienna']); $selectedzinc->Tk::bind("", \&resizerectangle); $selectedzinc->Tk::bind("", - [\&stoprectangle, 'enclosed', 'Enclosed search']); + [\&stoprectangle, 'enclosed', + 'Items enclosed in rectangle']); }; $off_command{findenclosed} = sub { $button{findenclosed}->{Value} = 0; @@ -183,11 +187,12 @@ sub init { $on_command{findoverlap} = sub { &savebindings($selectedzinc); $button{findoverlap}->{Value} = 1; - $selectedzinc->Tk::bind("", [\&startrectangle, 'mixed', 'Overlap', - 'sienna']); + $selectedzinc->Tk::bind("", [\&startrectangle, 'mixed', + 'Overlap', 'sienna']); $selectedzinc->Tk::bind("", \&resizerectangle); $selectedzinc->Tk::bind("", - [\&stoprectangle, 'overlapping', 'Overlap search']); + [\&stoprectangle, 'overlapping', + 'Items which overlap rectangle']); }; $off_command{findoverlap} = sub { $button{findoverlap}->{Value} = 0; @@ -307,7 +312,7 @@ sub init { $button{close}->configure(-command => sub { $button{close}->update; - $control_tl->withdraw(); + &Tk::Zinc::Debug::iconify; &restorebindings($selectedzinc); for my $name (@but) { &{$off_command{$name}}; @@ -373,7 +378,7 @@ sub showtree { my @optionstodisplay = split(/,/, $optionstodisplay); $WARNING = 1; &hidetree(); - $tree_tl = $zinc->Toplevel; + $tree_tl = $control_tl->Toplevel; $tree_tl->minsize(280, 200); $tree_tl->title("Zinc Items Tree"); $tree = $tree_tl->Scrolled('Tree', @@ -388,7 +393,7 @@ sub showtree { -command => sub { my $path = shift; my $item = (split(/\./, $path))[-1]; - &showresult("", $zinc, $item); + &showresult("Attributes of item $item", $zinc, $item); $zinc->after(100, sub { &undohighlightitem(undef, $zinc)}); }, @@ -447,7 +452,7 @@ sub showtree { my $path = $tree->selectionGet; $path = 1 unless $path; my $item = (split(/\./, $path))[-1]; - &showresult("", $zinc, $item); + &showresult("Attributes of item $item", $zinc, $item); }, )->pack(-side => 'left', -pady => 10, -padx => 10, -fill => 'both'); @@ -465,6 +470,7 @@ sub showtree { -fill => 'both', -expand => 1, ); + } # end showtree @@ -512,7 +518,8 @@ sub searchInTree { my $zinc = shift; $searchtree_tl->destroy if $searchtree_tl and Tk::Exists($searchtree_tl); - $searchtree_tl = $zinc->Toplevel; + $searchtree_tl = $tree_tl->Toplevel; + $searchtree_tl->transient($tree_tl); $searchtree_tl->title("Find string in tree"); my $fm = $searchtree_tl->Frame->pack(-side => 'top'); $fm->Label(-text => "Find : ", @@ -1009,7 +1016,7 @@ sub searchentry { my $zinc = shift; $search_tl->destroy if $search_tl and Tk::Exists($search_tl); - $search_tl = $zinc->Toplevel; + $search_tl = $control_tl->Toplevel; $search_tl->title("Specific search"); my $fm = $search_tl->Frame->pack(-side => 'top'); $fm->Label(-text => "Item TagOrId : ", @@ -1030,9 +1037,15 @@ sub searchentry { $searchEntryValue{$zinc} = $entry->get(); my @items = $zinc->find('withtag', $searchEntryValue{$zinc}); if (@items) { - &showresult("Search with TagOrId $searchEntryValue{$zinc}", $zinc, @items); + my $label; + if ($searchEntryValue{$zinc} =~ /^\d/) { + $label = "Attributes of item $searchEntryValue{$zinc}"; + } else { + $label = "Attributes of item(s) with tag $searchEntryValue{$zinc}" + } + &showresult($label, $zinc, @items); } else { - $status->configure(-text => "No such TagOrId ($searchEntryValue{$zinc})"); + $status->configure(-text => "No such tagOrId ($searchEntryValue{$zinc})"); } }]); @@ -1047,23 +1060,25 @@ sub searchentry { sub showtransfoparams { - my ($zinc, $item) = @_; + my ($label, $zinc, $item) = @_; my @m = $zinc->tget($item); my ($xt, $yt, $xsc, $ysc, $a, $xsk) = $zinc->tget($item, 'all'); - $transfo_tl->destroy if Tk::Exists($transfo_tl); - $transfo_tl = $zinc->Toplevel(); + $transfo_tl{$item}->destroy if Tk::Exists($transfo_tl{$item}); + $transfo_tl{$item} = $control_tl->Toplevel(); + $transfo_tl{$item}->transient($result_tl{$label}) + if Tk::Exists($result_tl{$label}); my $title = "Transformations of item $item"; - $transfo_tl->title($title); + $transfo_tl{$item}->title($title); my $r = 0; my $c = 0; - my $fm1 = $transfo_tl->Frame()->pack(-side => 'top', - -padx => 20, - -pady => 20, - ); - my $fm2 = $transfo_tl->Frame()->pack(-side => 'top', - -padx => 20, - -pady => 20, - ); + my $fm1 = $transfo_tl{$item}->Frame()->pack(-side => 'top', + -padx => 20, + -pady => 20, + ); + my $fm2 = $transfo_tl{$item}->Frame()->pack(-side => 'top', + -padx => 20, + -pady => 20, + ); # translate params $fm1->Label(-text => 'translate', -relief => 'ridge') ->grid(-row => $r, -column => $c++, @@ -1110,7 +1125,8 @@ sub showtransfoparams { $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); $fm2->Button(-text => 'Close', -command => sub { - $transfo_tl->destroy; + $transfo_tl{$item}->destroy; + delete $transfo_tl{$item}; })->pack(-side => 'left', -padx => 40, -pady => 10); @@ -1130,33 +1146,35 @@ sub showresult { my ($label, $zinc, @items) = @_; # toplevel (re-)creation - $result_tl->destroy if Tk::Exists($result_tl); - $result_tl = $zinc->Toplevel(); - my $title = "Zinc Debug"; + $result_tl{$label}->destroy if Tk::Exists($result_tl{$label}); + $result_tl{$label} = $control_tl->Toplevel(); + my $title = "TK::Zinc Debug"; $title .= " - $label" if $label; - $result_tl->title($title); - $result_tl->geometry('+10+20'); - my $fm = $result_tl->Frame()->pack(-side => 'bottom', + $result_tl{$label}->title($title); + $result_tl{$label}->geometry('+10+20'); + $control_tl->raise; + my $fm = $result_tl{$label}->Frame()->pack(-side => 'bottom', ); $fm->Button(-text => 'Help', -command => [\&showHelpAboutAttributes, $zinc] )->pack(-side => 'left', -padx => 40, -pady => 10); $fm->Button(-text => 'Close', -command => sub { - $result_tl->destroy; + $result_tl{$label}->destroy; + delete $result_tl{$label}; $zinc->remove("zincdebugrectangle", "zincdebuglabel"); })->pack(-side => 'left', -padx => 40, -pady => 10); # scrolled pane creation - $result_fm = $result_tl->Scrolled('Pane', - -scrollbars => 'osoe', - -height => 200, - -width => 1024, - ); + $result_fm = $result_tl{$label}->Scrolled('Pane', + -scrollbars => 'osoe', + -height => 200, + -width => 1024, + ); my $fm2 = $result_fm->Frame->pack; # attributes display - &showattributes($zinc, $fm2, \@items); + &showattributes($zinc, $fm2, $label, \@items); $result_fm->update; $fm2->update; my $width = $fm2->width + 10; @@ -1167,51 +1185,30 @@ sub showresult { -fill => 'both', -expand => 1, ); + } # end showresult # display table containing additionnal options/values sub showalloptions { - my ($zinc, $item, $fmp) = @_; - $alloptions_tl->destroy if Tk::Exists($alloptions_tl); - $alloptions_tl = $zinc->Toplevel(); - my $tl = $alloptions_tl; + my ($label, $zinc, $item, $fmp) = @_; + $alloptions_tl{$item}->destroy if Tk::Exists($alloptions_tl{$item}); + $alloptions_tl{$item} = $control_tl->Toplevel(); + $alloptions_tl{$item}->transient($result_tl{$label}) + if Tk::Exists($result_tl{$label}); + my $tl = $alloptions_tl{$item}; my $title = "All options of item $item"; $tl->title($title); $tl->geometry('-10+0'); - # header - #---------------- - my $fm_top = $tl->Frame()->pack(-fill => 'x', -expand => 0, - -padx => 10, -pady => 10, - -ipadx => 10, - ); - # show item - my $btn = $fm_top->Button(-height => 2, - -text => 'Show Item', - )->pack(-side => 'left', -fill => 'x', -expand => 1); - $btn->bind('<1>', [\&highlightitem, $zinc, $item, 0]); - $btn->bind('<2>', [\&highlightitem, $zinc, $item, 1]); - $btn->bind('<3>', [\&highlightitem, $zinc, $item, 2]); - # bounding box - $btn = $fm_top->Button(-height => 2, - -text => 'Bounding Box', - )->pack(-side => 'left', -fill => 'x', -expand => 1); - $btn->bind("<1>", [\&showbbox, $zinc, $item]); - $btn->bind("", [\&hidebbox, $zinc]); - # transformations - $btn = $fm_top->Button(-height => 2, - -text => "treset") - ->pack(-side => 'left', -fill => 'x', -expand => 1); - $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]); - $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]); - $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); - # footer #---------------- $tl->Button(-text => 'Close', - -command => sub {$tl->destroy})->pack(-side => 'bottom'); + -command => sub { + $alloptions_tl{$item}->destroy; + delete $alloptions_tl{$item}; + })->pack(-side => 'bottom'); # option scrolled frame #----------------------- my $fm = $tl->Scrolled('Pane', @@ -1222,22 +1219,33 @@ sub showalloptions { -expand => 1, -fill => 'both'); - my $bgcolor = 'ivory'; + my $bgcolor = 'ivory'; + my $i = 1; + $fm->Label(-text => $title, -background => $bgcolor, + -fg => 'sienna', -relief => 'ridge') + ->grid(-row => $i++, -column => 1, -ipady => 5, -ipadx => 5, + -columnspan => 2, -sticky => 'nswe') if $label; $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => 2, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => 2, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i++, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); my @options = $zinc->itemconfigure($item); - my $i = 3; for my $elem (@options) { my ($option, $type, $value) = (@$elem)[0,1,4]; $fm->Label(-text => $option, -relief => 'ridge') ->grid(-row => $i, -column => 1, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); - &entryoption($fm, $item, $zinc, $option, undef, 50, 25) - ->grid(-row => $i, -column => 2, -ipady => 5, - -ipadx => 5, -sticky => 'nswe'); + if ($option eq '-tags') { + &entryoption($fm, $item, $zinc, $option, + join("\n", @$value), 30, 30, scalar @$value) + ->grid(-row => $i, -column => 2, -ipady => 5, + -ipadx => 5, -sticky => 'nswe'); + } else { + &entryoption($fm, $item, $zinc, $option, undef, 50, 25) + ->grid(-row => $i, -column => 2, -ipady => 5, + -ipadx => 5, -sticky => 'nswe'); + } $i++; } @@ -1247,8 +1255,8 @@ sub showalloptions { # display device coords table sub showdevicecoords { - my ($zinc, $item) = @_; - &showcoords($zinc, $item, 1); + my ($label, $zinc, $item) = @_; + &showcoords($label, $zinc, $item, 1); } # end showdevicecoords @@ -1256,31 +1264,32 @@ sub showdevicecoords { # display coords table sub showcoords { - my ($zinc, $item, $deviceflag) = @_; + my ($label, $zinc, $item, $deviceflag) = @_; my $bgcolor = 'ivory'; my $bgcolor2 = 'gray75'; - $coords_tl->destroy if Tk::Exists($coords_tl) and not $deviceflag; - - $coords_tl = $zinc->Toplevel(); + $coords_tl{$item}->destroy if Tk::Exists($coords_tl{$item}) and not $deviceflag; + $coords_tl{$item} = $control_tl->Toplevel(); + $coords_tl{$item}->transient($result_tl{$label}) if Tk::Exists($result_tl{$label}); my $title = "Zinc Debug"; if ($deviceflag) { $title .= " - Coords of item $item"; } else { $title .= " - Device coords of item $item"; } - $coords_tl->title($title); - $coords_tl->geometry('+10+20'); - my $coords_fm0 = $coords_tl->Frame()->pack(-side => 'bottom'); + $coords_tl{$item}->title($title); + $coords_tl{$item}->geometry('+10+20'); + my $coords_fm0 = $coords_tl{$item}->Frame()->pack(-side => 'bottom'); $coords_fm0->Button(-text => 'Help', -command => [\&showHelpAboutCoords, $zinc] )->pack(-side => 'left', -padx => 40, -pady => 10); $coords_fm0->Button(-text => 'Close', -command => sub { &hidecontour($zinc); - $coords_tl->destroy; + $coords_tl{$item}->destroy; + delete $coords_tl{$item}; })->pack(-side => 'left', -padx => 40, -pady => 10); # scrolled pane creation - my $coords_fm = $coords_tl->Scrolled('Pane', + my $coords_fm = $coords_tl{$item}->Scrolled('Pane', -scrollbars => 'oe', -height => 200, )->pack(-padx => 10, -pady => 10, @@ -1390,217 +1399,30 @@ sub showcoords { } # end showcoords -# display in a toplevel group's attributes -sub showgroupattributes { - - my ($zinc, $item) = @_; - my $tl = $zinc->Toplevel; - my $title = "About group $item"; - $tl->title($title); - - # header - #----------- - - my $fm_top = $tl->Frame()->pack(-fill => 'x', -expand => 0, - -padx => 10, -pady => 10, - -ipadx => 10, - ); - # content - $fm_top->Button(-command => [\&showgroupcontent, $zinc, $item], - -height => 2, - -text => 'Content', - )->pack(-side => 'left', -fill => 'both', -expand => 1); - # bounding box - my $btn = $fm_top->Button(-height => 2, - -text => 'Bounding Box', - )->pack(-side => 'left', -fill => 'both', -expand => 1); - $btn->bind("<1>", [\&showbbox, $zinc, $item]); - $btn->bind("", [\&hidebbox, $zinc]); - - # transformations - my $trbtn = $fm_top->Button(-height => 2, - -text => "treset") - ->pack(-side => 'left', -fill => 'both', -expand => 1); - if ($item == 1) { - $trbtn->configure(-state => 'disabled'); - } else { - $trbtn->bind('<1>', [\&showtransfo, $zinc, $item, 0]); - $trbtn->bind('<2>', [\&showtransfo, $zinc, $item, 1]); - $trbtn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); - } - - # parent group - my $gr = $zinc->group($item); - my $bpg = $fm_top->Button(-command => [\&showgroupattributes, $zinc, $gr], - -height => 2, - -text => "Parent group [$gr]", - )->pack(-side => 'left', -fill => 'both', -expand => 1); - $bpg->configure(-state => 'disabled') if $item == 1; - - - # footer - #----------- - $tl->Button(-text => 'Close', - -command => sub {$tl->destroy})->pack(-side => 'bottom'); - - # coords and options scrolled frame - #---------------------------------- - my $fm = $tl->Scrolled('Pane', - -scrollbars => 'oe', - -height => 400, - )->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -expand => 1, - -fill => 'both'); - - my $r = 1; - my $bgcolor = 'ivory'; - # coords - $fm->Label(-text => 'Coordinates', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $r++, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe', - -columnspan => 2); # coords - $fm->Label(-text => 'Coords', -relief => 'ridge') - ->grid(-row => $r, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - my @coords = $zinc->coords($item); - my $coords; - if (@coords == 2) { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - $coords = "($x0, $y0)"; - } elsif (@coords == 4) { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $x1 = int($coords[2]); - my $y1 = int($coords[3]); - $coords = "($x0, $y0, $x1, $y1)"; - print "we should not go through this case (1)!\n"; - } else { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $xn = int($coords[$#coords-1]); - my $yn = int($coords[$#coords]); - my $n = @coords/2 - 1; - $coords = "P0=($x0, $y0), ..., P".$n."=($xn, $yn)"; - print "we should not go through this case (2d)!\n"; - } - $fm->Label(-text => $coords, -relief => 'ridge') - ->grid(-row => $r++, -column => 2, -ipady => 10, -ipadx => 2, -sticky => 'nswe'); - # device coords - $fm->Label(-text => 'Device coords', -relief => 'ridge') - ->grid(-row => $r, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - @coords = $zinc->transform($item, 'device', [@coords]); - if (@coords == 2) { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - $coords = "($x0, $y0)"; - } elsif (@coords == 4) { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $x1 = int($coords[2]); - my $y1 = int($coords[3]); - $coords = "($x0, $y0, $x1, $y1)"; - print "we should not go through this case (3)!\n"; - } else { - my $x0 = int($coords[0]); - my $y0 = int($coords[1]); - my $xn = int($coords[$#coords-1]); - my $yn = int($coords[$#coords]); - my $n = @coords/2 - 1; - $coords = "P0=($x0, $y0), ..., P".$n."=($xn, $yn)"; - print "we should not go through this case (4)!\n"; - } - $fm->Label(-text => $coords, -relief => 'ridge') - ->grid(-row => $r++, -column => 2, -ipady => 10, -ipadx => 2, -sticky => 'nswe'); - - # options - $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $r, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $r++, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - - my @options = $zinc->itemconfigure($item); - for my $elem (@options) { - my ($option, $value) = (@$elem)[0,4]; - $fm->Label(-text => $option, -relief => 'ridge') - ->grid(-row => $r, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - my $w; - if ($option and $option eq '-tags') { - $value = join("\n", @$value); - $w = $fm->Label(-text => $value, -relief => 'ridge'); - } elsif ($option and $option eq '-clip' and $value and $value > 0) { - $value .= " (". $zinc->type($value) .")"; - $w = $fm->Label(-text => $value, -relief => 'ridge'); - } else { - $w = &entryoption($fm, $item, $zinc, $option, undef, 50, 25); - } - $w->grid(-row => $r, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $r++; - } - -} # end showgroupattributes - - -# display in a toplevel the content of a group item -sub showgroupcontent { - - my ($zinc, $group) = @_; - my $tl = $zinc->Toplevel; - - my @items = $zinc->find('withtag', $group."."); - my $title = "Content of group $group"; - $tl->title($title); - my $fm2 = $tl->Frame()->pack(-side => 'bottom', - ); - $fm2->Button(-text => 'Help', - -command => [\&showHelpAboutAttributes, $zinc] - )->pack(-side => 'left', -padx => 40, -pady => 10); - $fm2->Button(-text => 'Close', - -command => sub { - $tl->destroy; - })->pack(-side => 'left', -padx => 40, -pady => 10); - - # coords and options scrolled frame - #---------------------------------- - my $fm = $tl->Scrolled('Pane', - -scrollbars => 'osoe', - -height => 200, - ); - - my $fm2 = $fm->Frame->pack; - &showattributes($zinc, $fm2, [@items]); - $fm2->update; - my $width = $fm2->width + 10; - $width = $screenwidth if $width > $screenwidth; - $fm->configure(-width => $width); - $fm->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -expand => 1, - -fill => 'both'); - -} # end showgroupcontent # display in a grid the values of most important attributes sub showattributes { - my ($zinc, $fm, $items) = @_; + my ($zinc, $fm, $label, $items, $expandTagsFlag) = @_; + $expandTagsFlag = 1; &getsize($zinc); my $bgcolor = 'ivory'; my $i = 1; + $fm->Label(-text => $label, -background => $bgcolor, + -fg => 'sienna', -relief => 'ridge') + ->grid(-row => $i++, -column => 0, -ipady => 0, -ipadx => 5, + -columnspan => 7, -sticky => 'nswe') if $label; + &showbanner($fm, $i++); + $i++; for my $item (@$items) { my $c = 0; my $type = $zinc->type($item); -# # transformations -# my $btn = $fm->Button(-text => 'treset') -# ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); -# $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]); -# $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]); -# $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); # id my $idbtn = $fm->Button(-text => $item, - -foreground => 'red' + -foreground => 'sienna' )->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); $idbtn->bind('<1>', [\&highlightitem, $zinc, $item, 0]); @@ -1608,8 +1430,11 @@ sub showattributes { $idbtn->bind('<3>', [\&highlightitem, $zinc, $item, 2]); # type if ($type eq 'group') { - $fm->Button(-text => $type, - -command => [\&showgroupcontent, $zinc, $item]) + $fm->Button(-text => $type, + -command => sub { + my @items = $zinc->find('withtag', $item."."); + &showresult("Content of group $item", $zinc, @items); + }) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } else { $fm->Label(-text => $type, -relief => 'ridge') @@ -1618,7 +1443,9 @@ sub showattributes { # group my $group = $zinc->group($item); $fm->Button(-text => $group, - -command => [\&showgroupattributes, $zinc, $group]) + -command => [\&showresult, + "Attributes of group $group (parent of $item)", + $zinc, $group]) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); # priority &entryoption($fm, $item, $zinc, -priority) @@ -1631,7 +1458,7 @@ sub showattributes { ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); # other options $fm->Button(-text => 'show', - -command => [\&showalloptions, $zinc, $item, $fm]) + -command => [\&showalloptions, $label, $zinc, $item, $fm]) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); # transformations my $tlabel = 'yes'; @@ -1639,7 +1466,7 @@ sub showattributes { $tlabel = 'no' if ($xt == 0 and $yt == 0 and $xsc == 1 and $ysc == 1 and $a == 0 and $xsk == 0); $fm->Button(-text => $tlabel, - -command => [\&showtransfoparams, $zinc, $item], + -command => [\&showtransfoparams, $label, $zinc, $item], ) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); # coords @@ -1665,7 +1492,7 @@ sub showattributes { } if (@coords > 2) { $fm->Button(-text => $coords, - -command => [\&showcoords, $zinc, $item]) + -command => [\&showcoords, $label, $zinc, $item]) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); } else { $fm->Label(-text => $coords, -relief => 'ridge') @@ -1693,7 +1520,7 @@ sub showattributes { } if (@coords > 2) { $fm->Button(-text => $coords, - -command => [\&showdevicecoords, $zinc, $item]) + -command => [\&showdevicecoords, $label, $zinc, $item]) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); } else { $fm->Label(-text => $coords, -relief => 'ridge') @@ -1717,7 +1544,9 @@ sub showattributes { } # tags my @tags = $zinc->gettags($item); - &entryoption($fm, $item, $zinc, -tags, join("\n", @tags), 30, scalar @tags) + my $height = 2; + $height = scalar @tags if $cmdoptions{expandTagsField}; + &entryoption($fm, $item, $zinc, -tags, join("\n", @tags), 30, 30, $height) ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); $i++; @@ -1764,7 +1593,7 @@ sub showbanner { ->grid(-row => $i, -column => $c++, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label()->grid(-row => 1, -column => $c++, -pady => 10); - + } # end showbanner @@ -2817,11 +2646,7 @@ sub newinstance { my $zinc = shift; return if $instances{$zinc}; - $zinc->toplevel->Tk::bind('', sub { - $button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn}); - $control_tl->deiconify(); - $control_tl->raise(); - }); + $zinc->toplevel->Tk::bind('', \&Tk::Zinc::Debug::deiconify); $instances{$zinc} = 1; push(@instances, $zinc); $zinc->Tk::focus; @@ -2830,6 +2655,45 @@ sub newinstance { } # end newinstance +sub deiconify { + + $button{zn}->destroy() if @instances == 1 and Tk::Exists($button{zn}); + $control_tl->deiconify(); + for (values %result_tl) { + $_->deiconify if Tk::Exists($_); + } + for (values %coords_tl) { + $_->deiconify if Tk::Exists($_); + } + for (values %alloptions_tl) { + $_->deiconify if Tk::Exists($_); + } + $tree_tl->deiconify if Tk::Exists($tree_tl); + $search_tl->deiconify if Tk::Exists($search_tl); + $searchtree_tl->deiconify if Tk::Exists($searchtree_tl); + $control_tl->raise(); + +} # end deiconify + + +sub iconify { + + for (values %result_tl) { + $_->withdraw if Tk::Exists($_); + } + for (values %coords_tl) { + $_->withdraw if Tk::Exists($_); + } + for (values %alloptions_tl) { + $_->withdraw if Tk::Exists($_); + } + $tree_tl->withdraw if Tk::Exists($tree_tl); + $search_tl->withdraw if Tk::Exists($search_tl); + $searchtree_tl->withdraw if Tk::Exists($searchtree_tl); + $control_tl->withdraw(); + +} # end iconify + 1; @@ -2869,7 +2733,7 @@ Scan all items which are enclosed in a rectangular area you have first drawn by =item B display items hierarchy -You can find a particular item's position in the tree and you can highlight items and see their features as described above. You can also generate the perl code corresponding to a selected branch. However there are some limitations : transformations and images can't be reproduced. +You can find a particular item's position in the tree and you can highlight items and see their features as described above. You can also generate the perl code corresponding to a selected branch (but images can't be reproduced). =item B snapshot the application window @@ -2901,12 +2765,17 @@ Used to display some option's values associated to items of the tree. Expected a =item E<32>E<32>E<32>B<-optionsFormat> => row | column -Defines the display format of option's values. Default is 'column'. +Defines the display format of option's values. Default is 'row'. =item E<32>E<32>E<32>B<-snapshotBasename> => string Defines the basename used for the file containing the snaphshot. The filename will be /basename.png Defaulted to 'zincsnapshot'. +=item E<32>E<32>E<32>B<-expandTagsField> => 0 | 1 + +Specifies if the tags field in the attributes window will be expanded to show all the items tags (it should take up a lot of space). In the default case (value is set to 0), only the head of the list is displayed. + + =back @@ -2920,6 +2789,8 @@ Daniel Etienne =head1 HISTORY +Oct 5 2004 : transformations are correctly managed in built code. + Oct 14 2003 : add a control bar, and zoom/translate new functionalities. finditems(), tree(), snapshot() functions become deprecated, initialisation is done using the new init() function. Oct 07 2003 : contours of curves can be displayed and explored. -- cgit v1.1