#
# $Id: CardBoard.pm,v 4.8 2002/07/21 06:49:51 kono Exp $
#
package CardPlay::CardBoard;
use Tk;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
);
require Exporter;
require AutoLoader;
use CardPlay::Undo;
use CardPlay::Drag;
@ISA = qw(Exporter AutoLoader
CardPlay::Undo CardPlay::Drag
);
@EXPORT = qw( );
$VERSION = "0.2";
use Tk;
use CardPlay::Card;
use Carp;
# class method
sub new {
my ($types) = shift;
my $self;
$self = CardPlay::Drag->new(@_);
bless $self;
$self->undo_init();
$self;
}
# instance method
sub display {
my ($self) = shift;
$self->merge_args(@_);
my ($title) = $self->{'-title'};
my $w = MainWindow->new();
my $size;
$self->{'-mainWindow'} = $w;
if (grep(/-large/,@ARGV)) {
$size = 'vlarge';
} elsif (grep(/-normal/,@ARGV)) {
$size = 'large';
} elsif (grep(/-small/,@ARGV)) {
$size = 'normal';
} else {
$size = 'large';
}
CardPlay::Card->init(-main=>$w , -size=>$size );
# my $c = $w->Canvas(-relief => 'raised', -width => ($CardPlay::Card::cx+6)*10, -height => '300',-bg=>'green3');
# my $c = $w->Canvas(-relief => 'raised', -bg=>'green3',-width=>($CardPlay::Card::cx+6)*10,-height=>400);
my $c = $w->Canvas(-relief => 'raised', -bg=>'green3',-scrollregion=>[
0,
0,
$CardPlay::Card::cx*15,
$CardPlay::Card::cy*10
]);
my $s = $c->Scrollbar(-command => ['yview', $c]);
$c->configure(-yscrollcommand => ['set', $s]);
# my $c = $w->Scrolled(qw/Canvas -relief sunken -borderwidth 2
# -scrollbars se -scrollregion/ => ['-10c', '-10c', '50c', '20c']);
$self->{'-canvas'} = $c;
my $w_frame = $w->Frame;
$w_frame->pack(-side => 'top', -fill => 'both', -pady => '5');
$c->pack(-side => 'top', -fill => 'both',-expand=>1);
$s->pack(-side => 'right', -fill => 'y');
my $w_quit = $w_frame->Button(-text => 'Quit', -width => 8, -command => ['destroy', $w]);
my $w_undo = $w_frame->Button(-text => 'Undo', -width => 8, -command => sub { $self->undo() ;});
my $w_redo = $w_frame->Button(-text => 'Redo', -width => 8, -command => sub { $self->redo() ;});
my $w_restart = $w_frame->Button(-text => 'Restart', -width => 8, -command => sub { $self->restart() ;});
my $w_newgame = $w_frame->Button(-text => 'Newgame', -width => 8, -command => sub { $self->new_game() ;});
my $w_msg = $w_frame->Label(-font => '-Adobe-Times-Medium-R-Normal-*-180-*-*-*-*-*-*', -wraplength => '4i',
-justify => 'left',-text=>$title);
$self->{'-titleMessage'} = $w_msg;
$w_undo->pack(-side => 'left', -padx => '5');
$w_redo->pack(-side => 'left', -padx => '5');
$w_restart->pack(-side => 'left', -padx => '5');
$w_msg->pack(-side => 'left', -fill => 'x');
$w_newgame->pack(-side => 'left', -padx => '5');
$w_quit->pack(-side => 'left', -padx => '5');
$w->title($title);
$w->iconname($title);
# $w->update();
print STDOUT "card initialzation done\n";
}
sub merge_args {
my ($self,%args) = @_;
foreach my $key ( keys %args ) {
if (defined( $args{$key} )) {
$self->{$key} = $args{$key};
}
}
}
sub new_game {
my $self = shift;
my ($dl) = $self->{'-dealPile'};
my ($i);
$self->undo_init();
# delete old staff from dealer
$dl->clear();
# make new shuffled one
$dl->{'-contents'} = $self->{'-cards'};
$dl->shuffle();
$dl->{'-contents'} = []; # setup remove this array
$self->restart();
}
sub restart {
my $self = shift;
# my $dl = $self->{'-dealPile'};
# $self->clear();
# make new board by saved card array
# @{$dl->{'-contents'}} = @{$self->{'-cards'}}; # copy
$self->disable_log();
$self->setup();
foreach my $pile ( @{$self->{'-piles'}} ) {
$pile->display();
}
$self->can('auto_play') && $self->auto_play();
$self->enable_log();
$self->undo_restart();
$self;
}
sub setup {
my $self = shift;
my ($dl) = $self->{'-dealPile'};
$self->clear();
# make new board by saved card array
@{$dl->{'-contents'}} = @{$self->{'-cards'}}; # copy
$self;
}
sub add_piles {
my $self = shift;
push(@{$self->{'-piles'}},@_);
}
sub clear {
my $self = shift;
my ($pile);
foreach $pile ( @{$self->{'-piles'}} ) {
$pile->clear;
}
$self;
}
sub mainLoop {
my $self = shift;
my $w = $self->{'-mainWindow'};
$w->update();
$w->MainLoop();
}
sub game {
my $self = shift;
$self->display();
$self->new_game();
$self->mainLoop();
}
# package main;
#
# use strict;
# use CardPlay::CardBoard;
#
# my $board = SpiderBoard->new();
# $boar->game();
1;
# end