About two years ago, I played around a bit with Tk and wrote a very primitive drawing program based on the one displayed in "Starting Tk" from Nancy Walsh. Maybe it could help you writing your own one, although it is just a quick hack:
#! /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
# ------------------------------------------------------------
Best regards,
perl -e "s>>*F>e=>y)\*martinF)stronat)=>print,print v8.8.8.32.11.32"
