#! /usr/bin/perl -w
use strict;
use Tk;

my @colors = qw(white yellow orange red magenta 
		cyan blue green gray brown black
		);

# starting values
my $drawItem = "rectangle";
my $thickness = 1;
my $color = "blue";

my ($movx, $movy) = (-1, -1);
my ($startx, $starty, $currentItem) = (-1,-1,"");
my @items;
my @allTags;

my $mw = MainWindow->new(-title => "Quick Draw");
my ($f) = &CreateMenu($mw);
my ($c, $canvas) = &CreateCanvas($f);

&BindStart();

MainLoop;
# ------------------------------------------------------------
sub CreateCanvas {
    my ($f) = shift;
    my $c = $mw->Scrolled("Canvas", -cursor => 'crosshair', 
                          -scrollbars => 'se')
	->pack( -side => 'left', -fill => 'both', -expand => 1);
    my $canvas = $c->Subwidget("canvas");

    return ($c, $canvas);
} # CreateCanvas
# ------------------------------------------------------------
sub BindStart {
    
    # if there's a "Motion"-binding, we need to allow the user
    # to finish drawing the item before rebinding Button-1
    # This fcn gets called when we finish drawing the item again
    my @bindings = $canvas->Tk::bind("<Motion>");
    return if ($#bindings >= 0);

    if ($drawItem eq "rectangle" or $drawItem eq "oval" or 
        $drawItem eq "line"){
	$canvas->Tk::bind("<Button-1>", 
           [\&StartDrawing, Ev('x'), Ev('y')] );
	$canvas->Tk::bind("<Button-3>", 
           [ \&StartMoving, Ev('x'), Ev('y') ]);
	$canvas->Tk::bind("<Button-2>", "");
    }
} # BindStart
# ------------------------------------------------------------
sub StartMoving {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);

    @allTags = $canvas->find("closest", $x, $y);
    print ("Moving: $x/$y: @allTags\n");
    $movx = $x; $movy = $y;
    
    $canvas->Tk::bind("<Button-1>", "");
    $canvas->Tk::bind("<Button-2>", "");
    $canvas->Tk::bind("<Motion>", 
        [ \&MoveItem, Ev('x'), Ev('y') ] );
    $canvas->Tk::bind("<Button-3>", 
        [ \&EndMoving, Ev('x'), Ev('y') ] );

} # StartMoving
# ------------------------------------------------------------
sub MoveItem {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);
    $canvas->move($allTags[0], $x - $movx, $y - $movy);    
    $movx = $x; $movy = $y;
} # MoveItem
# ------------------------------------------------------------
sub EndMoving {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);
    $canvas->Tk::bind("<Motion>", "");
    $canvas->Tk::bind("<Button-3>", 
         [ \&StartMoving, Ev('x'), Ev('y') ] );
    $canvas->move($allTags[0], $x - $movx, $y - $movy);    
    &BindStart;
} # EndMoving
# ------------------------------------------------------------
sub CancelDrawing {
    my ($canv) = @_;
    print ("Cancel drawing\n");
    $canvas->delete("drawmenow");
    $canvas->dtag("drawmenow");
    $canvas->Tk::bind("<Motion>", "");
    $canvas->Tk::bind("<Button-2>", "");
    $startx = -1; $starty = -1;
    $currentItem = "";
    &BindStart();
} # CancelDrawing
# ------------------------------------------------------------
sub StartDrawing {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);

    # Do some error-checking
    $thickness = 1 if $thickness !~ /^\d+$/;

    my @range = ($x, $y, $x, $y);
    my %options = ( -width => $thickness, -tags => "drawmenow",
		    -fill => $color,  );
    my ($id);
    if ($drawItem eq "rectangle"){
	$id = $canvas->createRectangle(@range, %options);
    }
    elsif ($drawItem eq "oval"){
	$id = $canvas->createOval(@range, %options);
    }
    elsif ($drawItem eq "line"){
	$id = $canvas->createLine(@range, %options);
    }
    $currentItem = $id;    $startx = $x; $starty = $y;

    # Map Button-1 binding to &EndDrawing instead of &StartDrawing
    $canvas->Tk::bind("<Motion>", 
          [\&SizeItem, Ev('x'), Ev('y') ]);
    $canvas->Tk::bind("<Button-1>", 
          [\&EndDrawing, Ev('x'), Ev('y') ]);
    $canvas->Tk::bind("<Button-2>", \&CancelDrawing);

} # StartDrawing
# ------------------------------------------------------------
sub EndDrawing {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);

    # finish the size of the item, and remove tag
    $canvas->Tk::bind("drawmenow", "<Enter>", \&DeleteItem);
    $canvas->coords("drawmenow", $startx, $starty, $x, $y);
    $canvas->dtag("drawmenow");   # remove tag
    $canvas->Tk::bind("<Motion>", ""); # remove motion binding

    push (@items, { -id => $currentItem,
		    -color => $color,
		    -range => [$startx, $starty, $x, $y],
		    }
	  );
    print ("$currentItem: $color: $startx, $starty, $x, $y\n");

    $currentItem = "";
    $startx = -1; $starty = -1;
    $canvas->Tk::bind("<Button-2>", "");
    &BindStart();
} # EndDrawing
# ------------------------------------------------------------
sub SizeItem {
    my ($canv, $x, $y) = &GetCanvasCoords(@_);
    $canvas->coords("drawmenow", $startx, $starty, $x, $y);
} # SizeItem
# ------------------------------------------------------------
sub GetCanvasCoords {
    return ($_[0], $_[0]->canvasx($_[1]), $_[0]->canvasy($_[2]) );
} # GetCanvasCoords
# ------------------------------------------------------------
sub CreateMenu {
    my ($mw) = shift;

    my $f = $mw->Frame( -relief => 'groove', -bd => 2, 
                        -label => "Draw:");
    $f->pack( -side => 'left', -fill => 'y');
    
    $f->Radiobutton ( -variable => \$drawItem, -text => "Rectangle",
		      -value => 'rectangle', -command => \&BindStart)
	->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Oval",
		      -value => 'oval', -command => \&BindStart)
	->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Line",
		      -value => 'line', -command => \&BindStart)
	->pack( -anchor => 'w');
    
    $f->Label( -text => "Line width:")->pack( -anchor => 'w');
    $f->Entry( -textvariable => \$thickness)->pack( -anchor => 'w');
    $f->Label( -text => "Color:")->pack( -anchor => 'w');
    foreach (@colors){
	$f->Radiobutton( -variable => \$color, -text => $_,
			 -value => $_, -command => \&BindStart)
	    ->pack( -anchor => 'w');
    }
    return ($f);
} # CreateMenu
# ------------------------------------------------------------