#        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 $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' );
    }
    my $color = ($options{-color}) ? $options{-color} : 'sienna';
    my $ekb = ($options{-enclosedModBtn}) ? $options{-enclosedModBtn} :	['Control', 3];
    my $okb = ($options{-overlapModBtn}) ? $options{-overlapModBtn} : ['Shift', 3];
    carp "in ZincDebug module, finditems function, enclosed search won't work because ".
	"both search process use the same sequence [$ekb->[0], $ekb->[1]]\n" if
	    $ekb->[0] eq $okb->[0] and $ekb->[1] eq $okb->[1];
    #
    # binding for help screen
    #
    $zinc->toplevel->Tk::bind('<Key-Escape>', [\&showhelp, $ekb, $okb]);
    #
    # 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']);
}

#------------------------------------------------------------------------------------
# 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 = MainWindow->new()->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 = MainWindow->new()->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;
    # 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])
	->grid(-row => $r++, -col => 2, -ipady => 10, -ipadx => 5, -sticky => 'nswe');
    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 = MainWindow->new()->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);
    &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('overlap', $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;
}


# display complete help screen
sub showhelp {
    my ($w, $ekb, $okb) = @_;
    my $eseq = $ekb->[0]."-Button".$ekb->[1];
    my $oseq = $okb->[0]."-Button".$okb->[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".
			     "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 = MainWindow->new()->toplevel();
	$result_tl->title("Zinc Debug");
	$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);
    $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) = @_;
    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].


=back

=back
    
=head1 AUTEURS

Daniel Etienne <etienne@cena.fr>