path: root/Perl/Zinc/Debug.pm

#        ZincDebug Perl Module :
#
#        For debugging/analysing a Zinc application
#
#        Author : Daniel Etienne <etienne@cena.fr>
#
# $Id$
#---------------------------------------------------------------------------
package ZincDebug;


use strict 'vars';
use vars qw(@ISA @EXPORT);
use Carp;
require Exporter;
use File::Basename;
use Tk::Zinc;
use Tk::LabFrame;
use Tk::Pane;
use Tk::Dialog;

@ISA = qw(Exporter);
@EXPORT = qw(finditems);

my ($help_tl0, $help_tl, $result_tl, $result_fm, $showitemflag);
my ($text_id, $rectangle_id);
my ($x0, $y0);
my ($help_print, $imagecounter, $saving) = (0,0);

my $zinc;


sub finditems {
    $zinc = shift;
    # options 
    my %options = @_;
    for my $opt (keys(%options)) {
	carp "in ZincDebug module, finditems function, unknown option $opt\n"
	    unless ($opt eq '-color' or $opt eq '-enclosedModBtn' or
		    $opt eq '-overlapModBtn' or $opt eq '-snapshotModBtn' or
		    $opt eq '-snapshotVerbosity' or $opt eq '-snapshotBasename' );
    }
    my $color = ($options{-color}) ? $options{-color} : 'sienna';
    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 ".
	"two of them use the same sequence.\n" .
	    "enclose : [$ekb->[0], $ekb->[1]]\n" .
		"overlap [$okb->[0], $okb->[1]]\n" .
		    "snapshot [$pkb->[0], $pkb->[1]]\n"
			
			if
	    ($ekb->[0] eq $okb->[0] and $ekb->[1] eq $okb->[1]) or
		($pkb->[0] eq $okb->[0] and $pkb->[1] eq $okb->[1]) or
		    ($pkb->[0] eq $ekb->[0] and $pkb->[1] eq $ekb->[1]) ;
    #
    # binding for help screen
    #
    $zinc->toplevel->Tk::bind('<Key-Escape>', [\&showhelp, $ekb, $okb, $pkb]);
    #
    # bindings for Enclosed search
    #
    $zinc->Tk::bind("<".$ekb->[0]."-".$ekb->[1].">",
		    [\&startrectangle, 'simple', 'Enclosed', $color]);
    $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-Motion>", \&resizerectangle);
    $zinc->Tk::bind("<".$ekb->[0]."-B".$ekb->[1]."-ButtonRelease>",
		    [\&stoprectangle, 'enclosed', 'Enclosed search']);
    #
    # bindings for Overlap search
    #
    $zinc->Tk::bind("<".$okb->[0]."-".$okb->[1].">",
		    [\&startrectangle, 'mixed', 'Overlap', $color]);
    $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-Motion>", \&resizerectangle);
    $zinc->Tk::bind("<".$okb->[0]."-B".$okb->[1]."-ButtonRelease>",
		    [\&stoprectangle, 'overlapping', 'Overlap search']);
    #
    # binding for printing a full zinc window
    $zinc->Tk::bind("<".$pkb->[0]."-B".$pkb->[1]."-ButtonRelease>",
		    [\&printWindow , $snapshotBasename, $snapshotVerbosity]);
}

#------------------------------------------------------------------------------------
# display in a toplevel the result of search
sub showresult {
    my ($label, $zinc, @items) = @_;
    $result_fm->destroy if Tk::Exists($result_fm);
    $result_fm = $result_tl->Scrolled('Pane',
				      -scrollbars => 'se',
				      -width => scalar $result_tl->screenwidth,
				      -height => 500,
				      );

    $result_fm->pack(-padx => 10, -pady => 10,
		     -ipadx => 10,
		     -fill => 'both',
		     -expand => 1,
		     );
    &showattributes($result_fm, \@items);
    $result_tl->deiconify;
    $result_tl->update;
}


