use Tk;
use English;

my $w = MainWindow->new();

$w->title('Card Demonstration');
$w->iconname('Card');
# my @ARG = $w;

my $w_msg = $w->Label(-font => '-Adobe-Times-Medium-R-Normal-*-180-*-*-*-*-*-*', -wraplength => '4i',
             -justify => 'left', -text => 'Card Demonstratoin');
my $c = $w->Canvas(-relief => 'raised', -width => '450', -height => '300');
my $w_ok = $w->Button(-text => 'Quit', -width => 8, -command => ['destroy', $w]);
$w_msg->pack(-side => 'top', -fill => 'x');
$c->pack(-side => 'top', -fill => 'x');
$w_ok->pack(-side => 'bottom', -pady => '5');

# $c = $w->Canvas(-width=>100,-height=>100);
# $c->pack();
# $w->update();

$dir = "/usr/open/lectures/kono/software/card9";
$imagedir = "$dir/image83x131/";
$imagedir = "$dir/image53x83/";

$imagedir =~ /(\d+)x(\d+)/;
$cx = $1;
$cy = $2;

$x = 20;
$y = 20;
foreach $suit ( 's','h','c','d') {
    for($i=1;$i<14;$i++) {
    $tag = $suit.$i;
    # image cache
    $image{$tag} =
        $w->Photo($tag, -file=>$imagedir.$tag.".gif",-width=>$cx,-height=>$cy);
    $card{$tag} = $c->create('image',$x,$y,-image=>$tag,-anchor=>'nw',-tag=>$tag);
    $c->delete($card{$tag});
    $card{$tag} = $c->create('rectangle',$x,$y,$x+$cx-1,$y+$cy-1,-tag=>$tag,-fill=>"blue");
    $c->addtag('card', 'withtag', $tag);
    $x+=10; 
    }
    $y += 40;
    $x = 20;
}
print STDOUT "initialzation done\n";
$w->update();

# $c->bind('card', '<Any-Enter>' => [sub{shift->itemconfigure(@ARG)}, qw(current -fill red)]);
# $c->bind('card', '<Any-Leave>' => [sub{shift->itemconfigure(@ARG)}, qw(current -fill SkyBlue2)]);
$c->bind('card', '<1>' => sub{plot_down(@ARG)});
$c->bind('card', '<2>' => sub{hide_card(@ARG)});
$c->bind('card', '<3>' => sub{open_card(@ARG)});
$c->bind('card', '<ButtonRelease-1>' => sub {shift->dtag('selected')});
# $c->Tk::bind('<B1-Motion>' => sub {plot_move(@ARG)});
$c->bind('card', '<B1-Motion>' => sub {plot_move(@ARG)});

# sleep(1);

# $c->itemconfigure($card{'h1'},-fill=>blue);

# $w->update();
# sleep(1);

sub 
hide_card {
    my($w) = @ARG;
    my($card) = &current_card($w);
    ($x,$y) = $w->coords($card{$card});
    $w->delete($card{$card});
    $card{$card} = $c->create('rectangle',$x,$y,$x+$cx-1,$y+$cy-1,-tag=>$card,-fill=>"blue");
    $w->addtag('card', 'withtag', $card);
}
sub 
open_card {
    my($w) = @ARG;
    my($card) = &current_card($w);
    ($x,$y) = $w->coords($card{$card});
    $w->delete($card{$card});
    $card{$card} = 
    $w->create('image',$x,$y,-image=>$card,-anchor=>'nw',-tag=>$card);
    $w->addtag('card', 'withtag', $card);
    $w->raise($card{$card});
}
 
# use subs qw(plot_down plot_move);


$point{'lastX'} = 0;
$point{'lastY'} = 0;

sub current_card {
    my($w) = @ARG;
    return (grep(/^[shdc]\d*/,$w->gettags('current')))[0];
}

sub plot_down {
    my($w) = @ARG;
    my $e = $w->XEvent;
    my($x, $y) = ($e->x, $e->y);
    my($card) = &current_card($w);

    $w->dtag('selected');
    $w->addtag('selected', withtag => $card);
    $w->raise($card);
    $point{'lastX'} = $x;
    $point{'lastY'} = $y;
} # end plot_down


sub plot_move {
    my($w) = @ARG;
    my $e = $w->XEvent;
    my($x, $y) = ($e->x, $e->y);
    $w->move('selected',  $x-$point{'lastX'}, $y-$point{'lastY'});
    $point{'lastX'} = $x;
    $point{'lastY'} = $y;
} # end plot_move


$w->MainLoop();

1;

# end