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]
}
|
