aboutsummaryrefslogtreecommitdiff
path: root/Perl/Zinc/Debug.pm
diff options
context:
space:
mode:
authoretienne2002-08-28 15:30:13 +0000
committeretienne2002-08-28 15:30:13 +0000
commit03d3d41a840448e509fb15075e2099024eeb244e (patch)
tree8d079eb6080b7b08d83349ef6d14af798aa8cee3 /Perl/Zinc/Debug.pm
parent8b400366374508c7eda20ce0b16814bafb9be7b5 (diff)
downloadtkzinc-03d3d41a840448e509fb15075e2099024eeb244e.zip
tkzinc-03d3d41a840448e509fb15075e2099024eeb244e.tar.gz
tkzinc-03d3d41a840448e509fb15075e2099024eeb244e.tar.bz2
tkzinc-03d3d41a840448e509fb15075e2099024eeb244e.tar.xz
* Mise en evidence d'un item : l'idee de rendre invisible ses items
hierarchiquement proches est abandonn� au profit d'un simple fond clair ou fonc� sur lequel se detache l'item design�. * L'aide en ligne est cach�e, accessible par les boutons Help. * Correction de bugs mineurs.
Diffstat (limited to 'Perl/Zinc/Debug.pm')
-rw-r--r--Perl/Zinc/Debug.pm320
1 files changed, 160 insertions, 160 deletions
diff --git a/Perl/Zinc/Debug.pm b/Perl/Zinc/Debug.pm
index 64c155e..32309d4 100644
--- a/Perl/Zinc/Debug.pm
+++ b/Perl/Zinc/Debug.pm
@@ -41,6 +41,7 @@ my $treeKey;
my $tree;
my @keys;
my @seq;
+my $helptree_tl;
sub tree {
@@ -59,7 +60,7 @@ sub tree {
#
# binding for help screen
#
- $zinc->toplevel->Tk::bind('<Key-Escape>', \&showhelp);
+ $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp);
#
# binding for building tree
#
@@ -95,7 +96,7 @@ sub finditems {
#
# binding for help screen
#
- $zinc->toplevel->Tk::bind('<Key-Escape>', \&showhelp);
+ $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp);
#
# bindings for Enclosed search
#
@@ -142,7 +143,7 @@ sub snapshot {
#
# binding for help screen
#
- $zinc->toplevel->Tk::bind('<Key-Escape>', \&showhelp);
+ $zinc->toplevel->Tk::bind('<Key-Escape>', \&showgeneralhelp);
#
# binding for printing a full zinc window
#
@@ -158,7 +159,7 @@ sub snapshot {
#
#---------------------------------------------------------------------------
sub findintree {
- if (not $tree_tl) {
+ if (not Tk::Exists($tree_tl)) {
&showtree;
}
my $ev = $zinc->XEvent;
@@ -184,37 +185,6 @@ sub showtree {
$tree_tl->destroy if $tree_tl and Tk::Exists($search_tl);
$tree_tl = $zinc->Toplevel;
$tree_tl->title("Zinc Items Tree");
- # help text
- my $font = $zinc->cget(-font);
- my $text = $tree_tl->Text(-height => 8,
- -relief => 'flat',
- -font => $font,
- -wrap => 'word',
- -foreground => 'gray30',
- )->pack(-side => 'top');
- $text->tagConfigure('keyword', -foreground => 'black');
- $text->insert('end', "<Up>", "keyword");
- $text->insert('end', " arrow key moves the anchor point to the item right on ".
- "top of the current anchor item. ");
- $text->insert('end', "<Down>", "keyword");
- $text->insert('end', " arrow key moves the anchor point to the item right below ".
- "the current anchor item. ");
- $text->insert('end', "<Left>", "keyword");
- $text->insert('end', " arrow key moves the anchor to the parent item of the ".
- "current anchor item. ");
- $text->insert('end', "<Right>", "keyword");
- $text->insert('end', " moves the anchor to the first child of the current anchor ".
- "item. If the current anchor item does not have any children, moves ".
- "the anchor to the item right below the current anchor item.\n\n");
- $text->insert('end', "<Click>", "keyword");
- $text->insert('end', " or ");
- $text->insert('end', "<Space>", "keyword");
- $text->insert('end', " highlights corresponding Zinc item and ");
- $text->insert('end', "<Double-Click>", "keyword");
- $text->insert('end', " or ");
- $text->insert('end', "<Return>", "keyword");
- $text->insert('end', " displays item's features\n");
-
$tree = $tree_tl->Scrolled('Tree',
-scrollbars => 'se',
-height => 40,
@@ -258,20 +228,31 @@ sub showtree {
}, Ev('y')]);
+ $tree->add("1", -text => "Group(1)", -state => 'disabled');
+ &scangroup($tree, 1, "1",);
+ $tree->autosetmode;
+ # control buttons frame
+ my $tree_butt_fm = $tree_tl->Frame(-height => 40)->pack(-side => 'bottom',
+ -expand => 1,
+ -fill => 'both');
+ $tree_butt_fm->Button(-text => 'Help',
+ -command => \&showHelpAboutTree,
+ )->pack(-side => 'left', -pady => 10,
+ -padx => 30, -fill => 'both');
+
+ $tree_butt_fm->Button(-text => 'Close',
+ -command => sub {$zinc->remove("zincdebug");
+ $tree_tl->destroy},
+ )->pack(-side => 'right', -pady => 10,
+ -padx => 30, -fill => 'both');
+ # pack tree
$tree->pack(-padx => 10, -pady => 10,
-ipadx => 10,
+ -side => 'top',
-fill => 'both',
-expand => 1,
);
- $tree->add("1", -text => "Group(1)", -state => 'disabled');
- &scangroup($tree, 1, "1",);
- $tree->autosetmode;
- $tree_tl->Button(-text => 'Close',
- -command => sub {$zinc->remove("zincdebug");
- $tree_tl->destroy},
- )->pack(-side => 'top', -pady => 10);
-
} # end showtree
@@ -357,7 +338,11 @@ sub stoprectangle {
$item != $text_id;
}
&restoreAtomicity(@atomicgroups);
- &showresult($text, $zinc, @items) if @items;
+ if (@items) {
+ &showresult($text, $zinc, @items);
+ } else {
+ $zinc->remove($rectangle_id, $text_id);
+ }
} # end stoprectangle
@@ -488,11 +473,17 @@ sub showresult {
$title .= " - $label" if $label;
$result_tl->title($title);
$result_tl->geometry('+10+20');
- $result_tl->Button(-text => 'Close',
- -command => sub {
- $result_tl->destroy;
- $zinc->remove($rectangle_id, $text_id);
- })->pack(-side => 'bottom');
+ my $fm = $result_tl->Frame()->pack(-side => 'bottom',
+ );
+ $fm->Button(-text => 'Help',
+ -command => [\&showHelpAboutAttributes, $result_tl]
+ )->pack(-side => 'left', -padx => 40, -pady => 10);
+ $fm->Button(-text => 'Close',
+ -command => sub {
+ $result_tl->destroy;
+ $zinc->remove($rectangle_id, $text_id);
+ })->pack(-side => 'left', -padx => 40, -pady => 10);
+
# scrolled pane creation
my $heightmax = 500;
my $height = 100 + 50*@items;
@@ -755,6 +746,16 @@ sub showgroupcontent {
$height = $heightmax if $height > $heightmax;
my $title = "Content of group $group";
$tl->title($title);
+ my $fm2 = $tl->Frame()->pack(-side => 'bottom',
+ );
+ $fm2->Button(-text => 'Help',
+ -command => [\&showHelpAboutAttributes, $tl]
+ )->pack(-side => 'left', -padx => 40, -pady => 10);
+ $fm2->Button(-text => 'Close',
+ -command => sub {
+ $tl->destroy;
+ })->pack(-side => 'left', -padx => 40, -pady => 10);
+
my $fm = $tl->Scrolled('Pane',
-scrollbars => 'se',
-width => scalar $result_tl->screenwidth,
@@ -765,8 +766,6 @@ sub showgroupcontent {
-expand => 1,
-fill => 'both');
&showattributes($fm, \@items);
- $tl->Button(-text => 'Close',
- -command => sub {$tl->destroy})->pack;
} # end showgroupcontent
@@ -779,47 +778,17 @@ sub highlightitem {
my ($btn, $zinc, $item, $level) = @_;
return if $showitemflag;
$showitemflag = 1;
-
- &surrounditem($zinc, $item);
- # make parent groups invisible
- my $group;
- my $visibility;
- if ($level == 2) {
- my $group1 = $zinc->group($item);
- if ($group1 == 1) {
- $group = undef;
- } else {
- my $group2 = $zinc->group($group1);
- if ($group2 == 1) {
- $group = $group1;
- } else {
- $group = $group2;
- }
- }
- } elsif ($level == 1) {
- my $group1 = $zinc->group($item);
- if ($group1 == 1) {
- $group = undef;
- } else {
- $group = $group1;
- }
- }
- if ($group) {
- $visibility = $zinc->itemcget($group, -visible);
- $zinc->itemconfigure($group, -visible => 0);
- }
-
- $btn->bind('<ButtonRelease>', [\&undohighlightitem, $zinc, 'zincdebug',
- $group, $visibility]) if $btn;
+ &surrounditem($zinc, $item, $level);
+
+ $btn->bind('<ButtonRelease>', [\&undohighlightitem]) if $btn;
} # end highlightitem
-
# draw a rectangle arround the selected item
sub surrounditem {
- my ($zinc, $item) = @_;
+ my ($zinc, $item, $level) = @_;
$zinc->remove("zincdebug");
my @coords = $zinc->coords($item);
# get item ancestors
@@ -842,15 +811,21 @@ sub surrounditem {
# move in topgroup
$zinc->chggroup($clone, $topgroup);
# create a rectangle around
- my @bbox1 = $zinc->bbox($item);
my @bbox = $zinc->bbox($clone);
- my @c = $zinc->coords($clone);
- #print "clone_id=$clone | bbox_item=@bbox1 | bbox_clone=@bbox | coords_clone=@c | clone_type=", $zinc->type($clone) ,"\n";
if (scalar @bbox == 4) {
@bbox = $zinc->transform(1, $topgroup, [@bbox]);
+ if ($level > 0) {
+ my $r = $zinc->add('Rectangle', $topgroup,
+ [$bbox[0] - 10, $bbox[1] - 10,
+ $bbox[2] + 10, $bbox[3] + 10],
+ -filled => 1,
+ -tags => ['zincdebug'],
+ -fillcolor => "gray20");
+ $zinc->itemconfigure($r, -fillcolor => "gray80") if $level == 1;
+ }
my $i = 0;
for ('white', 'red', 'white') {
- my $r = $zinc->add('rectangle', $topgroup,
+ $zinc->add('rectangle', $topgroup,
[$bbox[0] - 5 - 2*$i, $bbox[1] - 5 - 2*$i,
$bbox[2] + 5 + 2*$i, $bbox[3] + 5 + 2*$i],
-linecolor => $_,
@@ -861,51 +836,15 @@ sub surrounditem {
}
# raise
$zinc->raise('zincdebug');
-
+ $zinc->raise($clone);
+
} # end surrounditem
-# not used
-# draw a rectangle arround the selected item
-# without cloning all the hierarchy
-sub surrounditem2 {
- my ($zinc, $item) = @_;
- $zinc->remove("zincdebug");
- my @coords = $zinc->coords($item);
- # cloning
- my $clone = $zinc->clone($item, -visible => 1, -tags => ['zincdebug']);
- # move in group 1, with transformation adjustment
- my $topgroup = 1;
- $zinc->chggroup($clone, $topgroup, 1);
- # create a rectangle around
- my @bbox1 = $zinc->bbox($item);
- my @bbox = $zinc->bbox($clone);
- my @c = $zinc->coords($clone);
- if (scalar @bbox == 4) {
- @bbox = $zinc->transform(1, $topgroup, [@bbox]);
- my $i = 0;
- for ('white', 'red', 'white') {
- my $r = $zinc->add('rectangle', $topgroup,
- [$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');
-
-} # end surrounditem2
-
-
-
sub undohighlightitem {
- my ($btn, $zinc, $items2delete, $group, $visibility) = @_;
+ my ($btn) = @_;
$btn->bind('ReleaseButton', '');
- $zinc->itemconfigure($group, -visible => $visibility) if $group;
- $zinc->remove($items2delete);
+ $zinc->remove('zincdebug');
$showitemflag = 0;
} # end undohighlightitem
@@ -946,35 +885,6 @@ sub showattributes {
my ($fm, $items) = @_;
my $bgcolor = 'ivory';
my $i = 1;
- # help text
- my $font = $zinc->cget(-font);
- my $text = $fm->Text(-height => 5,
- -relief => 'flat',
- -font => $font,
- -wrap => 'word',
- -foreground => 'gray30',
- )->grid(-sticky => 'nswe',
- -columnspan => 10,
- -row => $i++,
- -col => 1);
- $text->tagConfigure('keyword', -foreground => 'black');
- $text->insert('end',
- "First column contains items identifiers buttons you can press to ".
- "highlight corresponding items in the application. ");
- $text->insert('end', "By default, using ");
- $text->insert('end', "left mouse button", "keyword");
- $text->insert('end', ", highlighting is done by raising selected item and drawing ".
- "a rectangle arround. ");
- $text->insert('end', "If you use ");
- $text->insert('end', "center mouse button", "keyword");
- $text->insert('end', ", other items contained in the selected item's group are ".
- "hidden too. ");
- $text->insert('end', "And if you use ");
- $text->insert('end', "right mouse button", "keyword");
- $text->insert('end', ", members of the selected item's parent group are hidden ".
- "too.\n");
- $text->insert('end', "Third column contains groups identifiers buttons you can ".
- "press to display groups content and attributes.");
&showbanner($fm, $i++);
for my $item (@$items) {
my $type = $zinc->type($item);
@@ -1147,7 +1057,7 @@ sub showErrorWhilePrinting {
#
#---------------------------------------------------------------------------
# display complete help screen
-sub showhelp {
+sub showgeneralhelp {
my $text;
if ($enclosedModBtn) {
my $eseq = $enclosedModBtn->[0]."-Button".$enclosedModBtn->[1];
@@ -1186,8 +1096,98 @@ sub showhelp {
$help_tl->after(300, sub {$help_tl->grabRelease});
$help_tl->Show();
-} # end showhelp
+} # end showgeneralhelp
+
+
+# display help about tree
+sub showHelpAboutTree {
+ $helptree_tl->destroy if $helptree_tl and Tk::Exists($helptree_tl);
+ $helptree_tl = $tree_tl->Toplevel;
+ $helptree_tl->title("Help about Tree");
+
+ my $text = $helptree_tl->Text(-font => scalar $zinc->cget(-font),
+ -wrap => 'word',
+ -foreground => 'gray10',
+ );
+ $text->tagConfigure('keyword', -foreground => 'darkblue');
+ $text->insert('end', "\nNAVIGATION IN TREE\n\n");
+ $text->insert('end', "<Up>", "keyword");
+ $text->insert('end', " arrow key moves the anchor point to the item right on ".
+ "top of the current anchor item. ");
+ $text->insert('end', "<Down>", "keyword");
+ $text->insert('end', " arrow key moves the anchor point to the item right below ".
+ "the current anchor item. ");
+ $text->insert('end', "<Left>", "keyword");
+ $text->insert('end', " arrow key moves the anchor to the parent item of the ".
+ "current anchor item. ");
+ $text->insert('end', "<Right>", "keyword");
+ $text->insert('end', " moves the anchor to the first child of the current anchor ".
+ "item. If the current anchor item does not have any children, moves ".
+ "the anchor to the item right below the current anchor item.\n\n");
+ $text->insert('end', "\nHIGHLIGHTING ITEMS\n\n");
+ $text->insert('end', "To display item's features, ");
+ $text->insert('end', "double-click", "keyword");
+ $text->insert('end', " on it or press ");
+ $text->insert('end', "<Return>", "keyword");
+ $text->insert('end', " key.\n\n");
+ $text->insert('end', "To highlight item in the application, simply ");
+ $text->insert('end', "click", "keyword");
+ $text->insert('end', " on it. ");
+ &infoAboutHighlighting($text);
+ $text->configure(-state => 'disabled');
+
+ $helptree_tl->Button(-command => sub {$helptree_tl->destroy},
+ -text => 'Close')->pack(-side => 'bottom',
+ -pady => 10);
+ $text->pack->pack(-side => 'top', -pady => 10, -padx => 10);
+} # end showHelpAboutTree
+
+
+
+sub showHelpAboutAttributes {
+ my $widget = shift;
+ $helptree_tl->destroy if $helptree_tl and Tk::Exists($helptree_tl);
+ $helptree_tl = $widget->Toplevel;
+ $helptree_tl->title("Help about attributes");
+
+ my $text = $helptree_tl->Text(-font => scalar $zinc->cget(-font),
+ -wrap => 'word',
+ -foreground => 'gray10',
+ );
+ $text->tagConfigure('keyword', -foreground => 'darkblue');
+
+
+ $text->insert('end',
+ "First column contains items identifiers buttons you can press to ".
+ "highlight corresponding items in the application.\n");
+ &infoAboutHighlighting($text);
+ $text->insert('end', "\n\nThird column contains groups identifiers buttons you can ".
+ "press to display groups content and attributes.");
+ $text->configure(-state => 'disabled');
+
+ $helptree_tl->Button(-command => sub {$helptree_tl->destroy},
+ -text => 'Close')->pack(-side => 'bottom',
+ -pady => 10);
+ $text->pack->pack(-side => 'top', -pady => 10, -padx => 10);
+
+} # end showHelpAboutAttributes
+
+
+sub infoAboutHighlighting {
+ my $text = shift;
+ $text->insert('end', "By default, using ");
+ $text->insert('end', "left mouse button", "keyword");
+ $text->insert('end', ", highlighting is done by raising selected item and drawing ".
+ "a rectangle arround. ");
+ $text->insert('end', "In order to improve visibility, ");
+ $text->insert('end', "item will be light backgrounded if you use ");
+ $text->insert('end', "center mouse button", "keyword");
+ $text->insert('end', " and dark backgrounded if you use ");
+ $text->insert('end', "right mouse button", "keyword");
+ $text->insert('end', ". ");
+
+} # end infoAboutHighlighting
1;