I have been thinking how tricky it can be to design subroutines in perl/Tk which handle the drawing of points or shapes in a Tk::Canvas.  To address this, I've written a module (tentatively called Tk::Draw), which attempts to abstract the lower-level details of drawing, and present the user with a cleaner interface that can capture points as they are drawn.

I'd like to ask for comments on the code in this module, and its functionality.

Typically, there are 3 separate events that are required for drawing in a Canvas.  For example: 

    $canvas->Tk::bind("<Button-1>"        => \&start_mouse);
    $canvas->Tk::bind("<Motion>"          => \&move_mouse);
    $canvas->Tk::bind("<ButtonRelease-1>" => \&stop_mouse);

[download]

It can be tedious to write the code that implements these bindings correctly.

It can also be annoying to have to rebind previously set events for the Canvas.

Finally, it's a hassle to track the current state of the given mouse button, and take the appropriate action.  Is the button down yet?  Is it down, and also moving?  Is the mouse moving, but the button released, so that no more points should be drawn?  Has a different mouse button been clicked, while still in the state of capturing points from the original button?  This module attempts to make these questions unnecessary.

Here is the module, which includes two examples within the pod section.  Example 1 is a very simple script showing just the basics of Tk::Draw.  Example 2 is a somewhat more complex program, and displays some methods of Tk::Draw not shown by the first example. 


package Tk::Draw;

our $VERSION = '0.01';

=head1 NAME

Tk::Draw - Simplifies drawing with a mouse in a perl/Tk Canvas

=head1 DESCRIPTION

This module simplifies the drawing of perl/Tk shapes in a Canvas, usin
+g
a mouse.  Once the first <Button-N> event is detected for the given mo
+use
button N, and in the specified Canvas, the Motion and ButtonRelease ev
+ents
are bound to the same mouse button and Canvas.  All subsequent points 
+are
captured until the final ButtonRelease event occurs.  Finally, any pre
+vious
set bindings for the Canvas and mouse button are reinstated, and the
registered callback is invoked to handle any necessary final processin
+g.

=head1 VERSION

Version 0.01

=head1 SYNOPSIS

use Tk::Draw;

Tk::Draw->new($canvas, \&final_callback, $h_args);

=head1 REQUIRED PARAMETERS

=over 4

=item $canvas

The Tk::Canvas object where the mouse events will be captured.

=item \&final_callback

A callback to invoked when the <ButtonRelease> event occurs.  The argu
+ment
is required, but may be a non-blank string (eg. 'none') if the user is
certain that no final processing is necessary.
(See the section FINAL CALLBACK below)

=item $h_args

An optional reference to a hash containing any of the following argume
+nts:

=over 4

=item 'style'

The style of drawing to be done.  Must be one of:

=over 4

=item 'none'

Does not draw anything, just collects the (x,y) points generated by
moving the mouse over the canvas.

=item 'free'

Joins all points drawn to create freehand lines (this is the default).

=item 'line'

Joins the first point with the most recent point, to create a straight
+ line.

=item 'oval'

Joins the first point with the most recent point to create an oval.

=item 'circle'

JOins the first point with the most recent point to create a circle.

=item 'rectangle'

JOins the first point with the most recent point to create a rectangle
+.

=item 'mouse'

The mouse button to bind the drawing to; one of {'1', '2' or '3'}.
The default is '1'.

=back

=item 'color'

The color of the object being drawn.  (Do not confuse this with the
'fill' argument).  The default color is 'black'.

=item 'fill'

The color with which to fill the drawn shape (does not apply to styles
'free' or 'line').  The default fill is '0' (ie. no fill).

=item 'width'

The width of the shape being draw.  In the case of lines (style 'free'
or 'line'), this referes to the line width; in all other shapes it is
the width of the shape's outline.  The default width is '1'.

=item 'action'

A callback to invoke each time a new point is detected.  It will be pa
+ssed
a reference to an array containing the most recent (x, y) point detect
+ed,
eg. [ 123, 45 ].

=back

=back

=head1 FINAL CALLBACK

The final callback parameter names a subroutine to be invoked
when the mouse button is released.  This subroutine is passed the
following 3 arguments:

=over 4

$o_obj -- The Tk::Draw object

