#!/usr/local/bin/perl
#
# $Id: spider.pl,v 4.9 2002/07/21 06:49:49 kono Exp $

package TempCardPile;

use strict;

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

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPlay::CardPile);

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::Card;
use CardPlay::CardPile;
use CardPlay::CardBoard;

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

sub can_merge {
    my ($self,$cardpile) = @_;
    my ($card) = $cardpile->first();
    my ($last) = $self->last();
    return 0 if (!defined($card)); 
    return $self->intelligent($cardpile) if ($self eq $cardpile->{'-prevSplit'}); 
    return 1 if ($self->empty());
    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 CardPlay::CardPile);

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::Card;
use CardPlay::CardPile;
use CardPlay::CardBoard;

sub new {
    my $type = shift;
    my $self = CardPlay::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);
    }     
    $self->{'-board'}->log_commit(0);
    foreach $i ( @cp ) {
    $i->do_merge($self->do_split(-1));
    }     
}

# 

package FinishCardPile;

use strict;

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

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader CardPlay::CardPile);

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::Card;
use CardPlay::CardPile;
use CardPlay::CardBoard;

sub new {
    my $type = shift;
    my $self = CardPlay::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 CardPlay::CardBoard);

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::Card;
use CardPlay::CardPile;
use CardPlay::CardBoard;

sub new {
    my $type = shift;
    my $self = CardPlay::CardBoard->new(@_);
    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},CardPlay::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( -title=>'Spider');
    my $c = $self->{'-canvas'};
    my $x = $CardPlay::Card::cx+10; 
    my $y = 20;
    my @finish;
    my $i;
    
    $self->{'-mainWindow'}->geometry(
    sprintf("%dx%d",($CardPlay::Card::cx+10)*10,600));
    $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 += $CardPlay::Card::cx+5; 
    }
    $self->{'-finishPiles'} = \@finish;
    $self->add_piles(@finish);

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

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

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

sub setup {
    my $self = shift;

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

    # remove all CardPile
    $self->clear;
    # make new board by saved card array
    @{$dl->{'-contents'}} = @{$self->{'-cards'}}; # copy
    $dl->close_all();

    for($i=0;$i<=$#count;$i++) {
    $j = $cp->[$i];
    $j->merge($dl->split(- $count[$i]));
    $j->open();
    }

    $self;
}

# end

package main;

use strict;
use CardPlay::CardBoard;

my $board = SpiderBoard->new();

$board->game();

1;

# end