aboutsummaryrefslogtreecommitdiff
path: root/Perl
diff options
context:
space:
mode:
Diffstat (limited to 'Perl')
-rw-r--r--Perl/Zinc/Debug.pm54
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;