$a_points -- A reference to an array containing the captured coordinat
+e
points, each of which is an array reference in the form [ x, y ]

$a_ids -- A reference to an array containing the ID(s) of the drawn sh
+ape

=back

=head1 METHODS

restart($obj, $h_args)

=over 4

Lets the user reuse the Tk::Draw object, optionally resetting any of
the same arguments as allowed to the new() method.  This method takes
the following 2 arguments:

=over 4

$obj

=over 4

The Tk::Draw object

=back

$h_args

=over 4

An optional hash, with the same values as allowed in the I<new()>
constructor.  (See the I<$h_args> parameter in the REQUIRED PARAMETERS
section above)

=back

=back

=back

transform($obj, $a_points, $xoff, $yoff, $canvas)

=over 4

Allows the recreation of the shape given by the points in $a_points to
an alternate location in the canvas (or in a separate canvas), and ret
+urns
the ID(s) associated with the new shape.  The following arguments are
required:

=over 4

$obj

=over 4

The Tk::Draw object.  The following accessor methods allow retrieval o
+f
the corresponding member data:

=over 4

 $obj->canvas
 $obj->mouse
 $obj->color
 $obj->fill
 $obj->width
 $obj->style

=back

=back

$a_points

=over 4

A reference to an array containing the (x, y) points generated by an
initial call to Tk::Draw::new.  For example:

[ [10, 25], [12, 27], [13, 29], ... ]

=back

$xoff

=over 4

The x-offset by which to vary the new shape from the original

=back

$yoff

=over 4

The y-offset by which to vary the new shape from the original

=back

$canvas

=over 4

An optional Canvas on which to draw the new shape (it defaults to the
current Canvas used by $obj)

=back

=back

=back

=head1 EXAMPLE 1

=begin text

    #!/usr/bin/perl -w
    #
    # A very simple example of Tk::Draw, using each of the various
    # allowable styles.
    ##

    use strict;
    use warnings;
    use Tk;
    use Tk::Draw;

    my $a_style  = [qw[ free  line oval  circle rectangle ]];
    my $a_color  = [qw[ black red  blue  purple orange    ]];
    my $stylenum = 0;
    my $colornum = 0;

    my $mw    = new MainWindow(-title => 'Tk::Draw example');
    my $cv    = $mw->Canvas(-width  => 512, -height => 512)->pack;
    Tk::Draw->new($cv, \&done, { width => 5, fill => 'white' });
    MainLoop;

    # Tk::Draw final callback - change drawing style, and reinstall ca
+llback
    sub done {
        my ($o_obj, $a_points, $a_ids) = @_;
        my $style = $a_style->[++$stylenum % @$a_style];
        my $color = $a_color->[++$colornum % @$a_color];
        $o_obj->restart( { style => $style, color => $color });
    }
    
    
=end text

=head1 EXAMPLE 2

