package TempCardPile;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPile);

@EXPORT = qw( );

$VERSION = "0.1";

use Tk;
use Carp;
use Card;
use CardPile;
use CardBoard;

sub new {
    my $type = shift;
    my $self = CardPile->new(@_);
    $self->{'-mergeable'}=1;
    $self->{'-splitable'}=1;
#    $self->{'-deltay'}=20;
    bless $self;
}

sub can_merge {
    my ($self,$cardpile) = @_;
    my ($card) = $cardpile->{'-contents'}->[0];
    my ($last) = $self->last();
    if (!defined($card)) { return $self->intelligent($cardpile); }
    return 1 if (!defined($last));
    if ($last->{'-state'} eq 'hide') { return $self->intelligent($cardpile); }
    return 1 if ($card->{'-number'}==$last->{'-number'}-1) ;
    return $self->intelligent($cardpile); 
}

sub intelligent {
    my ($self,$cardpile) = @_;
    # remember this is called from can_merge. 
    # use do_merge for undo logging etc.
    my ($suit) = $cardpile->first()->{'-suit'};
    my ($number) = $cardpile->first()->{'-number'};
    my ($last);
    my ($i);
    my ($tempPile) = $self->{'-tempPiles'};
    foreach $i ( @{$tempPile} ) {
	next if ($i eq $self);
	$last = $i->last();
	next if (! defined($last));
	next if ($last->{'-suit'} ne $suit);
	next if ($last->{'-number'} != $number+1);
	$i->do_merge($cardpile);
	return 2;
    }
    foreach $i ( @{$tempPile} ) {
	next if ($i eq $self);
	$last = $i->last();
	next if (! defined($last));
	next if ($last->{'-number'} != $number+1);
	$i->do_merge($cardpile);
	return 2;
    }
    foreach $i ( @{$tempPile} ) {
	next if ($i eq $self);
	$last = $i->last();
	next if (defined($last));
	$i->do_merge($cardpile);
	return 2;
    }
    return 0;
}

sub can_split {
    my ($self,$i) = @_;
    my (@contents) = @{$self->{'-contents'}};
    return 0 if (!defined($contents[$i]));
    return 0 if ($contents[$i]->{'-state'} eq 'hide');
    my $suit = $contents[$i]->{'-suit'};
    my $number = $contents[$i]->{'-number'};
    for(;$i<=$#contents;$i++) {
	return 0 if (!defined($contents[$i]));
	return 0 if ($contents[$i]->{'-suit'} ne $suit);
	return 0 if ($contents[$i]->{'-number'} != $number);
	$number--;
    }
    return 1;
}

package DealCardPile;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPile);

@EXPORT = qw( );

$VERSION = "0.1";

use Tk;
use Carp;
use Card;
use CardPile;
use CardBoard;

sub new {
    my $type = shift;
    my $self = CardPile->new(@_);
    $self->{'-deltay'}=0;
    $self->bind('<1>' => sub {$self->deal()});
    bless $self;
    $self;
}

sub deal {
    my $self = shift;
    my @cp= @{$self->{'-tempPiles'}};
    my $i;
    foreach $i ( @cp ) {
	return if ($#{$i->{'-contents'}} == -1);
    }	 
    foreach $i ( @cp ) {
	$i->merge($self->split(-1));
	if (defined($self->{'-board'})) {
	    $self->{'-board'}->log_move(
		CardPileUndo->new(
		    -from=>$self,
		    -to=>$i,
		    -at=> -1));
	}
    }	 
    if (defined($self->{'-board'})) {
        $self->{'-board'}->log_commit(0);
    }

}

# 

package FinishCardPile;

use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPile);

@EXPORT = qw( );

$VERSION = "0.1";

use Tk;
use Carp;
use Card;
use CardPile;
use CardBoard;

sub new {
    my $type = shift;
    my $self = CardPile->new(@_);
    $self->{'-mergeable'}=1;
    $self->{'-deltay'}=0;
    bless $self;
}

sub can_merge {
    my ($self,$cardpile) = @_;
    my (@contents) = @{$cardpile->{'-contents'}};
    return 0 if ($cardpile->empty());
    return 0 if (! $self->empty());
    my $suit = $contents[0]->{'-suit'};
    my $number = 13;
    for(my $i=0;$i<=$#contents;$i++) {
	return 0 if (!defined($contents[$i]));
	return 0 if ($contents[$i]->{'-suit'} ne $suit);
	return 0 if ($contents[$i]->{'-number'} != $number);
	$number--;
    }
    return 0 if ($number!=0);
    return 1;
}

