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