diff options
Diffstat (limited to 'Perl')
| -rw-r--r-- | Perl/Zinc/Debug.pm | 54 |
1 files changed, 36 insertions, 18 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm index 0dc6ca0..dd792a1 100644 --- a/Perl/Zinc/Debug.pm +++ b/Perl/Zinc/Debug.pm @@ -44,9 +44,12 @@ sub finditems { my $ekb = ($options{-enclosedModBtn}) ? $options{-enclosedModBtn} : ['Control', 3]; my $okb = ($options{-overlapModBtn}) ? $options{-overlapModBtn} : ['Shift', 3]; my $pkb = ($options{-printModBtn}) ? $options{-printModBtn} : ['Control-Shift', 2]; - my $snapshotVerbosity = (defined $options{-snapshotVerbosity}) ? $options{-snapshotVerbosity} : 1; - my $snapshotBasename = ($options{-snapshotBasename}) ? $options{-snapshotBasename} : "zincsnapshot"; - carp "in ZincDebug module, finditems function, enclosed search and zinc snapshot won't work because ". + my $snapshotVerbosity = (defined $options{-snapshotVerbosity}) ? + $options{-snapshotVerbosity} : 1; + my $snapshotBasename = ($options{-snapshotBasename}) ? + $options{-snapshotBasename} : "zincsnapshot"; + carp "in ZincDebug module, finditems function, enclosed search and ". + "zinc snapshot won't work because ". "two of them use the same sequence.\n" . "enclose : [$ekb->[0], $ekb->[1]]\n" . "overlap [$okb->[0], $okb->[1]]\n" . @@ -78,7 +81,8 @@ sub finditems { [\&stoprectangle, 'overlapping', 'Overlap search']); # # binding for printing a full zinc window - $zinc->Tk::bind("<".$pkb->[0]."-B".$pkb->[1]."-ButtonRelease>", [\&printWindow , $snapshotBasename, $snapshotVerbosity]); + $zinc->Tk::bind("<".$pkb->[0]."-B".$pkb->[1]."-ButtonRelease>", + [\&printWindow , $snapshotBasename, $snapshotVerbosity]); } #------------------------------------------------------------------------------------ @@ -106,7 +110,7 @@ sub showresult { # display in a toplevel the value of other options sub showotheroptions { my ($zinc, $item) = @_; - my $tl = MainWindow->new()->toplevel; + my $tl = $zinc->Toplevel; my $title = "Other options of item $item"; $tl->title($title); my $fm = $tl->LabFrame(-labelside => 'acrosstop', @@ -140,7 +144,7 @@ sub showotheroptions { sub showgroupattributes { my ($zinc, $item) = @_; - my $tl = MainWindow->new()->toplevel; + my $tl = $zinc->Toplevel; my $title = "About group $item"; $tl->title($title); my $fm = $tl->LabFrame(-labelside => 'acrosstop', @@ -149,13 +153,19 @@ sub showgroupattributes { -ipadx => 10, -fill => 'both'); my $r = 1; + # content + $fm->Button(-command => [\&showgroupcontent, $zinc, $item], + -text => 'Content', + )->grid(-row => $r++, -col => 1, -columnspan => 2, -sticky => 'nswe'); # 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); - $fm->Button(-text => $gr, - -command => [\&showgroupattributes, $zinc, $gr]) + 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 $bgcolor = 'ivory'; # coords $fm->Label(-text => 'Coordinates', -background => $bgcolor, -relief => 'ridge') @@ -239,20 +249,25 @@ sub showgroupattributes { # display in a toplevel the content of a group item sub showgroupcontent { my ($zinc, $group) = @_; - my $tl = MainWindow->new()->toplevel; + my $tl = $zinc->Toplevel; my $title = "Content of group $group"; $tl->title($title); - my $fm = $tl->LabFrame(-labelside => 'acrosstop', - -label => $title, - )->pack(-padx => 10, -pady => 10, - -ipadx => 10, - -fill => 'both'); - my @items = $zinc->find('all', $group); + my $fm = $tl->Scrolled('Pane', + -scrollbars => 'se', + -width => scalar $result_tl->screenwidth, + -height => 200, + -label => $title, + )->pack(-padx => 10, -pady => 10, + -ipadx => 10, + -expand => 1, + -fill => 'both'); + my @items = $zinc->find('withtag', $group."."); &showattributes($fm, \@items); $tl->Button(-text => 'Close', -command => sub {$tl->destroy})->pack; } + # highlight an item (by cloning it and hiding other found items) # why cloning? because we can't simply make visible an item which # belongs to an invisible group. @@ -263,7 +278,7 @@ sub highlightitem { my @itemstohide = (); my @visibility = (); - for ($zinc->find('overlap', $zinc->coords($rectangle_id))) { + for ($zinc->find('overlapping', $zinc->coords($rectangle_id))) { push (@itemstohide, $_) unless $_ == $rectangle_id or $_ == $text_id; } for (@itemstohide) { @@ -276,10 +291,11 @@ sub highlightitem { $zinc->coords($clone, [$zinc->transform(scalar $zinc->group($item), 1, [@coords])]); $zinc->raise($clone); $btn->bind('<ButtonRelease>', [\&undohighlightitem, $zinc, $clone, - \@itemstohide, \@visibility]); + \@itemstohide, \@visibility]); } + sub undohighlightitem { my ($btn, $zinc, $clone, $itemstohide, $visibility) = @_; $btn->bind('ReleaseButton', ''); @@ -290,6 +306,7 @@ sub undohighlightitem { $showitemflag = 0; } + # print a zinc window in png format sub printWindow { exit if $saving; @@ -495,8 +512,9 @@ sub showattributes { sub startrectangle { my ($widget, $style, $text, $color) = @_; if (not $result_tl or not Tk::Exists($result_tl)) { - $result_tl = MainWindow->new()->toplevel(); + $result_tl = $zinc->Toplevel(); $result_tl->title("Zinc Debug"); + $result_tl->geometry('+10+10'); $result_tl->Button(-text => 'Close', -command => sub { $result_tl->destroy; |