RE: [tcltk-perl] Package Img

[Jeff H. <je...@Ac...>]

The following is a working translation of the Tcl doodle code.
There are others ways to express some of this stuff, but this
works:

#!/usr/bin/perl

use Tcl::Tk qw/:perlTk/;
my $mw = MainWindow->new();
my $c = $mw->Canvas(-background => "white")
  ->pack(-fill => 'both', -expand => 1);

our $id;
doodle($c);

MainLoop;

sub doodle {
    my ($w, $color) = @_;
    my $color = "black" unless defined $color;
    Tcl::Tk::bind($w->interp, $w, '<1>',
		  [\&doodle_start, Tcl::Ev('%x', '%y'), $w, $color]);
    Tcl::Tk::bind($w->interp, $w, '<B1-Motion>',
		  [\&doodle_move, Tcl::Ev('%x', '%y'), $w]);
#   bind $w <1>         [list doodle'start %W %x %y $color]
#   bind $w <B1-Motion> {doodle'move %W %x %y}
}

sub doodle_start {
    my ($x, $y, $w, $color) = @_;
    $id = $w->create('line', $x, $y, $x, $y, -fill => $color);
#   set ::_id [$w create line $x $y $x $y -fill $color]
}

sub doodle_move {
    my ($x, $y, $w) = @_;
    my @coords = $w->coords($id);
    unshift @coords, $x, $y;
    $w->coords($id, @coords);
#   $w coords $::_id [concat [$w coords $::_id] $x $y]
}

  Jeff Hobbs, The Tcl Guy
  http://www.ActiveState.com/, a division of Sophos

> -----Original Message-----
> From: Paul Falbe [mailto:fa...@ca...] 
> Sent: Thursday, September 02, 2004 8:52 AM
> To: Jeff Hobbs
> Cc: tcl...@li...
> Subject: Re: [tcltk-perl] Package Img
> 
> 
> 
> here is my simplistic attach at bind to canvas.  I Can't get it to
> for for "<1>".
> 
> #!/usr/bin/perl
> 
> use Tcl::Tk qw/:perlTk/;
> my $MW = MainWindow->new();
> my $C = $MW->Canvas(-height => '100',
>                     -width => '100' )->pack(-fill => 'both');
> my $f = $C->Frame->pack;
> my $c =$f->Canvas(-width => '100',
>                   -height => '100',
>                   -highlightthickness => 0,
>                   -background => "#ffffff")->pack;
> $c->bind('canvas', '<1>', \&foo);
> 
> MainLoop;
> 
> sub foo {
> print "foo\n";
> }
> 
> On Thu, Sep 02, 2004 at 08:20:14AM -0700, Jeff Hobbs wrote:
> > Paul Falbe wrote:
> > 
> > >Would you happen to have a example of a scribble program 
> using perl Tcl/TK?
> > 
> > Not in Perl Tcl::Tk, but this is so simple the translation should
> > be easy:
> > 
> > From http://wiki.tcl.tk/9625
> > 
> >  proc doodle {w {color black}} {
> >     bind $w <1>         [list doodle'start %W %x %y $color]
> >     bind $w <B1-Motion> {doodle'move %W %x %y}
> >  }
> >  proc doodle'start {w x y color} {
> > 	set ::_id [$w create line $x $y $x $y -fill $color]
> >  }
> >  proc doodle'move {w x y} {
> > 	$w coords $::_id [concat [$w coords $::_id] $x $y]
> >  }
> >  pack [canvas .c -bg white] -fill both -expand 1
> >  doodle       .c
> >  bind .c <Double-3> {%W delete all}
> > 
> > Anyone undertaking the exercise should post it back here for
> > others to see the translation.
> > 
> > -- 
> >     Jeff Hobbs, The Tcl Guy
> >     http://www.ActiveState.com/, a division of Sophos
>