=begin text

    #!/usr/bin/perl -w
    #
    # A more complicated example of Tk::Draw, giving the user more
    # flexibility in choosing options to the constructor (although
    # the color and width are randomized).  This also demonstrates
    # usage of the -action => \&callback argument, to track points
    # as they are drawn, as well as showing the transform() method
    # which is used to make copies of the drawn object.
    ##

    use strict;
    use warnings;
    use Tk;
    use Tk::Draw;

    #############
    ## Globals ##
    #############
    my $a_styles = [qw[ free line oval circle rectangle ]];
    my $a_font   = [qw[ tahoma 12 ]];
    my @all_id1  = ( );
    my @all_id2  = ( );
    my $b_fill   = 0;
    my $lastxy   = "";
    my $style;

    ##################
    ## Main program ##
    ##################
    my $mw = new MainWindow(-title => 'Tk::Draw example');
    my $f1 = $mw->Frame()->pack(-fill => 'x');
    my $f2 = $mw->Frame()->pack(-fill => 'both');
    my $c1 = $f2->Canvas(-wi => 512,-he => 512, -bg => 'white');
    my $c2 = $f2->Canvas(-wi => 512,-he => 512, -bg => '#ffffdf');
    $c1->pack($c2, -side => 'left');

    button($f1, '>Quit (^Q)',          sub { exit }, 'Control-q');
    button($f1, '<Clear Last (space)', \&clear_last, 'space');
    button($f1, '<Clear All (Esc)',    \&clear_all,  'Escape');

    choose_style($f1);
    choose_fill($f1);
    last_point($f1);
    start_drawing($c1);
    MainLoop;

    #################
    ## Subroutines ##
    #################
    sub button {
        my ($w, $text, $c_cmd, $bind) = @_;
        my $side = ($text =~ s/^([<>])//)? $1: '<';
        my $bt = $w->Button(-bg => '#ffafef', -text => $text);
        $bt->configure(-comm => $c_cmd, -font => $a_font);
        if ($bind || 0) {
            $w->toplevel->bind("<$bind>" => sub { $bt->invoke });
        }
        $bt->pack(-side => ($side eq '<')? 'left': 'right');
    }

    sub random_color {
        sprintf "#%02x%02x%02x", rand(256), rand(256), rand(256);
    }

    sub clear_last {
        my $a_id1 = pop @all_id1;
        my $a_id2 = pop @all_id2;
        map { $c1->delete($_) } @$a_id1;
        map { $c2->delete($_) } @$a_id2;
    }

    sub clear_all {
        while (@all_id1 > 0) {
            clear_last();
        }
    }

    sub labeled_frame {
        my ($w, $text) = @_;
        my $fr = $w->Frame(-relief => 'ridge', -borderwidth => 4);
        my $lb = $fr->Label(-text  => $text, -font => $a_font);
        $fr->pack(-side => 'left');
        $lb->pack(-side => 'left');
        return $fr;
    }

    sub choose_style {
        my ($w) = @_;
        my $fr   = labeled_frame($w, "Style");
        my @args = (
            -bg       => '#7fcfff',
            -variable => \$style,
            -command  => \&start_drawing,
            -font     => $a_font,
        );
        my $opt = $fr->Optionmenu(@args);
        map { $opt->addOptions($_) } @$a_styles;
        $style = 'free';
        $opt->pack(-side => 'left');
    }

    sub choose_fill {
        my ($w) = @_;
        my $fr     = labeled_frame($w, "Fill Shapes");
        my $a_comm = [
            -font     => $a_font,
            -variable => \$b_fill,
            -command  => \&start_drawing,
        ];
        my $a_no   = [ -text => "No",  -value => 0 ];
        my $a_yes  = [ -text => "Yes", -value => 1 ];
        my $r_no   = $fr->Radiobutton(@$a_no,  @$a_comm);
        my $r_yes  = $fr->Radiobutton(@$a_yes, @$a_comm);
        $r_no->pack($r_yes, -side => 'left');
    }

    sub last_point {
        my ($w) = @_;
        my $fr  = labeled_frame($w, "Last Point");
        my $lbl = $fr->Label(-textvar => \$lastxy, -font => $a_font);
        $lbl->pack(-side => 'left');
    }

    #======================#
    ## Tk::Draw interface ##
    #======================#
    sub start_drawing {
        my $width = int(1 + rand(32));
        my $color = random_color();
        my $fill  = $b_fill? random_color: 0;

        my $h_opts = {
            'width'  => $width,
            'color'  => $color,
            'fill'   => $fill,
            'style'  => $style,
            'action' => \&show_last,
        };

        new Tk::Draw($c1, \&done_drawing, $h_opts);
    }

    sub show_last {
        my ($a_point) = @_;
        my ($x, $y) = @$a_point;
        $lastxy = sprintf "($x, $y)";
    }

    sub done_drawing {
        my ($o_obj, $a_points, $a_ids) = @_;
        push @all_id1, $a_ids;
        push @all_id2, Tk::Draw::transform($o_obj, $a_points, 0, 0, $c
+2);
        start_drawing();
    }
    

=end text

=head1 AUTHOR

John C. Norton

=head1 COPYRIGHT & LICENSE

Copyright 2009 John C. Norton.

This program is free software; you can redistribute it and/or modify i
+t
under the terms of either: the GNU General Public License as published
by the Free Software Foundation; or the Artistic License.

See http://dev.perl.org/licenses/ for more information.

=cut

###############
## Libraries ##
###############
use strict;
use warnings;
use Carp;
use Tk;


#############
## Globals ##
#############
my $b_drawing = 0;        # Disallow multiple simultaneous invocations

my $h_defaults = {
    'mouse'   => 1,
    'color'   => 'black',
    'fill'    => 0,
    'width'   => 1,
    'action'  => 0,
    'style'   => 'free',
};

my $h_aliases = {
    'a' => 'action',
    'c' => 'color',
    'f' => 'fill',
    'm' => 'mouse',
    'w' => 'width',
    's' => 'style',
};

my $h_styles = {
    'none'      => 'Do not draw anything, just collect points',
    'free'      => 'Join all points to create freehand lines (default)
+',
    'line'      => 'Join first/last points to create straight lines',
    'oval'      => 'Join first/last points to create ovals',
    'circle'    => 'Join first/last points to create circles',
    'rectangle' => 'Join first/last points to create rectangles',
};


###############
## Libraries ##
###############
sub new {
    my ($proto, $canvas, $c_result, $h_args) = @_;

    my $self = { 'points' => [ ], 'ids' => [ ], 'bindings' => { } };
    bless $self, $proto;

    $self->assign_args($h_args);

    ($canvas   || 0) or $self->fatal("Missing Canvas argument (arg \$1
+)");
    ($c_result || 0) or $self->fatal("Missing result callback (arg \$2
+)");

    $self->{'canvas'} = $canvas;
    $self->{'result'} = $c_result;

    my $mouse  = $self->{'mouse'};
    my $event  = $self->{'start_event'};
    my $a_draw = [ sub { $self->start_drawing(@_) }, Ev('x'), Ev('y') 
+];
    $self->new_binding($canvas, $event, $a_draw);

    return $self;
}


###############
## Accessors ##
###############
sub canvas { my ($self) = @_; $self->{'canvas'} }
sub mouse  { my ($self) = @_; $self->{'mouse'}  }
sub color  { my ($self) = @_; $self->{'color'}  }
sub fill   { my ($self) = @_; $self->{'fill'}   }
sub width  { my ($self) = @_; $self->{'width'}  }
sub style  { my ($self) = @_; $self->{'style'}  }


##########################
## User-visible Methods ##
##########################
sub restart {
    my ($self, $h_args) = @_;
    $self->assign_args($h_args);
    my $canvas = $self->{'canvas'};
    my $event  = $self->{'start_event'};
    my $a_draw = [ sub { $self->start_drawing(@_) }, Ev('x'), Ev('y') 
+];
    $self->new_binding($canvas, $event, $a_draw);
}


sub transform {
    my ($self, $a_points, $xoff, $yoff, $canvas) = @_;
    my $a_ids = [ ];
    my ($x0, $y0);

    $canvas  ||= $self->canvas;
    my $color  = $self->color;
    my $fill   = $self->fill;
    my $width  = $self->width;
    my $style  = $self->style;

    for (my $i = 0; $i < @$a_points; $i++) {
        my $a_point   = $a_points->[$i];
        my ($x1, $y1) = ( $a_point->[0] + $xoff, $a_point->[1] + $yoff
+ );

        if ($i > 0) {
            my @args = ($x0, $y0, $x1, $y1);
            if ($style eq 'free' or $style eq 'line') {
                push @args, -width => $width;
                $color and push @args, -fill => $color;
                push @$a_ids, $canvas->createLine(@args);
            } elsif ($style eq 'oval') {
                push @args, -width => $width, -outline => $color;
                $fill and push @args, -fill => $fill;
                push @$a_ids, $canvas->createOval(@args);
            } elsif ($style eq 'rectangle') {
                push @args, -width => $width, -outline => $color;
                $fill and push @args, -fill => $fill;
                push @$a_ids, $canvas->createRectangle(@args);
            } elsif ($style eq 'circle') {
                my $rad  = sqrt(($x1 - $x0) ** 2 + ($y1 - $y0) ** 2);
                @args = ($x0 - $rad, $y0 - $rad, $x0 + $rad, $y0 + $ra
+d);
                push @args, -width => $width, -outline => $color;
                $fill and push @args, -fill => $fill;
                push @$a_ids, $canvas->createOval(@args);
            }
        }

        ($x0, $y0) = ($x1, $y1);
    }

    return $a_ids;
}


######################
## Internal Methods ##
######################
sub fatal {
    my ($self, $errmsg) = @_;
    carp "$errmsg\n";
    exit;
}


sub new_binding {
    my ($self, $canvas, $binding, $a_args) = @_;
    my $c_prev = $canvas->Tk::bind($binding);
    $self->{'bindings'}->{$binding} = $c_prev;
    $canvas->Tk::bind($binding => $a_args);
}


sub restore_bindings {
    my ($self, $canvas, $binding) = @_;
    my $c_prev = delete $self->{'bindings'}->{$binding};
    $canvas->Tk::bind($binding => $c_prev);
}


sub styles {
    print "[Available Tk::Draw styles]\n";
    foreach my $key (sort keys %$h_styles) {
        my $desc = $h_styles->{$key};
        printf "%10.10s .... %s\n", $key, $desc;
    }
}


sub assign_args {
    my ($self, $h_args) = @_;

    # Make a copy of user-supplied args, resolving aliases
    $h_args ||= { };
    my $h_copy = { };
    foreach my $k (keys %$h_args) {
        my $key = $h_aliases->{$k} || $k;
        $h_copy->{$key} = $h_args->{$k};
    }

    # Resolve all arguments
    foreach my $key (keys %$h_defaults) {
        my $val = delete $h_copy->{$key};
        if (defined($val)) {
            $self->{$key} = $val;
        } elsif (!defined($self->{$key})) {
            $self->{$key} = $h_defaults->{$key};
        }
    }

    # Give an error if any arguments were invalid
    my @leftover = keys %$h_copy;
    if (@leftover > 0) {
        my $s = (1 == @leftover)? "": "s";
        my $errstr = "Unknown Tk::Draw arg$s:  ";
        for (my $i = 0; $i < @leftover; $i++) {
            my $arg = $leftover[$i];
            $errstr .= ($i > 0)? ", '$arg'": "'$arg'";
        }
        $self->fatal($errstr);
    }

    # Determine action when mouse button is clicked/moving/released
    my $style = $self->{'style'};
    if (!exists($h_styles->{$style})) {
        my $styles = join(', ', keys %$h_styles);
        $self->fatal("Unknown style '$style' (must be one of {$styles}
+)");
    }

    # Validate the mouse button
    my $mouse = $self->{'mouse'};
    if ($mouse !~ /^[123]$/) {
        $self->fatal("Unknown mouse '$mouse' (must be one of {1, 2, 3}
+)");
    }

    # Assign events
    $self->{'start_event'} = "<Button-$mouse>";
    $self->{'stop_event'}  = "<ButtonRelease-$mouse>";
}


sub start_drawing {
    my ($self, $canvas, $x, $y) = @_;

    $b_drawing++ and return;

    push @{$self->{'points'}}, [ $self->{'x'} = $x, $self->{'y'} = $y 
+];

    my $a_move = [ sub { $self->keep_drawing(@_) }, Ev('x'), Ev('y') ]
+;
    $self->new_binding($canvas, '<Motion>', $a_move);

    my $a_stop = [ sub { $self->stop_drawing(@_) }, Ev('x'), Ev('y') ]
+;
    $self->new_binding($canvas, $self->{'stop_event'}, $a_stop);

    my $c_action = $self->{'action'};
    ($c_action || 0) and $c_action->([ $x, $y ]);
}


sub keep_drawing {
    my ($self, $canvas, $x1, $y1) = @_;

    my ($x0, $y0) = ($self->{'x'}, $self->{'y'});

    my $style = $self->{'style'};
    if ($style ne 'none') {
        my $method = "style_$style";
        $self->$method($canvas, [ $x0, $y0, $x1, $y1 ]);
    }

    my $c_action = $self->{'action'};
    ($c_action || 0) and $c_action->([ $x1, $y1 ]);
}


sub stop_drawing {
    my ($self, $canvas, $x, $y) = @_;

    my $h_bindings = $self->{'bindings'};
    foreach my $binding (keys %$h_bindings) {
        $self->restore_bindings($canvas, $binding);
    }

    my $c_result = $self->{'result'};
    my $a_points = $self->{'points'};
    my $a_ids    = $self->{'ids'};

    $self->{'points'} = [ ];
    $self->{'ids'}    = [ ];

    if (ref $c_result eq 'CODE') {
        $c_result->($self, $a_points, $a_ids, $canvas);
    }
    $b_drawing = 0;
}


#==========#
## Styles ##
#==========#
sub style_free {
    my ($self, $canvas, $a_points) = @_;

    my ($x0, $y0, $x1, $y1) = @$a_points;

    my $width = $self->{'width'};
    my $color = $self->{'color'};
    my $a_ids = $self->{'ids'};

    my @args = ( -width => $width, -fill => $color );
    push @$a_ids, $canvas->createLine($x0, $y0, $x1, $y1, @args);
    push @{$self->{'points'}}, [ $self->{'x'} = $x1, $self->{'y'} = $y
+1 ];
}


sub style_line {
    my ($self, $canvas, $a_points) = @_;

    my ($x1, $y1) = ($a_points->[-2], $a_points->[-1]);
    my ($x0, $y0) = @{$self->{'points'}->[0]};

    my $width = $self->{'width'};
    my $color = $self->{'color'};
    my $a_ids = $self->{'ids'};

    if (@$a_ids > 0) {
        pop @{$self->{'points'}};
        my $id = pop @{$self->{'ids'}};
        $canvas->delete($id);
    }

    my @args = ( -width => $width, -fill => $color );
    push @$a_ids, $canvas->createLine($x0, $y0, $x1, $y1, @args);
    push @{$self->{'points'}}, [ $self->{'x'} = $x1, $self->{'y'} = $y
+1 ];
}


sub style_oval {
    my ($self, $canvas, $a_points) = @_;

    my ($x1, $y1) = ($a_points->[-2], $a_points->[-1]);
    my ($x0, $y0) = @{$self->{'points'}->[0]};

    my $width = $self->{'width'};
    my $color = $self->{'color'};
    my $fill  = $self->{'fill'};
    my $a_ids = $self->{'ids'};

    if (@$a_ids > 0) {
        pop @{$self->{'points'}};
        my $id = pop @{$self->{'ids'}};
        $canvas->delete($id);
    }

    my @args = ( -width => $width, -outline => $color );
    $fill and push @args, -fill => $fill;
    push @$a_ids, $canvas->createOval($x0, $y0, $x1, $y1, @args);
    push @{$self->{'points'}}, [ $self->{'x'} = $x1, $self->{'y'} = $y
+1 ];
}


sub style_rectangle {
    my ($self, $canvas, $a_points) = @_;

    my ($x1, $y1) = ($a_points->[-2], $a_points->[-1]);
    my ($x0, $y0) = @{$self->{'points'}->[0]};

    my $width = $self->{'width'};
    my $color = $self->{'color'};
    my $fill  = $self->{'fill'};
    my $a_ids = $self->{'ids'};

    if (@$a_ids > 0) {
        pop @{$self->{'points'}};
        my $id = pop @{$self->{'ids'}};
        $canvas->delete($id);
    }

    my @args = ( -width => $width, -outline => $color );
    $fill and push @args, -fill => $fill;
    push @$a_ids, $canvas->createRectangle($x0, $y0, $x1, $y1, @args);
    push @{$self->{'points'}}, [ $self->{'x'} = $x1, $self->{'y'} = $y
+1 ];
}


sub style_circle {
    my ($self, $canvas, $a_points) = @_;

    my ($x1, $y1) = ($a_points->[-2], $a_points->[-1]);
    my $a_center  = $self->{'points'}->[0];
    my ($x0, $y0) = @$a_center;
    my $rad       = sqrt(($x1 - $x0) ** 2 + ($y1 - $y0) ** 2);

    # Create the box surrounding the larger circle
    my $a_corner1 = [ $x0 - $rad, $y0 - $rad ];
    my $a_corner2 = [ $x0 + $rad, $y0 + $rad ];

    my $width = $self->{'width'};
    my $color = $self->{'color'};
    my $fill  = $self->{'fill'};
    my $a_ids = $self->{'ids'};

    if (@$a_ids > 0) {
        pop @{$self->{'points'}};
        my $id = pop @{$self->{'ids'}};
        $canvas->delete($id);
    }

    my @args = ( -width => $width, -outline => $color );
    $fill and push @args, -fill => $fill;
    push @$a_ids, $canvas->createOval(@$a_corner1, @$a_corner2, @args)
+;
    push @{$self->{'points'}}, [ $self->{'x'} = $x1, $self->{'y'} = $y
+1 ];
}


1;

[download]

Some questions I have and would appreciate feedback for:

  1. Is Tk::Draw a valid name for this module?  Too general?
  2. Is this functionality useful enough to submit to CPAN?
  3. Do the "styles" of drawing allowed (eg. "free", "line", "oval", "circle", "rectangle") cover enough of the most commonly required drawing methods?
  4. Are there other "styles" that should be implemented?
  5. Are there other features that would be useful to add to the module?

Thank you in advance for any comments, feedback or insights!

s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/

Replies are listed 'Best First'.
Re: RFC: A Tk module to simplify drawing - Tk::Draw
by zentara (Cardinal) on Dec 02, 2009 at 12:05 UTC
    .... cool, after a quick run of the examples, my thoughts:

    ... at least add bezier lines, like is shown in most gui demos

    ... i like the way you can transfer the geometric data across canvases....people have been looking for a good way to do this for awhile.... so you can have "shared drawing whiteboards" across sockets.....

    ... other features?.... yes, besides socket_abilty :-), people also want to save what they have done..... it would be nice the data to a file, and be able to reload it later

    .... i'm sure i'll think up something later ..... like oh yeah... an eraser function for the lines....if you need a quick idea of the data you would have to save for an eraser to work on a smoothed line curve....see ztk-roller-coaster-simulation

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku
[reply]
Re: RFC: A Tk module to simplify drawing - Tk::Draw
by Anonymous Monk on Dec 02, 2009 at 05:09 UTC
    Is Tk::Draw a valid name for this module? Too general?

    Yup, its too general, maybe Tk::Canvas::MouseDraw? MouseTrap? MouseRecord?

    Is this functionality useful enough to submit to CPAN?

    Sure

    Do the "styles" of drawing allowed (eg. "free", "line", "oval", "circle", "rectangle") cover enough of the most commonly required drawing methods?

    Its a good start, but since Canvas doesn't have too many types you should include them all :)

