Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
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"


In reply to very primitive drawing tool (was: Re: simple drawing tool) by strat
in thread simple drawing tool by traveler

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chilling in the Monastery: (12)
    As of 2014-09-02 20:43 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      My favorite cookbook is:










      Results (29 votes), past polls