
package Card;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
            $image_dir $cx $cy %point
	    $imagedir %image %card
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);

@EXPORT = qw( );

$VERSION = "0.1";

use Tk;
use Carp;


$imagedir = "/local/kono/src/card9/image80x128/";
$imagedir = "/local/kono/src/card9/image50x80/";
%image= ();


# class method

sub init {
    my ($type) = shift;
    my (%arg) = @_;
    my ($x,$y,$tag,$suit,$cx,$cy,$w,$b);
    my ($file,$name);

    if (! defined($arg{'-main'}) ) {
	carp "Card::init needs -main\n";
    }
    $image_dir = $arg{'-dir'} if (defined($arg{'-dir'}));
    $imagedir =~ /(\d+)x(\d+)/;
    $cx = $1;
    $cy = $2;
    $w = $arg{'-main'};

    foreach $file ( <${image_dir}/[shcd]*.gif> ) {
	$name = $file;  
	$name =~ s/\.gif//;
	$image{$name} =
	    $w->Photo($name, -file => $file, -width=>$cx,-height=>$cy);
    }
    print STDOUT "initialzation done\n";
    1;
}

sub new {
    my $type = shift;
    my ($x,$y,$tag,$suit,$number,$cx,$cy,$c);
    my $self = {};
    my %arg = @_;

    if (! defined($arg{'-canvas'}) || 
        ! defined($arg{'-suit'}) || 
        ! defined($arg{'-number'})) {
	carp "Card needs -canvas,-suit,-number\n";
    }
    $c = $self->{'-canvas'} = $arg{'-canvas'};
    $self->{'-x'} =  defined($arg{'-x'})?$arg{'-x'}:0 ;
    $self->{'-y'} =  defined($arg{'-y'})?$arg{'-y'}:0 ;
    $suit = $self->{'-suit'} = $arg{'-suit'};
    $number = $self->{'-number'} = $arg{'-number'};
    $tag = $self->{'-tag'} = $suit.$number;

    bless $self;
}

sub openable {
    my($self) = shift;
    my($c) = $self->{'-canvas'};
    my($tag) = $self->{'-tag'};
    $c->bind($tag, '<1>' => sub{plot_down(@_)});
    $c->bind($tag, '<2>' => sub{hide_card(@_)});
    $c->bind($tag, '<3>' => sub{open_card(@_)});
    $c->bind($tag, '<ButtonRelease-1>' => sub {shift->dtag('selected')});
    $c->bind($tag, '<B1-Motion>' => sub {plot_move(@_)});
}

sub 
remove {
    my($self) = shift;
    my($c) = $self->{'-canvas'};
    $c->delete($self->{'-tag'});
    $self->{'-state'} = 'removed';
}

sub 
add {
    my($self,%args) = @_;
    my($w) = $self->{'-canvas'};
    my($tag) = $self->{'-tag'};

    if (defined( $args{'-x'} )) { $self->{'-x'} = $args{'-x'}; }
    if (defined( $args{'-y'} )) { $self->{'-y'} = $args{'-y'}; }
    my $x = $self->{'-x'};
    my $y = $self->{'-y'};
    if ($args{'-surface'}) {
	$w->delete($card{$tag});
	$w->create('image',$x,$y,-image=>$image{$tag},-anchor=>'nw',-tag=>$tag);
	$w->raise($card{$tag});
	$self->{'-state'} = 'open';
    } else {
        $w->create('rectangle',$x,$y,$x+$cx+2,$y+$cy+2,-tag=>$tag, -fill=>"blue");
	$self->{'-state'} = 'hide';
    }
}

sub 
hide {
    my($self) = shift;
    my($c) = $self->{'-canvas'};
    my($tag) = $self->{'-tag'};
    my ($x,$y) = $c->coords($tag);

    $c->delete($tag);
    $c->create('rectangle',$x,$y,$x+$cx+2,$y+$cy+2,-tag=>$tag, -fill=>"blue");
    $self->{'-state'} = 'hide';
}

sub 
open {
    my($self) = shift;
    my($w) = $self->{'-canvas'};
    my($tag) = $self->{'-tag'};
    my ($x,$y) = $w->coords($tag);

    $w->delete($card{$tag});
    $card{$tag} = 
        $w->create('image',$x,$y,-image=>$image{$tag},-anchor=>'nw',-tag=>$tag);
    $self->{'-state'} = 'open';
    $w->raise($card{$tag});
}
 
sub 
raise {
    my($self) = shift;
    my($c) = $self->{'-canvas'};
    my($tag) = $self->{'-tag'};
    $c->raise($tag);
}

# use subs qw(plot_down plot_move);

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

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

sub plot_down {
    my($w) = @_;
    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) = @_;
    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


1;

# end