[reply]
Re: RFC: A Tk module to simplify drawing - Tk::Draw
by hangon (Deacon) on Dec 02, 2009 at 19:55 UTC

    I like it. Thanks for the distraction from a tedious project.

    IMHO Tk::Draw is clear and unambiguous, though there are those who would like to reserve obvious namespaces for posterity. Perhaps Tk:Canvas:Draw would be a bit more accurate and less controversial.

    It certainly is functional enough to submit to CPAN, where you should be able to get more feedback. My feature suggestions:

    • Have a plugin arcitecture for adding additional styles as needed.
    • An option for start and/or end points to snap to the nearest point from another shape.

[reply]
Re: RFC: A Tk module to simplify drawing - Tk::Draw
by liverpole (Monsignor) on Dec 09, 2009 at 17:42 UTC
    Thanks for all your comments.

    I have requested the namespace Tk::Canvas::Draw, which I agree seems like the best choice.

    zentara:  Certainly bezier lines would be a good addition; I'll plan to include them soon.  As far as saving data for later, you could do that very easily with use Storable, so I didn't explicitly provide the capability.  And when you say:

        "...an eraser function for the lines"

    You do realize, don't you, that the IDs of all lines/shapes drawn are passed to the results subroutine?  Thus, deleting those shapes is as easy as: 

    my $o_obj = new Tk::Draw($c1, \&done_drawing, $h_opts);

sub done_drawing {
    my ($o_obj, $a_points, $a_ids) = @_;
    map { $o_obj->canvas->delete($_) } @a_ids;
}

    [download]

    But perhaps I'll simplify that further, and provide a delete_shapes method to the object.

    hangon:  Thanks for confirming the name (Tk::Canvas::Draw) that I was considering as an alternative for the module.

    As for your two specific suggestions, plugins and "snapping points to a shape", if you wouldn't mind providing me with more details, or even some example code, I'd be more than happy to consider both of them.

    s''(q.S:$/9=(T1';s;(..)(..);$..=substr+crypt($1,$2),2,3;eg;print$..$/
[reply]
[d/l]

Back to Meditations