Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

very primitive drawing tool (was: Re: simple drawing tool)

by strat (Canon)
on Oct 22, 2002 at 11:19 UTC ( #207032=note: print w/ replies, xml ) Need Help??


in reply to simple drawing tool

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"


Comment on very primitive drawing tool (was: Re: simple drawing tool)
Download Code
Re: very primitive drawing tool (was: Re: simple drawing tool)
by traveler (Parson) on Oct 22, 2002 at 15:07 UTC
    This is very much the kind of start I was looking for.
    Thanks!

    --traveler

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://207032]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (8)
As of 2014-09-17 05:01 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    How do you remember the number of days in each month?











    Results (57 votes), past polls