diff options
Diffstat (limited to 'Perl/Zinc/Debug.pm')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 127 |
1 files changed, 119 insertions, 8 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index b50acf0..f831c58 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -15,8 +15,6 @@ use Carp; use English; require Exporter; use File::Basename; -use Tk; -use Tk::Zinc; use Tk::LabFrame; use Tk::Pane; use Tk::Dialog; @@ -27,9 +25,9 @@ use Tk::ItemStyle; @EXPORT = qw(finditems snapshot tree); @EXPORT_OK = qw(finditems snapshot tree); -my ($itemstyle, $groupstyle); +my ($itemstyle, $groupstyle, $step); my (%help_tl, $result_tl, $result_fm, $search_tl, $helptree_tl, $coords_tl, - $searchtree_tl, $tree_tl, $tree); + $searchtree_tl, $tree_tl, $tree, $transfo_tl); my $showitemflag; my ($x0, $y0); my ($help_print, $imagecounter, $saving) = (0, 0, 0); @@ -53,6 +51,7 @@ my @instances; my %cmdoptions; my $initobjectfunction; + sub BEGIN { # test if ZincDebug is loaded using the -M perl option $preload = 1 if (caller(2))[2] == 0; @@ -67,10 +66,13 @@ sub BEGIN { ); # save current Tk::Zinc::InitObject function; it will be invoked in # overloaded one (see below) + use Tk; + use Tk::Zinc; $initobjectfunction = Tk::Zinc->can('InitObject'); } + # Hack to capture the instance of zinc. ZincDebug functions are invoked here. # Note that created bindings might be overloaded by the application. sub Tk::Zinc::InitObject { @@ -103,9 +105,11 @@ sub Tk::Zinc::InitObject { push (@options, -verbosity => $cmdoptions{verbosity}) if $cmdoptions{verbosity}; push (@options, -basename => $cmdoptions{basename}) if $cmdoptions{basename}; &snapshot($zinc, @options); + } + #--------------------------------------------------------------------------- # tree : display items hierarchy #--------------------------------------------------------------------------- @@ -810,6 +814,7 @@ sub showotheroptions { } # end showotheroptions + sub showdevicecoords { my ($zinc, $item) = @_; &showcoords($zinc, $item, 1); @@ -934,11 +939,18 @@ sub showgroupattributes { -height => 2, -text => 'Content', )->grid(-row => $r, -col => 1, -sticky => 'nswe'); + # bounding box my $btn = $fm->Button(-height => 2, -text => 'Bounding Box', )->grid(-row => $r++, -col => 2, -sticky => 'nswe'); $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]); # parent group $fm->Label(-text => 'Parent group', -relief => 'ridge') @@ -1068,7 +1080,7 @@ sub showgroupcontent { -ipadx => 10, -expand => 1, -fill => 'both'); - &showattributes($zinc, $fm, \@items); + &showattributes($zinc, $fm, [@items]); } # end showgroupcontent @@ -1083,10 +1095,8 @@ sub showbbox { my $i = -2; for ('white', 'blue', 'white') { $zinc->add('rectangle', 1, - #[$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i, - #$bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i], [$bbox[0] + $i, $bbox[1] + $i, - $bbox[2] - $i, $bbox[3] + $i], + $bbox[2] - $i, $bbox[3] - $i], -linecolor => $_, -linewidth => 1, -tags => ['zincdebugbbox']); @@ -1120,6 +1130,19 @@ sub highlightitem { } # end highlightitem + +sub showtransfo { + my ($btn, $zinc, $item, $level) = @_; + + my $anim = &highlighttransfo($zinc, $item, $level); + + $btn->bind('<ButtonRelease>', [\&undohighlighttransfo, $zinc, $anim]) if $btn; + +} # end showtransfo + + + + sub itemisoutside { my $zinc = shift; my @bbox = @_; @@ -1207,6 +1230,86 @@ sub itemisoutside { } # end itemisoutside +sub highlighttransfo { + my ($zinc, $item, $level) = @_; + $zinc->remove("zincdebug"); + my $g = $zinc->add('group', 1); + my $g0 = $zinc->add('group', $g, -alpha => 0); + my $g1 = $zinc->add('group', $g); + # clone item and reset its transformation + my $clone0 = $zinc->clone($item, -visible => 1, -tags =>['zincdebug']); + $zinc->treset($clone0); + # clone item and preserve its transformation + my $clone1 = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']); + # move clones is dedicated group + $zinc->chggroup($clone0, $g0, 1); + $zinc->chggroup($clone1, $g1, 1); + # create a rectangle around + my @bbox0 = $zinc->bbox($g); + if (scalar @bbox0 == 4) { + my @bbox = $zinc->transform(1, $g, [@bbox0]); + # If item is visible, rectangle is drawm surround it. + # Else, a warning is displayed. + unless (&itemisoutside($zinc, @bbox0)) { + my $r = $zinc->add('Rectangle', $g, + [$bbox[0] - 10, $bbox[1] - 10, + $bbox[2] + 10, $bbox[3] + 10], + -filled => 1, + -linewidth => 0, + -tags => ['zincdebug'], + -fillcolor => "gray90"); + $zinc->itemconfigure($r, -fillcolor => "gray50") if $level == 1; + $zinc->itemconfigure($r, -fillcolor => "gray20") if $level == 2; + my $i = 0; + for ('white', 'green', 'white') { + $zinc->add('rectangle', $g, + [$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i, + $bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i], + -linecolor => $_, + -linewidth => 1, + -tags => ['zincdebug']); + $i++; + } + } + } + # raise + $zinc->raise('zincdebug'); + $zinc->raise($clone0); + $zinc->raise($clone1); + # animation + my $anim; + if ($zinc->cget(-render) == 0) { + $anim = $zinc->after(150, [sub { + $zinc->itemconfigure($g1, -visible => 0); + $zinc->itemconfigure($g0, -visible => 1); + }]); + } else { + my $maxsteps = 5; + $step = $maxsteps; + $anim = $zinc->repeat(150, [sub { + return if $step < 0; + $zinc->itemconfigure($g1, -alpha => ($step)*100/$maxsteps); + $zinc->itemconfigure($g0, -alpha => ($maxsteps-$step)*100/$maxsteps); + $zinc->update; + $step--; + }]); + + + } + return $anim; + +} # end highlighttransfo + + +sub undohighlighttransfo { + my ($btn, $zinc, $anim) = @_; + $btn->bind('ReleaseButton', ''); + $zinc->remove('zincdebug'); + $zinc->afterCancel($anim); + +} # end undohighlightitem + + # draw a rectangle arround the selected item sub surrounditem { my ($zinc, $item, $level) = @_; @@ -1241,6 +1344,7 @@ sub surrounditem { my $r = $zinc->add('Rectangle', $topgroup, [$bbox[0] - 10, $bbox[1] - 10, $bbox[2] + 10, $bbox[3] + 10], + -linewidth => 0, -filled => 1, -tags => ['zincdebug'], -fillcolor => "gray20"); @@ -1317,6 +1421,12 @@ sub showattributes { &showbanner($fm, $i++); for my $item (@$items) { my $type = $zinc->type($item); + # transformations + my $btn = $fm->Button(-text => 'treset') + ->grid(-row => $i, -col => 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]); # id my $idbtn = $fm->Button(-text => $item, @@ -1422,6 +1532,7 @@ sub showattributes { $fm->Label(-text => join("\n", @tags), -relief => 'ridge') ->grid(-row => $i, -col => 10, -sticky => 'nswe', -ipadx => 5); + # other options $fm->Button(-text => 'Other options', -command => [\&showotheroptions, $zinc, $item, $fm]) ->grid(-row => $i, -col => 11, -sticky => 'nswe', -ipadx => 5); |