# display in a toplevel the value of other options
sub showotheroptions {
    my ($zinc, $item) = @_;
    my $tl = $zinc->Toplevel;
    my $title = "Other options of item $item";
    $tl->title($title);
    my $fm = $tl->LabFrame(-labelside => 'acrosstop',
			   -label => $title,
			   )->pack(-padx => 10, -pady => 10,
				   -ipadx => 10,
				   -fill => 'both');
    my $bgcolor = 'ivory';
    $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => 1, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => 1, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');

    my @options = $zinc->itemconfigure($item);
    my $i = 2;
    for my $elem (@options) {
	my ($option, $value) = (@$elem)[0,4];
	next if ($option eq '-visible' or $option eq '-sensitive' or
		 $option eq '-tags' or $option eq '-position' or
		 $option eq '-priority');
	$fm->Label(-text => $option, -relief => 'ridge')
	    ->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
	$fm->Label(-text => $value, -relief => 'ridge')
	    ->grid(-row => $i, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
	$i++;
    }
    $tl->Button(-text => 'Close',
		-command => sub {$tl->destroy})->pack;    

}

sub showgroupattributes {
    my ($zinc, $item) = @_;
    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,
				   -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);
    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')
	->grid(-row => $r++, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe',
	       -columnspan => 2);	# coords
    $fm->Label(-text => 'Coords', -relief => 'ridge')
	->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    my @coords = $zinc->coords($item);
    my $coords;
    if (@coords == 2) {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	$coords = "($x0, $y0)";
    } elsif (@coords == 4) {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	my $x1 = int($coords[2]);
	my $y1 = int($coords[3]);
	$coords = "($x0, $y0, $x1, $y1)";
    } else {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	my $xn = int($coords[$#coords-1]);
	my $yn = int($coords[$#coords]);
	my $n = @coords/2 - 1;
	$coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
    }
    $fm->Label(-text => $coords, -relief => 'ridge')
	->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    # device coords
    $fm->Label(-text => 'Device coords', -relief => 'ridge')
	->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    @coords = $zinc->transform(scalar $zinc->group($item), 1, [@coords]);
    if (@coords == 2) {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	$coords = "($x0, $y0)";
    } elsif (@coords == 4) {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	my $x1 = int($coords[2]);
	my $y1 = int($coords[3]);
	$coords = "($x0, $y0, $x1, $y1)";
    } else {
	my $x0 = int($coords[0]);
	my $y0 = int($coords[1]);
	my $xn = int($coords[$#coords-1]);
	my $yn = int($coords[$#coords]);
	my $n = @coords/2 - 1;
	$coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
    }
    $fm->Label(-text => $coords, -relief => 'ridge')
	->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');

    # options
    $fm->Label(-text => 'Option', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Value', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');

    my @options = $zinc->itemconfigure($item);
    for my $elem (@options) {
	my ($option, $value) = (@$elem)[0,4];
	$fm->Label(-text => $option, -relief => 'ridge')
	    ->grid(-row => $r, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
	if ($option and $option eq '-tags') {
	    $value = join("\n", @$value);
	} elsif ($option and $option eq '-clip' and $value > 0) {
	    $value .= " (". $zinc->type($value) .")";
	}
	$fm->Label(-text => $value, -relief => 'ridge')
	    ->grid(-row => $r, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
	$r++;
    }
    $tl->Button(-text => 'Close',
		-command => sub {$tl->destroy})->pack;    

}


# display in a toplevel the content of a group item
sub showgroupcontent {
    my ($zinc, $group) = @_;
    my $tl = $zinc->Toplevel;
    my $title = "Content of group $group";
    $tl->title($title);
      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.
sub highlightitem {
    my ($btn, $zinc, $item) = @_;
    return if $showitemflag;
    $showitemflag = 1;

    my @itemstohide = ();
    my @visibility = ();
    for ($zinc->find('overlapping', $zinc->coords($rectangle_id))) {
	push (@itemstohide, $_) unless $_ == $rectangle_id or $_ == $text_id;
    }
    for (@itemstohide) {
	push(@visibility, scalar $zinc->itemcget($_, -visible));
	$zinc->itemconfigure($_, -visible => 0);
    }
    my @coords = $zinc->coords($item);
    my $clone = $zinc->clone($item, -visible => 1);
    $zinc->chggroup($clone, 1);
    $zinc->coords($clone, [$zinc->transform(scalar $zinc->group($item), 1, [@coords])]);
    $zinc->raise($clone);
    $btn->bind('<ButtonRelease>', [\&undohighlightitem, $zinc, $clone,
  				 \@itemstohide, \@visibility]);

}


sub undohighlightitem {
    my ($btn, $zinc, $clone, $itemstohide, $visibility) = @_;
    $btn->bind('ReleaseButton', '');
    for (my $i=0; $i < @$itemstohide; $i++) {
	$zinc->itemconfigure($itemstohide->[$i], -visible => $visibility->[$i]);
    }
    $zinc->remove($clone);
    $showitemflag = 0;
}


# print a zinc window in png format
sub printWindow {
    exit if $saving;
    $saving = 1;
    my ($zinc,$basename,$verbosity) = @_;
    my $id = $zinc->id;
    my $filename = $basename . $imagecounter . ".png";
    $imagecounter++;
    my $original_cursor = ($zinc->configure(-cursor))[3];
    $zinc->configure(-cursor => 'watch');
    $zinc->update;
    my $res = system("import", -window, $id, $filename);
    $zinc->configure(-cursor => $original_cursor);
    
    $saving = 0;
    if ($res) {
	&showErrorWhilePrinting($res)
	}
    else {
	my $dir = `pwd`; chomp ($dir);
	print "ZincDebug: Zinc window snapshot saved in $dir". "/$filename\n" if $verbosity;
    }
}

# display complete help screen
sub showErrorWhilePrinting {
    my ($res) = @_;
    my $dir = `pwd`; chomp ($dir);
    $help_print->destroy if $help_print and Tk::Exists($help_print);
    $help_print = $zinc->Dialog(-title => 'Zinc Print info',
				-text =>
				"To acquire a TkZinc window snapshot, you must " .
				"have access to the import command, which is ".
				"part of imageMagic package\n\n".
				"You must also have the rights to write ".
				"in the current dir : $dir",
				-bitmap => 'warning',
				);
    $help_print->after(300, sub {$help_print->grabRelease});
    $help_print->Show();
}

# display complete help screen
sub showhelp {
    my ($w, $ekb, $okb, $pkb) = @_;
    my $eseq = $ekb->[0]."-Button".$ekb->[1];
    my $oseq = $okb->[0]."-Button".$okb->[1];
    my $pseq = $pkb->[0]."-Button".$pkb->[1];
    $help_tl->destroy if $help_tl and Tk::Exists($help_tl);
    $help_tl = $zinc->Dialog(-title => 'Zinc Debug info',
			     -text =>
			     "With <".$oseq."> sequence, create ".
			     "a rectangular area to search items ".
			     "which overlap it.\n\n".
			     "With <".$eseq."> sequence, create ".
			     "a rectangular area to search items ".
			     "which are enclosed in it.\n\n".
			     "With <".$pseq."> you can acquire a " .
			     "snapshot of the full zinc window. ".
			     "It will be saved in the current directory ".
			     "with the name zincsnapshot<n>.png ".
			     "The ImageMagic package must be installed.\n\n".
			     "Strike <Escape> key to display this help ".
			     "message again.",
			     -bitmap => 'info',
			     );
    $help_tl->after(300, sub {$help_tl->grabRelease});
    $help_tl->Show();
}

sub showbanner {
    my $fm = shift;
    my $i = shift;
    my $bgcolor = 'ivory';
    $fm->Label(-text => 'Id', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 1, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Type', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Group', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 3, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Priority', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 4, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Sensitive', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 5, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Visible', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 6, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Coords', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 7, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Device coords', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 8, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Bounding box', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 9, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label(-text => 'Tags', -background => $bgcolor, -relief => 'ridge')
	->grid(-row => $i, -col => 10, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    $fm->Label()->grid(-row => 1, -col => 11, -pady => 10);
     
}

# display in a grid the values of most important attributes 
sub showattributes {
    my ($fm, $items) = @_;
    my $bgcolor = 'ivory';
    my $i = 1;
    &showbanner($fm, $i++);
    for my $item (@$items) {
	# id
	my $idbtn =
	    $fm->Button(-text => $item,
			-foreground => 'red'
			)->grid(-row => $i, -col => 1, -sticky => 'nswe', -ipadx => 5);
	$idbtn->bind('<1>', [\&highlightitem, $zinc, $item]);
	# type
	my $type = $zinc->type($item);
	if ($type eq 'group') {
	    $fm->Button(-text => $type, 
			-command => [\&showgroupcontent, $zinc, $item])
		->grid(-row => $i, -col => 2, -sticky => 'nswe', -ipadx => 5);
	} else {
	    $fm->Label(-text => $type, -relief => 'ridge')
		->grid(-row => $i, -col => 2, -sticky => 'nswe', -ipadx => 5);
	}
	# group
	my $group = $zinc->group($item);
	$fm->Button(-text => $group,
		    -command => [\&showgroupattributes, $zinc, $group])
	    ->grid(-row => $i, -col => 3, -sticky => 'nswe', -ipadx => 5);
	# priority
	$fm->Label(-text => scalar $zinc->itemcget($item, -priority),
		   -relief => 'ridge')
	    ->grid(-row => $i, -col => 4, -sticky => 'nswe', -ipadx => 5);
	# sensitiveness
	$fm->Label(-text => scalar $zinc->itemcget($item, -sensitive),
		   -relief => 'ridge')
	    ->grid(-row => $i, -col => 5, -sticky => 'nswe', -ipadx => 5);
	# visibility
	$fm->Label(-text => scalar $zinc->itemcget($item, -visible),
		   -relief => 'ridge')
	    ->grid(-row => $i, -col => 6, -sticky => 'nswe', -ipadx => 5);
	# coords
	my @coords = $zinc->coords($item);
	my $coords;
	if (@coords == 2) {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    $coords = "($x0, $y0)";
	} elsif (@coords == 4) {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    my $x1 = int($coords[2]);
	    my $y1 = int($coords[3]);
	    $coords = "($x0, $y0, $x1, $y1)";
	} else {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    my $xn = int($coords[$#coords-1]);
	    my $yn = int($coords[$#coords]);
	    my $n = @coords/2 - 1;
	    $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
	}
	$fm->Label(-text => $coords, -relief => 'ridge')
	    ->grid(-row => $i, -col => 7, -sticky => 'nswe', -ipadx => 5);
	# device coords
	@coords = $zinc->transform(scalar $zinc->group($item), 1, [@coords]);
	if (@coords == 2) {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    $coords = "($x0, $y0)";
	} elsif (@coords == 4) {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    my $x1 = int($coords[2]);
	    my $y1 = int($coords[3]);
	    $coords = "($x0, $y0, $x1, $y1)";
	} else {
	    my $x0 = int($coords[0]);
	    my $y0 = int($coords[1]);
	    my $xn = int($coords[$#coords-1]);
	    my $yn = int($coords[$#coords]);
	    my $n = @coords/2 - 1;
	    $coords = "C0=($x0, $y0), ..., C".$n."=($xn, $yn)";
	}
	$fm->Label(-text => $coords, -relief => 'ridge')
	    ->grid(-row => $i, -col => 8, -sticky => 'nswe', -ipadx => 5);
	# bounding box
	my @bbox = $zinc->bbox($item);
	$fm->Label(-text => "($bbox[0], $bbox[1]), ($bbox[2], $bbox[3])",
		   -relief => 'ridge')
	    ->grid(-row => $i, -col => 9, -sticky => 'nswe', -ipadx => 5);
	# tags
  	my @tags = $zinc->gettags($item);
	$fm->Label(-text => join("\n", @tags),
		   -relief => 'ridge')
	    ->grid(-row => $i, -col => 10, -sticky => 'nswe', -ipadx => 5);
	$fm->Button(-text => 'Other options',
		    -command => [\&showotheroptions, $zinc, $item])
	    ->grid(-row => $i, -col => 11, -sticky => 'nswe', -ipadx => 5);
	$i++;
	&showbanner($fm, $i++) if ($i % 15 == 0);
    }
}

# begin to draw rectangular area for search
sub startrectangle {
    my ($widget, $style, $text, $color) = @_;
    if (not $result_tl or not Tk::Exists($result_tl)) {
	$result_tl = $zinc->Toplevel();
	$result_tl->title("Zinc Debug");
	$result_tl->geometry('+10+10');
	$result_tl->Button(-text => 'Close',
			   -command => sub {
			       $result_tl->destroy;
			       $zinc->remove($rectangle_id, $text_id);
			       })->pack(-side => 'bottom');
    }
    $zinc->remove($rectangle_id, $text_id);
    $result_tl->iconify;
    my $ev = $zinc->XEvent;
    ($x0, $y0) = ($ev->x, $ev->y);
    $rectangle_id = $zinc->add('rectangle', 1, [$x0, $y0, $x0, $y0],
			       -linecolor => $color,
			       -linewidth => 2,
			       -linestyle => $style,
			       );
    $text_id = $zinc->add('text', 1,
			  -color => $color,
			  -font => '7x13',
			  -position => [$x0+5, $y0-15],
			  -text => $text,
			  );
  
}

# resize the rectangular area for search
sub resizerectangle {
    my $ev = $zinc->XEvent;
    my ($x, $y) = ($ev->x, $ev->y);
    return unless ($zinc->find('withtag', $rectangle_id));

    $zinc->coords($rectangle_id, 1, 1, [$x, $y]);
    if ($x < $x0) {
	if ($y < $y0) {
	    $zinc->coords($text_id, [$x+5, $y-15]);
	} else {
	    $zinc->coords($text_id, [$x+5, $y0-15]);
	}
    } else {
	if ($y < $y0) {
	    $zinc->coords($text_id, [$x0+5, $y-15]);
	} else {
	    $zinc->coords($text_id, [$x0+5, $y0-15]);
	}
    }
    $zinc->raise($rectangle_id);
    $zinc->raise($text_id);
}

# stop drawing rectangular area for search
sub stoprectangle {
    my ($widget, $searchtype, $text) = @_;
    return unless ($zinc->find('withtag', $rectangle_id));

    my @coords = $zinc->coords($rectangle_id);
    my @items;
    for my $item ($zinc->find($searchtype, @coords)) {
	push (@items, $item) if $item != $rectangle_id and
	    $item != $text_id;
    }
    &showresult($text, $zinc, @items);

}

1;

__END__


=head1 NAME

ZincDebug - a perl module for analysing a Zinc application. 


=head1 SYNOPSIS

 use ZincDebug;
 my $zinc = MainWindow->new()->Zinc()->pack;
 finditems($zinc);

=head1 DESCRIPTION

ZincDebug provides an interface to help developers to debug or analyse Zinc applications.

With B<finditems> function, you are able to scan all items which are enclosed in a rectangular area you have first drawn by drag & drop, or all items which overlap it. Result is a Tk table which presents details (options, coordinates, ...) about found items; you can also highlight a particular item, even if it's not visible, by clicking on its corresponding button in the table.

Press Escape key in the main window of the application to have some help about available input sequences.

    
=head1 FUNCTIONS 


=over

=item B<finditems>($zinc, ?option => value, ...?)

This function creates required Tk bindings to permit items search. You can specify the following options :

=over

=item E<32>E<32>E<32>B<-color> => color

Defines color of search area contour. Default to 'sienna'.

=item E<32>E<32>E<32>B<-enclosedModBtn> => [Mod, Btn]

Defines input sequence used to process "enclosed" search. Default to ['Control', 3].

=item E<32>E<32>E<32>B<-overlapModBtn> => [Mod, Btn]

Defines input sequence used to process "overlap" search. Default to ['Shift', 3].

=item E<32>E<32>E<32>B<-snapshotModBtn> => [Mod, Btn]

Defines input sequence used to process a snapshot of the zinc window. Default to ['Control-Shift', 2].

=item E<32>E<32>E<32>B<-snapshotVerbosity> => boolean

Defines if snapshot should print a message on the terminal. Default to true.

=item E<32>E<32>E<32>B<-snapshotBasename> => "a_string"

Defines the basename used for the file containing the snaphshot. The filename will be <currentdir>/basename<n>.png Defaulted to zincsnapshot.


=back

=back
    
=head1 AUTEURS

Daniel Etienne <etienne@cena.fr>