package SpiderBoard;
use strict;

use vars qw($VERSION @ISA @EXPORT @EXPORT_OK
    @count
);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardBoard);

@EXPORT = qw( );

$VERSION = "0.1";

use Tk;
use Carp;
use Card;
use CardPile;
use CardBoard;

sub new {
    my $type = shift;
    my $self = CardBoard->new(
	-title=>'Spider',-minx=>($Card::cx+6)*11,-miny=>600,@_);
    bless $self;
}

sub new_cards {
    my $self = shift;
    my $card = [];
    my ($i,$j,$suit);
    my ($c) = $self->{'-canvas'};

    for($j=0;$j<2;$j++) {
	foreach $suit ( 's','h','c','d') {
	    for($i=1;$i<14;$i++) {
		push(@{$card},Card->new(
			-canvas=>$c,-board=>$self,-suit=>$suit,-number=>$i));
	    }
	}
    }
    $self->{'-cards'} = $card;
    $self;
}

@count = (6,5,5,6,5,5,6,5,5,6);

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

    my $x = $Card::cx+10; 
    my $y = 20;
    my @finish;
    my $i;

    $self->new_cards;

    for($i=0;$i<8;$i++) {
	$finish[$i] = FinishCardPile->new(-canvas=>$c,-base=>1,-board=>$self);
	$finish[$i]->display('-x'=>$x,'-y'=>$y);
	$x += $Card::cx+5; 
    }
    $self->{'-finishPiles'} = \@finish;

    $x = 5;
    $y = 20;
    my $dl = DealCardPile->new(-canvas=>$c,-base=>1,-board=>$self);
    $dl->display('-x'=>$x,'-y'=>$y);
    $self->{'-dealPile'} = $dl;

    $x = 5; 
    $y = $y+$Card::cy+10;

    my @cp;
    for($i=0;$i<=$#count;$i++) {
	$cp[$i] = TempCardPile->new(
	    -canvas=>$c,-auto_open=>1,-board=>$self,
	    -tempPile=>\@cp);
	$cp[$i]->display('-x'=>$x,'-y'=>$y,-base=>1);
	$x += $Card::cx+5; 
    }
    $dl->{'-tempPiles'} = \@cp;
    $self->{'-tempPiles'} = \@cp;
    $self;
}

sub new_game {
    my $self = shift;

    my ($dl) = $self->{'-dealPile'};
    my ($i);

    # delete old staff from dealer
    $dl->clear();
    # make new one
    my @cards = @{$self->{'-cards'}};
    $dl->{'-contents'} = $self->{'-cards'};
    $dl->shuffle();
    # and make backup
    @{$self->{'-cards'}} = @{$dl->{'-contents'}};

    # and restart
    $self->restart;
}

sub restart {
    my $self = shift;

    my ($dl) = $self->{'-dealPile'};
    my ($cp) = $self->{'-tempPiles'};
    my ($fi) = $self->{'-finishPiles'};
    my ($i,$j);

    $self->undo_init();
    # remove all CardPile
    $self->clear;
    # make new board from @cards
    $dl->{'-contents'} = $self->{'-cards'};

    $dl->display();
    for($i=0;$i<=$#count;$i++) {
	$j = $cp->[$i];
	$j->merge($dl->split(- $count[$i]));
	$j->open();
	$j->display();
    }
    for($i=0;$i<=$#{$self->{'-finishPiles'}};$i++) {
	$fi->[$i]->display();
    }
    $self->log_commit(-1);

    $self;
}

sub clear {
    my $self = shift;

    my ($dl) = $self->{'-dealPile'};
    my ($cp) = $self->{'-tempPiles'};
    my ($fi) = $self->{'-finishPiles'};
    my ($i);

    $dl->clear;
    foreach $i ( @{$cp} ) {
	$i->clear;
    }	 
    foreach $i ( @{$fi} ) {
	$i->clear;
    }	 
    $self;
}

sub mainLoop {
    my $self = shift;
    my $w = $self->{'-mainWindow'};
    print STDOUT "cardpile initialzation done\n";
    $w->update();
    $w->MainLoop();
}

# end

package main;

use strict;
use CardBoard;

my $board = SpiderBoard->new();

$board->display();
$board->new_game();
$board->mainLoop();

1;

# end
