diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 271 |
1 files changed, 160 insertions, 111 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index f831c58..fedfe9d 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -16,10 +16,10 @@ use English; require Exporter; use File::Basename; use Tk::LabFrame; -use Tk::Pane; use Tk::Dialog; use Tk::Tree; use Tk::ItemStyle; +use Tk::Pane; @ISA = qw(Exporter); @EXPORT = qw(finditems snapshot tree); @@ -368,7 +368,8 @@ sub showtree { my $path = shift; my $item = (split(/\./, $path))[-1]; &showresult("", $zinc, $item); - $zinc->after(100, sub {$zinc->remove("zincdebug")}); + $zinc->after(100, sub { + &undohighlightitem(undef, $zinc)}); }, ); $tree->bind('<1>', [sub { @@ -744,47 +745,77 @@ sub showresult { 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 => 'soeo', - -gridded => 'xy', - -width => $width, - -height => $height, + -scrollbars => 'oe', + -height => 200, ); + + # attributes display + &showattributes($zinc, $result_fm, \@items); + $result_fm->pack(-padx => 10, -pady => 10, -ipadx => 10, -fill => 'both', - -expand => 1, ); - # attributes display - &showattributes($zinc, $result_fm, \@items); } # end showresult -# display in a toplevel the values of other options -sub showotheroptions { + +sub showalloptions { my ($zinc, $item, $fmp) = @_; my $tl = $fmp->Toplevel; - #$tl->transient($fmp); - my $title = "Other options of item $item"; + my $title = "All options of item $item"; $tl->title($title); - my $background = $tl->cget(-background); - my $fm = $tl->LabFrame(-labelside => 'acrosstop', - -label => $title, + $tl->geometry('-10+0'); + + # header + #---------------- + my $fm_top = $tl->Frame()->pack(-fill => 'both', -expand => 1, + -padx => 10, -pady => 10, + -ipadx => 10, + ); + # show item + my $btn = $fm_top->Button(-height => 2, + -text => 'Show Item', + )->pack(-side => 'left', -fill => 'both', -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 => 'both', -expand => 1); + $btn->bind("<1>", [\&showbbox, $zinc, $item]); + $btn->bind("<ButtonRelease-1>", [\&hidebbox, $zinc]); + # transformations + $btn = $fm_top->Button(-height => 2, + -text => "treset") + ->pack(-side => 'left', -fill => 'both', -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'); + # option scrolled frame + #----------------------- + my $fm = $tl->Scrolled('Pane', + -scrollbars => 'oe', + -height => 500, )->pack(-padx => 10, -pady => 10, -ipadx => 10, + -expand => 1, -fill => 'both'); - my $btn1 = $fm->Button(-text => 'Show Item',) - ->grid(-row => 1, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $btn1->bind('<1>', [\&highlightitem, $zinc, $item, 0]); - $btn1->bind('<2>', [\&highlightitem, $zinc, $item, 1]); - $btn1->bind('<3>', [\&highlightitem, $zinc, $item, 2]); - my $btn2 = $fm->Button(-text => 'Bounding Box') - ->grid(-row => 1, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $btn2->bind("<1>", [\&showbbox, $zinc, $item]); - $btn2->bind("<ButtonRelease-1>", [\&hidebbox, $zinc]); - - my $bgcolor = 'ivory'; + + my $bgcolor = 'ivory'; $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge') ->grid(-row => 2, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge') @@ -794,24 +825,14 @@ sub showotheroptions { my $i = 3; for my $elem (@options) { my ($option, $type, $value) = (@$elem)[0,1,4]; - #print "option=$option type=$type\n"; - next if ($option eq '-visible' or $option eq '-sensitive' or - $option eq '-tags' or $option eq '-position' or - $option eq '-priority'); - if ($type eq 'gradient') { - my ($gradient) = $zinc->gname($value); - #print "value=$value gradient=$gradient\n"; - } $fm->Label(-text => $option, -relief => 'ridge') - ->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - &entryoption($fm, $item, $zinc, $option) - ->grid(-row => $i, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); + ->grid(-row => $i, -col => 1, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); + &entryoption($fm, $item, $zinc, $option, undef, 50, 25) + ->grid(-row => $i, -col => 2, -ipady => 5, -ipadx => 5, -sticky => 'nswe'); $i++; } - $tl->Button(-text => 'Close', - -command => sub {$tl->destroy})->pack; - -} # end showotheroptions + +} # end showalloptions @@ -822,6 +843,7 @@ sub showdevicecoords { } # end showdevicecoords + sub showcoords { my ($zinc, $item, $deviceflag) = @_; my $bgcolor = 'ivory'; @@ -842,21 +864,12 @@ sub showcoords { $coords_tl->destroy; })->pack(-side => 'bottom'); # scrolled pane creation - my $heightmax = 500; - my $height = 100 + 50; - $height = $heightmax if $height > $heightmax; - my $width = $coords_tl->screenwidth; - $width = 1200 if $width > 1200; my $coords_fm = $coords_tl->Scrolled('Pane', - -scrollbars => 'se', - -width => $width, - -height => $height, - ); - $coords_fm->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -fill => 'both', - -expand => 1, - ); + -scrollbars => 'oe', + -height => 200, + )->pack(-padx => 10, -pady => 10, + -ipadx => 10, + -fill => 'both'); my @contour; my $contournum = $zinc->contour($item); for (my $i=0; $i < $contournum; $i++) { @@ -928,39 +941,62 @@ sub showgroupattributes { my $tl = $zinc->Toplevel; my $title = "About group $item"; $tl->title($title); - my $fm = $tl->LabFrame(-labelside => 'acrosstop', - -label => $title, - )->pack(-padx => 10, -pady => 10, + + # header + #----------- + + my $fm_top = $tl->Frame()->pack(-fill => 'both', -expand => 1, + -padx => 10, -pady => 10, -ipadx => 10, - -fill => 'both'); - my $r = 1; + ); # content - $fm->Button(-command => [\&showgroupcontent, $zinc, $item], - -height => 2, - -text => 'Content', - )->grid(-row => $r, -col => 1, -sticky => 'nswe'); + $fm_top->Button(-command => [\&showgroupcontent, $zinc, $item], + -height => 2, + -text => 'Content', + )->pack(-side => 'left', -fill => 'both', -expand => 1); # bounding box - my $btn = $fm->Button(-height => 2, + my $btn = $fm_top->Button(-height => 2, -text => 'Bounding Box', - )->grid(-row => $r++, -col => 2, -sticky => 'nswe'); + )->pack(-side => 'left', -fill => 'both', -expand => 1); $btn->bind("<1>", [\&showbbox, $zinc, $item]); $btn->bind("<ButtonRelease-1>", [\&hidebbox, $zinc]); - # transformations - my $btn = $fm->Button(-text => "treset") - ->grid(-row => $r++, -col => 1, -sticky => 'nswe', -columnspan => 2); - $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_top->Button(-height => 2, + -text => "treset") + ->pack(-side => 'left', -fill => 'both', -expand => 1); + if ($item == 1) { + $btn->configure(-state => 'disabled'); + } else { + $btn->bind('<1>', [\&showtransfo, $zinc, $item, 0]); + $btn->bind('<2>', [\&showtransfo, $zinc, $item, 1]); + $btn->bind('<3>', [\&showtransfo, $zinc, $item, 2]); + } + # parent group - $fm->Label(-text => 'Parent group', -relief => 'ridge') - ->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); my $gr = $zinc->group($item); - my $bpg = $fm->Button(-text => $gr, - -command => [\&showgroupattributes, $zinc, $gr]) - ->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); - $bpg->configure(-disabledforeground => scalar $bpg->cget(-foreground), - -state => 'disabled') if $gr == $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, + -fill => 'both'); + + my $r = 1; my $bgcolor = 'ivory'; # coords $fm->Label(-text => 'Coordinates', -background => $bgcolor, -relief => 'ridge') @@ -1038,13 +1074,11 @@ sub showgroupattributes { $value .= " (". $zinc->type($value) .")"; $w = $fm->Label(-text => $value, -relief => 'ridge'); } else { - $w = &entryoption($fm, $item, $zinc, $option); + $w = &entryoption($fm, $item, $zinc, $option, undef, 50, 25); } $w->grid(-row => $r, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe'); $r++; } - $tl->Button(-text => 'Close', - -command => sub {$tl->destroy})->pack; } # end showgroupattributes @@ -1053,10 +1087,8 @@ sub showgroupattributes { sub showgroupcontent { my ($zinc, $group) = @_; my $tl = $zinc->Toplevel; + my @items = $zinc->find('withtag', $group."."); - my $heightmax = 500; - my $height = 100 + 50*@items; - $height = $heightmax if $height > $heightmax; my $title = "Content of group $group"; $tl->title($title); my $fm2 = $tl->Frame()->pack(-side => 'bottom', @@ -1069,17 +1101,15 @@ sub showgroupcontent { $tl->destroy; })->pack(-side => 'left', -padx => 40, -pady => 10); - my $width = $result_tl->screenwidth; - $width = 1200 if $width > 1200; + # coords and options scrolled frame + #---------------------------------- my $fm = $tl->Scrolled('Pane', - -scrollbars => 'se', - -width => $width, - -height => $height, - -label => $title, - )->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -expand => 1, - -fill => 'both'); + -scrollbars => 'oe', + -height => 200, + )->pack(-padx => 10, -pady => 10, + -ipadx => 10, + -fill => 'both'); + &showattributes($zinc, $fm, [@items]); } # end showgroupcontent @@ -1121,7 +1151,9 @@ sub hidebbox { # belongs to an invisible group. sub highlightitem { my ($btn, $zinc, $item, $level) = @_; + #print "highlightitem\n"; return if $showitemflag or $item == 1; + print "highlightitem 2\n"; $showitemflag = 1; &surrounditem($zinc, $item, $level); @@ -1282,11 +1314,12 @@ sub highlighttransfo { $anim = $zinc->after(150, [sub { $zinc->itemconfigure($g1, -visible => 0); $zinc->itemconfigure($g0, -visible => 1); + $zinc->update; }]); } else { my $maxsteps = 5; $step = $maxsteps; - $anim = $zinc->repeat(150, [sub { + $anim = $zinc->repeat(100, [sub { return if $step < 0; $zinc->itemconfigure($g1, -alpha => ($step)*100/$maxsteps); $zinc->itemconfigure($g0, -alpha => ($maxsteps-$step)*100/$maxsteps); @@ -1303,7 +1336,7 @@ sub highlighttransfo { sub undohighlighttransfo { my ($btn, $zinc, $anim) = @_; - $btn->bind('ReleaseButton', ''); + $btn->bind('ReleaseButton', '') if $btn; $zinc->remove('zincdebug'); $zinc->afterCancel($anim); @@ -1371,7 +1404,8 @@ sub surrounditem { sub undohighlightitem { my ($btn, $zinc) = @_; - $btn->bind('ReleaseButton', ''); + #print "undohighlightitem\n"; + $btn->bind('ReleaseButton', '') if $btn; $zinc->remove('zincdebug'); $showitemflag = 0; @@ -1529,12 +1563,12 @@ sub showattributes { } # tags my @tags = $zinc->gettags($item); - $fm->Label(-text => join("\n", @tags), - -relief => 'ridge') + &entryoption($fm, $item, $zinc, -tags, join("\n", @tags), 50, scalar @tags) ->grid(-row => $i, -col => 10, -sticky => 'nswe', -ipadx => 5); + # other options - $fm->Button(-text => 'Other options', - -command => [\&showotheroptions, $zinc, $item, $fm]) + $fm->Button(-text => 'All options', + -command => [\&showalloptions, $zinc, $item, $fm]) ->grid(-row => $i, -col => 11, -sticky => 'nswe', -ipadx => 5); $i++; &showbanner($fm, $i++) if ($i % 15 == 0); @@ -1869,20 +1903,31 @@ sub infoAboutHighlighting { # #--------------------------------------------------------------------------- sub entryoption { - my ($fm, $item, $zinc, $option) = @_; - my $def = $zinc->itemcget($item, $option); + my ($fm, $item, $zinc, $option, $def, $widthmax, $widthmin, $height) = @_; + my $arrayflag; + unless ($def) { + my @def = $zinc->itemcget($item, $option); + if (@def > 1) { + $arrayflag = 1; + $def = join(', ', @def); + } else { + $def = $def[0]; + } + } my $i0; my $e; if ($def =~ /\n/) { - $e = $fm->Text(-height => 1, -width => 1, -wrap => 'word'); + $height = 1 unless defined($height); + $e = $fm->Text(-height => $height, -width => 1, -wrap => 'none'); $i0 = '0.0'; } else { $e = $fm->Entry(); $i0 = 0; } - my $len = length($def); - $len = 50 if $len > 50; - $e->configure(-width => $len); + my $width = length($def); + $width = $widthmax if defined($widthmax) and $width > $widthmax; + $width = $widthmin if defined($widthmin) and $width < $widthmin; + $e->configure(-width => $width); if ($defaultoptions{$item}->{$option} and $def ne $defaultoptions{$item}->{$option}) { $e->configure(-foreground => 'blue'); @@ -1911,7 +1956,11 @@ sub entryoption { $e->after(80, sub { $e->configure(-background => $bg, -foreground => $fg); }); - $zinc->itemconfigure($item, $option => $val); + if ($arrayflag) { + $zinc->itemconfigure($item, $option => [split(/,/, $val)]); + } else { + $zinc->itemconfigure($item, $option => $val); + } }); return $e; @@ -2074,7 +2123,7 @@ Daniel Etienne <etienne@cena.fr> =head1 HISTORY -Mar 11 2003 : ZincDebug can manage several instances of Zinc widget. Options of ZincDebug functions can be set on the command line. +Mar 11 2003 : ZincDebug can manage several instances of Zinc widget. Options of ZincDebug functions can be set on the command line. Jan 20 2003 : item's attributes can be edited. |