Re: [tcltk-perl] Package Img

[Paul F. <fa...@ca...>]

On Tue, Sep 07, 2004 at 11:18:56PM -0700, Jeff Hobbs wrote:
> Konovalov, Vadim wrote:
> >>One strange thing on your doodle.pl It works great on
> >>my i386 Linux box which has tcl/tk 8.4.7 but on my CASIO which has
> >>8.4.4 all lines start from the upper left-hand corner.  Any ideas??
> >
> >
> >I saw same behaviour, and I didn't realized why it behaves that way.
> 
> This may be a bug in the %x/%y translation on Win/CE only.
> I haven't confirmed this, but there are some bugs in the
> Win/CE port still where functionality has to be emulated
> because the CE OS doesn't currently support it.

Here's what I did to make it work.  Forgot to post it, Sorry.  I took a flare
and did the same thing Slaven Rezic does in his Tk::Sketch module.
And returned if "return if $x < 0 || $y < 0;" in the doodle_start
and doodle_move functions.  I guess Tk has the same problem?


#!/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) = @_;
return if $x < 0 || $y < 0;
    $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) = @_;
return if $x < 0 || $y < 0;
    my @coords = $w->coords($id);
    unshift @coords, $x, $y;
    $w->coords($id, @coords);
#   $w coords $::_id [concat [$w coords $::_id] $x $y]
}