From 059cb213a9a7d18f7b74a82d542f6216621f0720 Mon Sep 17 00:00:00 2001 From: etienne Date: Thu, 30 Sep 2004 15:22:20 +0000 Subject: Better management of windows size. Lists of data reformated. New window displaying transformation parameters. --- Perl/Zinc/Debug.pm | 288 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 206 insertions(+), 82 deletions(-) (limited to 'Perl') diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 935709c..711faa2 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, - $helpcoords_tl, $searchtree_tl, $tree_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); @@ -51,7 +51,7 @@ my %button; my %on_command; my %off_command; my @znpackinfo; - +my $screenwidth; #--------------------------------------------------------------------------- # # Initialisation functions for plugin usage @@ -102,6 +102,7 @@ sub Tk::Zinc::InitObject { sub init { my $zinc = shift; + $screenwidth = $zinc->screenwidth; my %options = @_; for my $opt (keys(%options)) { carp "in Tk::Zinc::Debug initialisation function, unknown option $opt\n" @@ -430,23 +431,33 @@ sub showtree { $tree_butt_fm->Button(-text => 'Help', -command => [\&showHelpAboutTree, $zinc], )->pack(-side => 'left', -pady => 10, - -padx => 30, -fill => 'both'); + -padx => 10, -fill => 'both'); $tree_butt_fm->Button(-text => 'Search', -command => [\&searchInTree, $zinc], )->pack(-side => 'left', -pady => 10, - -padx => 30, -fill => 'both'); + -padx => 10, -fill => 'both'); $tree_butt_fm->Button(-text => "Build\ncode", -command => [\&buildCode, $zinc, $tree], )->pack(-side => 'left', -pady => 10, - -padx => 30, -fill => 'both'); + -padx => 10, -fill => 'both'); + + $tree_butt_fm->Button(-text => "Attributes", + -command => sub { + my $path = $tree->selectionGet; + $path = 1 unless $path; + my $item = (split(/\./, $path))[-1]; + &showresult("", $zinc, $item); + }, + )->pack(-side => 'left', -pady => 10, + -padx => 10, -fill => 'both'); $tree_butt_fm->Button(-text => 'Close', -command => sub {$zinc->remove("zincdebug"); $tree_tl->destroy}, )->pack(-side => 'left', -pady => 10, - -padx => 30, -fill => 'both'); + -padx => 20, -fill => 'both'); # pack tree $tree->pack(-padx => 10, -pady => 10, -ipadx => 10, @@ -676,6 +687,7 @@ sub buildCode { -initialfile => 'zincdebug.pl', -title => 'Save code', ); + return unless defined $file; $zinc->Busy; open (OUT, ">$file"); for (@code) { @@ -1029,6 +1041,85 @@ sub searchentry { #--------------------------------------------------------------------------- # +# Functions related to transformations parameters +# +#--------------------------------------------------------------------------- + +sub showtransfoparams { + + my ($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(); + my $title = "Transformations of item $item"; + $transfo_tl->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, + ); + # translate params + $fm1->Label(-text => 'translate', -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $xt, -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $yt, -relief => 'ridge') + ->grid(-row => $r++, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $c = 0; + # rotate params + $fm1->Label(-text => 'rotate', -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $a, -relief => 'ridge') + ->grid(-row => $r++, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $c = 0; + # scale params + $fm1->Label(-text => 'scale', -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $xsc, -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $ysc, -relief => 'ridge') + ->grid(-row => $r++, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $c = 0; + # skew params + $fm1->Label(-text => 'skew', -relief => 'ridge') + ->grid(-row => $r, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm1->Label(-text => $xsk, -relief => 'ridge') + ->grid(-row => $r++, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + + + my $btn = $fm2->Button(-text => 'treset', + )->pack(-side => 'left', -padx => 40, -pady => 10); + $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]); + $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]); + $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); + $fm2->Button(-text => 'Close', + -command => sub { + $transfo_tl->destroy; + })->pack(-side => 'left', -padx => 40, -pady => 10); + + + +} # end showtransfoparams + + +#--------------------------------------------------------------------------- +# # Functions related to results tables display # #--------------------------------------------------------------------------- @@ -1057,23 +1148,20 @@ sub showresult { })->pack(-side => 'left', -padx => 40, -pady => 10); # scrolled pane creation - my $heightmax = 500; - my $height = 100 + 50*@items; - my $width = $result_tl->screenwidth; - $width = 1200 if $width > 1200; - $height = $heightmax if $height > $heightmax; - $result_fm = $result_tl->Scrolled('Listbox', - -scrollbars => 'se', - ); - $result_fm = $result_tl->Scrolled('Pane', - -scrollbars => 'oe', + -scrollbars => 'osoe', -height => 200, + -width => 1024, ); + my $fm2 = $result_fm->Frame->pack; # attributes display - &showattributes($zinc, $result_fm, \@items); - + &showattributes($zinc, $fm2, \@items); + $result_fm->update; + $fm2->update; + my $width = $fm2->width + 10; + $width = $screenwidth if $width > $screenwidth; + $result_fm->configure(-width => $width); $result_fm->pack(-padx => 10, -pady => 10, -ipadx => 10, -fill => 'both', @@ -1085,7 +1173,9 @@ sub showresult { sub showalloptions { my ($zinc, $item, $fmp) = @_; - my $tl = $fmp->Toplevel; + $alloptions_tl->destroy if Tk::Exists($alloptions_tl); + $alloptions_tl = $zinc->Toplevel(); + my $tl = $alloptions_tl; my $title = "All options of item $item"; $tl->title($title); $tl->geometry('-10+0'); @@ -1143,9 +1233,11 @@ sub showalloptions { 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'); + ->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'); + ->grid(-row => $i, -column => 2, -ipady => 5, + -ipadx => 5, -sticky => 'nswe'); $i++; } @@ -1388,11 +1480,11 @@ sub showgroupattributes { my $xn = int($coords[$#coords-1]); my $yn = int($coords[$#coords]); my $n = @coords/2 - 1; - $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + $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 => 5, -sticky => 'nswe'); + ->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'); @@ -1414,11 +1506,11 @@ sub showgroupattributes { my $xn = int($coords[$#coords-1]); my $yn = int($coords[$#coords]); my $n = @coords/2 - 1; - $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + $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 => 5, -sticky => 'nswe'); + ->grid(-row => $r++, -column => 2, -ipady => 10, -ipadx => 2, -sticky => 'nswe'); # options $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge') @@ -1470,15 +1562,21 @@ sub showgroupcontent { # coords and options scrolled frame #---------------------------------- my $fm = $tl->Scrolled('Pane', - -scrollbars => 'oe', + -scrollbars => 'osoe', -height => 200, - )->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -expand => 1, - -fill => 'both'); - - &showattributes($zinc, $fm, [@items]); - + ); + + 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 @@ -1491,18 +1589,19 @@ sub showattributes { my $i = 1; &showbanner($fm, $i++); for my $item (@$items) { + my $c = 0; my $type = $zinc->type($item); - # transformations - my $btn = $fm->Button(-text => 'treset') - ->grid(-row => $i, -column => 0, -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]); +# # 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' - )->grid(-row => $i, -column => 1, -sticky => 'nswe', + )->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); $idbtn->bind('<1>', [\&highlightitem, $zinc, $item, 0]); $idbtn->bind('<2>', [\&highlightitem, $zinc, $item, 1]); @@ -1511,25 +1610,38 @@ sub showattributes { if ($type eq 'group') { $fm->Button(-text => $type, -command => [\&showgroupcontent, $zinc, $item]) - ->grid(-row => $i, -column => 2, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } else { $fm->Label(-text => $type, -relief => 'ridge') - ->grid(-row => $i, -column => 2, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } # group my $group = $zinc->group($item); $fm->Button(-text => $group, -command => [\&showgroupattributes, $zinc, $group]) - ->grid(-row => $i, -column => 3, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); # priority &entryoption($fm, $item, $zinc, -priority) - ->grid(-row => $i, -column => 4, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); # sensitiveness &entryoption($fm, $item, $zinc, -sensitive) - ->grid(-row => $i, -column => 5, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); # visibility &entryoption($fm, $item, $zinc, -visible) - ->grid(-row => $i, -column => 6, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); + # other options + $fm->Button(-text => 'show', + -command => [\&showalloptions, $zinc, $item, $fm]) + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); + # transformations + my $tlabel = 'yes'; + my ($xt, $yt, $xsc, $ysc, $a, $xsk) = $zinc->tget($item, 'all'); + $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], + ) + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); # coords my @coords = $zinc->coords($item); my $coords; @@ -1548,16 +1660,16 @@ sub showattributes { if ($n == 1) { ## a couple of points $coords = "($x0, $y0, $xn, $yn)"; } else { - $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + $coords = "P0=($x0, $y0), ..., P".$n."=($xn, $yn)"; } } if (@coords > 2) { $fm->Button(-text => $coords, -command => [\&showcoords, $zinc, $item]) - ->grid(-row => $i, -column => 7, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); } else { $fm->Label(-text => $coords, -relief => 'ridge') - ->grid(-row => $i, -column => 7, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } # device coords @coords = $zinc->transform($item, 'device', [@coords]); @@ -1576,42 +1688,41 @@ sub showattributes { if ($n == 1) { ## a couple of points $coords = "($x0, $y0, $xn, $yn)"; } else { - $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)"; + $coords = "P0=($x0, $y0), ..., P".$n."=($xn, $yn)"; } } if (@coords > 2) { $fm->Button(-text => $coords, -command => [\&showdevicecoords, $zinc, $item]) - ->grid(-row => $i, -column => 8, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 2); } else { $fm->Label(-text => $coords, -relief => 'ridge') - ->grid(-row => $i, -column => 8, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } # bounding box my @bbox = $zinc->bbox($item); if (@bbox == 4) { - my $btn = $fm->Button(-text => "($bbox[0], $bbox[1]), ($bbox[2], $bbox[3])") - ->grid(-row => $i, -column => 9, -sticky => 'nswe', -ipadx => 5); + my ($b0, $b1, $b2, $b3) = @bbox; + $b0 = sprintf("%.2f", $b0) if int($b0) ne $b0; + $b1 = sprintf("%.2f", $b1) if int($b1) ne $b1; + $b2 = sprintf("%.2f", $b2) if int($b2) ne $b2; + $b3 = sprintf("%.2f", $b3) if int($b3) ne $b3; + my $btn = $fm->Button(-text => "($b0, $b1), ($b2, $b3)") + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); $btn->bind('<1>', [\&showbbox, $zinc, $item]); $btn->bind('', [\&hidebbox, $zinc]) ; } else { $fm->Label(-text => "--", , -relief => 'ridge') - ->grid(-row => $i, -column => 9, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); } # tags my @tags = $zinc->gettags($item); &entryoption($fm, $item, $zinc, -tags, join("\n", @tags), 30, scalar @tags) - ->grid(-row => $i, -column => 10, -sticky => 'nswe', -ipadx => 5); + ->grid(-row => $i, -column => $c++, -sticky => 'nswe', -ipadx => 5); - # other options - $fm->Button(-text => 'All options', - -command => [\&showalloptions, $zinc, $item, $fm]) - ->grid(-row => $i, -column => 11, -sticky => 'nswe', -ipadx => 5); $i++; &showbanner($fm, $i++) if ($i % 15 == 0); } - $fm->update; - return ($fm->width, $fm->height); } # end showattributes @@ -1621,27 +1732,38 @@ sub showbanner { my $fm = shift; my $i = shift; my $bgcolor = 'ivory'; - $fm->Label(-text => 'Id', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Type', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Group', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Priority', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 4, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Sensitive', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 5, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label(-text => 'Visible', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 6, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + my $c = 0; + $fm->Label(-text => "Item\nId", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "Item\nType", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "Parent\ngroup", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "P\nr\ni\no", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 2, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "S\ne\nn\ns", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 2, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "V\ni\ns\ni", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, -ipady => 2, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "All\noptions", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, + -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + $fm->Label(-text => "Transfo", -background => $bgcolor, -relief => 'ridge') + ->grid(-row => $i, -column => $c++, + -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Coords', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 7, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i, -column => $c++, + -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Device coords', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 8, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i, -column => $c++, + -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Bounding box', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 9, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i, -column => $c++, + -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Tags', -background => $bgcolor, -relief => 'ridge') - ->grid(-row => $i, -column => 10, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $fm->Label()->grid(-row => 1, -column => 11, -pady => 10); + ->grid(-row => $i, -column => $c++, + -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + $fm->Label()->grid(-row => 1, -column => $c++, -pady => 10); } # end showbanner @@ -2170,9 +2292,11 @@ sub showHelpAboutTree { $text->insert('end', "\nHIGHLIGHTING ITEMS\n\n"); $text->insert('end', "To display item's features, "); $text->insert('end', "double-click", "keyword"); - $text->insert('end', " on it or press "); + $text->insert('end', " on it, press "); $text->insert('end', "", "keyword"); - $text->insert('end', " key.\n\n"); + $text->insert('end', " key or click on the "); + $text->insert('end', "Attributes", "keyword"); + $text->insert('end', " button.\n\n"); $text->insert('end', "To highlight item in the application, simply "); $text->insert('end', "click", "keyword"); $text->insert('end', " on it."); -- cgit v1.1