Tk Canvas Animation

dvergin has asked for the wisdom of the Perl Monks concerning the following question:

I've been playing around with a version of the Solitaire game from The Perl Journal #18. (Actually I'm working with a modified version of the game found here where a link to the card images can also be found.)

It occured to me that it would be slick if the cards would slide from one place to another instead of just suddenly appearing in the new location.

But it didn't work. I have reduced the problem to the following snippet which seems to demonstrate that Tk only updates the screen at the end of a callback -- but not during it. What happens is that when I click on the 'Slide It' button, there is a delay and then the image suddenly appears on the final position. No slide animation. So...

Is there a way to animate the movement of an image on a canvas? Is there some other way to achieve what I am trying to do?

Here's the code:

#!/usr/bin/perl -w
use strict;
use Tk;

sub jump_it {
   my ($c, $thing) = @_;
   my ($old_x, $old_y) = $c->coords($thing);
   my $new_pos = $old_x == 10 ? 80 : 10;
   $c->coords($thing, $new_pos, $new_pos);
}

sub slide_it {
   my ($c, $thing) = @_;
   for my $i (10..80) {
      $c->coords($thing, $i, $i);
      for (my $wait=20000; --$wait;){};
   }
}

my $mw = MainWindow->new;
my $c = $mw->Canvas(-relief => 'sunken',
                    -bd     => 2,
                    -width  => 200,
                    -height => 200);
my $image = $c->Photo(-file => "cards/ah.gif");
my $card = $c->create('image', 10, 10,
                      -anchor => 'nw',
                      -image  => $image);
my $j_btn  = $mw->Button(-text    => 'Jump It',
                         -command => [\&jump_it, 
                                      $c, $card] );
my $s_btn = $mw->Button(-text    => 'Slide It',
                        -command => [\&slide_it, 
                                     $c, $card] );
$j_btn->pack;
$s_btn->pack;
$c->pack;

MainLoop;
[download]

------------------------------------------------------------
"Perl is a mess and that's good because the
problem space is also a mess." - Larry Wall

Comment on Tk Canvas Animation Download Code

Replies are listed 'Best First'.

(crazyinsomniac) Re: Tk Canvas Animation
by crazyinsomniac (Prior) on Jan 02, 2002 at 14:01 UTC

Tk::after

your code modified (to do somewhat what you want, some numbers may be off, but it's animated ;D)

#!/usr/bin/perl -w
use strict;
use Tk;

sub jump_it {
   my ($c, $thing) = @_;
   my ($old_x, $old_y) = $c->coords($thing);
   my $new_pos = $old_x == 10 ? 80 : 10;
   $c->coords($thing, $new_pos, $new_pos);
}

=head1 ORIGINAL C<slide_it> function

sub slide_it {
   my ($c, $thing) = @_;
   for my $i (10..80) {
      $c->coords($thing, $i, $i);
      for (my $wait=20000; --$wait;){};
   }
}

=cut

sub slide_it # canvas, card
{
    my ($c, $thing) = @_;
    $$c{__slide_for} = 80;
    $$c{__slide_count} = 0;
    $$c{__slide_timer} = $c->repeat(100, # miliseconds
                             [ \&move_thing,
                               $c,
                               $thing,
                               2, # this many pixels X
                               2, # this many pixels Y
                             ,]
                            ,);
}

sub move_thing
{
    my($c, $thing, $nX, $nY) = @_;

    if( $$c{__slide_count} > $$c{__slide_for} )
    { $$c{__slide_timer}->cancel() }

    $$c{__slide_count}++;

    $c->move( $thing, #what?
              $nX,
              $nY,                
            ,);
}

my $mw = MainWindow->new;
my $c = $mw->Canvas(-relief => 'sunken',
                    -bd     => 2,
                    -width  => 200,
                    -height => 200);
my $image = $c->Photo(-file => "cards/ah.gif");
my $card = $c->create('image', 10, 10,
                      -anchor => 'nw',
                      -image  => $image);
my $j_btn  = $mw->Button(-text    => 'Jump It',
                         -command => [\&jump_it, 
                                      $c, $card] );
my $s_btn = $mw->Button(-text    => 'Slide It',
                        -command => [\&slide_it, 
                                     $c, $card] );
$j_btn->pack;
$s_btn->pack;
$c->pack;

MainLoop;
[download]

update:

my $image = $c->Photo(-file => "cards/ah.gif");
my $card = $c->create('image', 10, 10,
                      -anchor => 'nw',
                      -image  => $image);
[download]

my $image = $c->Photo(-file => "cards/ah.gif");
$$image{_id} = $c->create('image', 10, 10,
                      -anchor => 'nw',
                      -image  => $image);
[download]

update: ++danger though I like my way more ;)

______crazyinsomniac_____________________________
Of all the things I've lost, I miss my mind the most.
perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"

[reply]
[d/l]
[select]

Re: (crazyinsomniac) Re: Tk Canvas Animation

by danger (Priest) on Jan 02, 2002 at 14:17 UTC

Alternatively, you can use the update() method within the original callback function (and set a delay with the after() method if desired):

sub slide_it {
   my ($c, $thing) = @_;
   for my $i (10..80) {
      $c->coords($thing, $i, $i);
      $c->update;                # update $c widget
      # $c->after(100);          # delay if desired
   }
}
[download]

[reply]
[d/l]


No such thing as a small change
	PerlMonks