#!/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 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 $image = $c->Photo( -data => q{ R0lGODdhJwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAAAAAAALAAAAAAnADkA AAjDAP8JHEiwoMGDCBMqXMiwocOHECNKnEixosWLGDNq3Mixo8ePIEOKHEmypEmKAFICEKlSpceW MDm2/AczJUaXK2vOvKizJs2VFYHqFOhzYs6YA3P+BCrRJlKaRJ8+PIozadSdEKkKxanVZtaYXr0u dfnVp9ikWKeCRSjV4VC2ad1qTdi2oVm4ZMs6hVqwqF6yZ/2q/bn06tusULmOrWvX8MzDTR0v3osS 7eS4TZmaPWsR8FiWnE+KHk26tOnTqFOrLhgQADs=}, -format => '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; __END__ #### #!/usr/bin/perl -w use strict; use Tk; my $MW = MainWindow->new; my $c = $MW->Canvas(-relief => 'sunken', -bd => 2, -width => 200, -height => 200)->pack(); #my $image = $c->Photo(-file => "cards/ah.gif"); my $image = $c->Photo( -data => q{ R0lGODdhJwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgMDAwMDcwKbK8EAgAGAgAIAgAKAgAMAg AOAgAABAACBAAEBAAGBAAIBAAKBAAMBAAOBAAABgACBgAEBgAGBgAIBgAKBgAMBgAOBgAACAACCA AECAAGCAAICAAKCAAMCAAOCAAACgACCgAECgAGCgAICgAKCgAMCgAOCgAADAACDAAEDAAGDAAIDA AKDAAMDAAODAAADgACDgAEDgAGDgAIDgAKDgAMDgAODgAAAAQCAAQEAAQGAAQIAAQKAAQMAAQOAA QAAgQCAgQEAgQGAgQIAgQKAgQMAgQOAgQABAQCBAQEBAQGBAQIBAQKBAQMBAQOBAQABgQCBgQEBg QGBgQIBgQKBgQMBgQOBgQACAQCCAQECAQGCAQICAQKCAQMCAQOCAQACgQCCgQECgQGCgQICgQKCg QMCgQOCgQADAQCDAQEDAQGDAQIDAQKDAQMDAQODAQADgQCDgQEDgQGDgQIDgQKDgQMDgQODgQAAA gCAAgEAAgGAAgIAAgKAAgMAAgOAAgAAggCAggEAggGAggIAggKAggMAggOAggABAgCBAgEBAgGBA gIBAgKBAgMBAgOBAgABggCBggEBggGBggIBggKBggMBggOBggACAgCCAgECAgGCAgICAgKCAgMCA gOCAgACggCCggECggGCggICggKCggMCggOCggADAgCDAgEDAgGDAgIDAgKDAgMDAgODAgADggCDg gEDggGDggIDggKDggMDggODggAAAwCAAwEAAwGAAwIAAwKAAwMAAwOAAwAAgwCAgwEAgwGAgwIAg wKAgwMAgwOAgwABAwCBAwEBAwGBAwIBAwKBAwMBAwOBAwABgwCBgwEBgwGBgwIBgwKBgwMBgwOBg wACAwCCAwECAwGCAwICAwKCAwMCAwOCAwACgwCCgwECgwGCgwICgwKCgwMCgwOCgwADAwCDAwEDA wGDAwIDAwKDAwP/78KCgpICAgP8AAAD/AP//AAAA//8A/wD//////yH5BAAAAAAALAAAAAAnADkA AAjDAP8JHEiwoMGDCBMqXMiwocOHECNKnEixosWLGDNq3Mixo8ePIEOKHEmypEmKAFICEKlSpceW MDm2/AczJUaXK2vOvKizJs2VFYHqFOhzYs6YA3P+BCrRJlKaRJ8+PIozadSdEKkKxanVZtaYXr0u dfnVp9ikWKeCRSjV4VC2ad1qTdi2oVm4ZMs6hVqwqF6yZ/2q/bn06tusULmOrWvX8MzDTR0v3osS 7eS4TZmaPWsR8FiWnE+KHk26tOnTqFOrLhgQADs=}, -format => 'gif' ); ## CARD my $card = $c->create( 'image', 10, 10, -anchor => 'nw', -image => $image ); $image->bind( 'Tk::Canvas', '' => [\&DragOn, map{Ev($_)} qw{ x y s } ] ); $image->bind( 'Tk::Canvas', '' => [\&DragOff, map{Ev($_)} qw{ x y s } ] ); MainLoop; sub DragOn { my( $C, $X, $Y, $S ) = @_; if( grep { $card eq $_ } $C->find('overlapping', $X, $Y, $X + 1 , $Y + 1 ) ) { $MW->bind( 'Tk::Canvas', '' => [\&StickToMouse, map { Ev($_) } qw{ x y s } ] ); } } sub DragOff { my( $C, $X, $Y, $S ) = @_; $MW->bind( 'Tk::Canvas', '' => undef, # essentially unbind ); } sub StickToMouse { my( $C, $X, $Y, $S ) = @_; $C->coords( $card, $X, $Y); } __END__