# # $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