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

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 => "Genome Labeling Tools");
my ($f) = &CreateMenu($mw);
my ($c, $canvas) = &CreateCanvas($f);
my ($win);



&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 {
    our ($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 {
    our ($canv, $x, $y) = &GetCanvasCoords(@_);
    $canvas->move($allTags[0], $x - $movx, $y - $movy);
    $movx = $x; $movy = $y;
} # MoveItem
# ------------------------------------------------------------
sub EndMoving {
    our ($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 {
    our ($canv, $x, $y) = &GetCanvasCoords(@_);
    my ($sub);
    # Do some error-checking
    $thickness = 1 if $thickness !~ /^\d+$/;

    our @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->createArc(@range, %options);
    }
    elsif ($drawItem eq "line"){
    $id = $canvas->createLine(@range, %options);
    }
    elsif ($drawItem eq "text"){

    my $main = MainWindow->new;
    $main->Label(-text => 'Annotation Entry')->pack; # create an annot
+ation label and pack it
    my $say = $main->Entry(-width => 100);

    $say->pack;

    $main->Button(-text => 'Enter',
              -command => sub{do_say($say)}


     )->pack;
     }

    $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 {
    our ($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 {
    our ($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 => "Mark Region",
              -value => 'rectangle', -command => \&BindStart)
    ->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Add tRNA",
              -value => 'oval', -command => \&BindStart)
    ->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Add rRNA",
              -value => 'line', -command => \&BindStart)
    ->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Add annotatio
+n",
              -value => 'text', -command => \&BindStart)
    ->pack( -anchor => 'w');
    $f->Radiobutton ( -variable => \$drawItem, -text => "Add 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);
    }

 sub do_say {
    my ($what) = @_;
    my $what_val = $what->get;            # use get to access contents
+ of entry

 #   $canvas ->createText($range[0],$range[1], -text =>"$what_val\n");
    $canvas ->createText(50,50, -text =>"$what_val\n");

  }

 # CreateMenu
# ------------------------------------------------------------
[download]