#
# $Id: Card.pm,v 4.6 1999/06/14 05:13:13 kono Exp $
#

package CardPlay::Card;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
            $large_image_dir $image_dir $dir
		$image_large $image_small 
		%image $cx $cy %point $size
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPlay::SimpleCard 
);
#	CardPlay::SmallCard CardPlay::LargeCard 

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::SimpleCard;
# use CardPlay::LargeCard;
# use CardPlay::SmallCard;

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

%image= ();


# class method

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

    srand;
    if (! defined($arg{'-main'}) ) {
	carp "${type}::init needs -main\n";
    }
    $w = $arg{'-main'};

    if (defined($arg{'-large'}) ) {
      $image = $large_image_dir;
      $size='-large';
    } else {
      $image = $image_dir;
      $size='-small';
    }

#    if (defined($arg{'-large'}) ) {
#	$type->large_card_image_init($w);
#	$size='-large';
#    } else {
#	$type->small_card_image_init($w);
#	$size='-small';
#    }
#    $cx--; 
#    $cy--; 

    $image = $arg{'-dir'} if (defined($arg{'-dir'}));
    $image =~ /(\d+)x(\d+)/;
    $cx = $1-1;
    $cy = $2-1;

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

sub new {
    my $type = shift;
    my ($suit,$number,$c);
    my $self;
    
    %$self = @_;
    if (! defined($self->{'-canvas'}) || 
        ! defined($self->{'-suit'}) || 
        ! defined($self->{'-number'})) {
	carp "Card needs -canvas,-suit,-number\n";
    }
    defined($self->{'-state'}) or $self->{'-state'} = 'removed';
    $c = $self->{'-canvas'};
    $suit = $self->{'-suit'};
    $number = $self->{'-number'};
    $self->{'-image'} = $image{$suit.$number};

    bless $self;
}

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

sub unmovable {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    $self->{'-movable'}=0;
    $c->bind($tag, '<1>' => "");
    $c->bind($tag, '<2>' => "");
    $c->bind($tag, '<3>' => "");
    $c->bind($tag, '<ButtonRelease-1>' => "");
    $c->bind($tag, '<B1-Motion>' => "");
}

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

sub display {
    my ($self,%args) = @_;
    my ($c) = $self->{'-canvas'};
    my ($tag);
    my ($x) = $self->{'-x'};
    my ($y) = $self->{'-y'};

    if (defined( $args{'-x'} )) { $self->{'-x'} = $x = $args{'-x'}; }
    if (defined( $args{'-y'} )) { $self->{'-y'} = $y = $args{'-y'}; }
    if ($self->{'-state'} eq 'open') {
	$tag = $c->create('image',$x,$y,-image=>$self->{'-image'},-anchor=>'nw');
    } else {
	$tag = $c->create('rectangle',$x,$y,$x+$cx,$y+$cy,-fill=>"blue");
	$self->{'-state'} = 'hide';
    }
    $self->{'-tag'} = $tag;
    if ($args{'-movable'}) {
	$self->movable();
    }
    $self;
}

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

    # Representation chaned. but tag and event have to be repserved.
    foreach (@seq) {
	push(@bind,$c->bind($tag,$_));
    }
    $c->delete($tag);
    $self->{'-tag'} = $tag = 
	$c->create('rectangle',$x,$y,$x+$cx,$y+$cy,-fill=>"blue",-tag=>$tag);
    $c->itemconfigure($tag,-tag=>$tags);
    while (@seq) {
	$c->bind($tag,shift(@seq),shift(@bind));
    }
    if (defined($self->{'-board'})) {
        $self->{'-board'}->log_move(
            CardPlay::CardUndo->new(-card=>$self,-mode=>'hide'));
    }
    $self->{'-state'} = 'hide';
}

sub open {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    my ($tags) = $c->itemcget($tag,'-tag');
    my ($x,$y) = $c->coords($tag);
    my (@seq) = $c->bind($tag);
    my (@bind) = ();

    foreach (@seq) {
	push(@bind,$c->bind($tag,$_));
    }
    $c->delete($tag);
    $self->{'-tag'} = $tag = 
	$c->create('image',$x,$y,-image=>$self->{'-image'},-anchor=>'nw',-tag=>$tag);
    $c->itemconfigure($tag,-tag=>$tags);
    while (@seq) {
	$c->bind($tag,shift(@seq),shift(@bind));
    }
   
    if (defined($self->{'-board'})) {
        $self->{'-board'}->log_move(
            CardPlay::CardUndo->new(-card=>$self,-mode=>'open'));
    }
    $self->{'-state'} = 'open';
}

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

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 $self->{'-canvas'}->gettags('current');
}

sub plot_down {
    my ($self) = shift;
    my ($w) = @_;
    my ($e) = $w->XEvent;
    my ($x, $y) = ($e->x, $e->y);
    my ($tag) = $self->{'-tag'};

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


sub plot_move {
    my ($self) = shift;
    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

sub bbox {
    my ($self) = shift;
    return $self->{'-canvas'}->bbox($self->{'-tag'});
}

sub clear {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};

    if (defined($self->{'-tag'})) {
	$c->delete($self->{'-tag'});
	delete $self->{'-tag'};
    }
#    $self->{'-state'} = 'hide';
}

1;

# end
