#!/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',
     '<ButtonPress-1>' => [\&DragOn, map{Ev($_)} qw{ x y s } ]
);

 
$image->bind(
    'Tk::Canvas',
    '<ButtonRelease-1>' => [\&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',
            '<Motion>' => [\&StickToMouse, map { Ev($_) } qw{ x y s } ]
        );
    }
}

sub DragOff {
    my( $C, $X, $Y, $S ) = @_;
    
    $MW->bind(
        'Tk::Canvas',
        '<Motion>' => undef, # essentially unbind
    );       
}

sub StickToMouse {
    my( $C, $X, $Y, $S ) = @_;
    $C->coords( $card, $X, $Y);   
}
__END__