#!/usr/bin/perl

use strict;
use warnings;
use Data::Dumper qw/Dumper/;
use Tk;

my $mw = tkinit();

my $canvas = $mw->Canvas()->pack(-expand => 1, -fill => 'both',);

# -------------------------------------------------------------
# --- left box
my $left = $canvas->createText(
        50, 50,
        -text => 'left',
        -tags => [qw/left text id1/]
);
my @left_bbox = $canvas->bbox('left', 'id1');
my $padding = 3;
$canvas->createRectangle(
        $left_bbox[0] - $padding, $left_bbox[1] - $padding,
        $left_bbox[2] + $padding, $left_bbox[3] + $padding,
        -fill => 'green',
        -tags => [qw/left box id1/]
);
$canvas->raise('text', 'box');

# -------------------------------------------------------------
# --- right box
my $right = $canvas->createText(
        250, 50,
        -text => 'right',
        -tags => [qw/right text id5/]
);
my @right_bbox = $canvas->bbox('right', 'id5');
$canvas->createRectangle(
        $right_bbox[0] - $padding, $right_bbox[1] - $padding,
        $right_bbox[2] + $padding, $right_bbox[3] + $padding,
        -fill => 'yellow',
        -tags => [qw/right box id5/]
);
$canvas->raise('text', 'box');


# -- store point of origin here:
my $origin_x = undef;
my $origin_y = undef;


$canvas->bind('left', '<Button-1>' , [ 
	sub{ start_drawing_xy(@_); }, 
	Ev('x'), Ev('y'), 
	\$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<B1-Motion>' , [ 
	sub{ motion_xy(@_); }, 
	Ev('x'), Ev('y'), 
	\$origin_x, \$origin_y 
]);
$canvas->Tk::bind('<ButtonRelease>' , [ 
	sub{ stop_drawing_xy(@_); }, 
	Ev('x'), Ev('y'), 
	\$origin_x, \$origin_y 
]);

$mw->MainLoop();


=head2 start_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub start_drawing_xy {
	my $canvas = shift;
	my $x = shift;
	my $y = shift;
	my $origin_x = shift;
	my $origin_y = shift;
	
	$$origin_x = $x;
	$$origin_y = $y;
	
	printf("init drawing from vertex <%s, %s>\n", $x, $y);
} # /start_drawing_xy




=head2 motion_xy( $canvas, $x, $y )

Draw a line from source vertex to current vertex. Current vertex is the vertex
of the current mouse cursor position while button 1 is pressed.

=cut

sub motion_xy {
	my $canvas = shift;
	my $x = shift;
	my $y = shift;
	my $origin_x = shift;
	my $origin_y = shift;

	# catch unset origin
	return unless $$origin_x;

	# -- delete old line
	$canvas->delete('line');
	
	# -- draw new line
	$canvas->createLine($$origin_x, $$origin_y, $x, $y, -tags => [qw/line/]);

	printf("draw line from source vertex <%s, %s> to current vertex <%s, %s>\n", 
		$$origin_x, $$origin_y, $x, $y);
} # /motion_xy




=head2 stop_drawing_xy( $canvas, $x, $y, \$origin_x, \$origin_y )

=cut

sub stop_drawing_xy {
	my $canvas = shift;
	my $x = shift;
	my $y = shift;
	my $origin_x = shift;
	my $origin_y = shift;
	
	$$origin_x = $x;
	$$origin_y = $y;
	
	$canvas->delete('line');
	
	# -- Check if there is a valid target widget at <$x, $y>. If not, delete
	# the line && do nothing.
	my $w = $canvas->find("overlapping", $x, $y, $x+1, $y+1);
	print (defined $w ? "defined\n" : "undef\n");
	return undef unless defined $w;
	#print Dumper($w);
	
	my $id = undef;
	WIDGETS: foreach my $widget ( @{$w} ) {

		my @tags = $canvas->itemcget($widget, '-tags');
		next unless @tags;
		
		foreach my $tag ( @tags ) {
			if( $tag =~ m/^id\d+$/ ) {
				$id = $tag;
				last WIDGETS;
			}
		}
	}
	
	return undef unless $id; # there was no valid widget :-(
	
	print "target widget id = $id\n";
	
	
	
	printf("stop drawing from vertex <%s, %s> to vertex <%s, %s>\n", 
		$$origin_x, $$origin_y, $x, $y, );
} # /stop_drawing_xy