#
# $Id: Card.pm,v 4.10 2002/07/21 06:49:51 kono Exp $
#
package CardPlay::Card;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
%image $cx $cy %point $size $deltax $deltay
);
require Exporter;
require AutoLoader;
@ISA = qw(Exporter AutoLoader CardPlay::SimpleCard
);
@EXPORT = qw( );
$VERSION = "0.2";
use Tk;
use Carp;
use CardPlay::SimpleCard;
%image= ();
# class method
sub init {
my ($type) = shift;
my (%arg) = @_;
my ($x,$y,$tag,$suit,$w,$b);
my ($file,$name);
my ($image,$size);
srand;
if (! defined($arg{'-main'}) ) {
carp "${type}::init needs -main\n";
}
$w = $arg{'-main'};
if (!defined($arg{'-size'}) ) { $size = 'large' }
else { $size = $arg{'-size'} }
if ($size eq 'large') {
eval '
use CardPlay::LargeCard;
($deltax,$deltay,$cx,$cy) = CardPlay::LargeCard->init($w,\%image);
';
} elsif ($size eq 'vlarge' ) {
eval '
use CardPlay::VeryLargeCard;
($deltax,$deltay,$cx,$cy) = CardPlay::VeryLargeCard->init($w,\%image);
';
} else {
eval '
use CardPlay::SmallCard;
($deltax,$deltay,$cx,$cy) = CardPlay::SmallCard->init($w,\%image);
';
# print "($deltax,$deltay,$cx,$cy)\n";
}
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