#!/usr/local/bin/perl
#
# $Id: seeheaven.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 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();
    if (defined($self->{'-max'}) 
    && $self->count()+$cardpile->count() >$self->{'-max'}) { 
    return $self->intelligent($cardpile); 
    }
    if (!defined($card)) { 
    return 0; 
    }
    if ($self eq $cardpile->{'-prevSplit'}) {
    # any better place?
    return $self->intelligent($cardpile); 
    }
    if (!defined($last)) {
    if (defined($self->{'-max'})) {
        return 1;
    } else {
        if ($card->{'-number'} == 13) {
        return 1;
        } else {
        return $self->intelligent($cardpile); 
        }
    }
    }
    if ($last->{'-state'} eq 'hide') { 
    return $self->intelligent($cardpile); 
    }
    if ($card->{'-number'}==$last->{'-number'}-1 
    && $card->{'-suit'} eq $last->{'-suit'}  )  {
    return 1; 
    }
    return $self->intelligent($cardpile); 
}

sub intelligent {   # intelligent? Ha!
    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 ($board) = $self->{'-board'};
    my ($last);
    my ($i);
    foreach $i ( @{$self->{'-tempPiles'}} ) {
    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 ( @{$self->{'-tempPiles'}} ) {
    next if ($i eq $self);
    $last = $i->last();
    next if (defined($last));
    next if (!defined($self->{'-max'}) && $number != 13);
    next if (defined($self->{'-max'}) && $cardpile->count > $self->{'-max'});
    $i->do_merge($cardpile);
    return 2;
    }
    return 0 if ($cardpile->count != 1);
    foreach $i ( @{$self->{'-bufPiles'}} ) {
    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'};
    my $vacancy = $self->{'-board'}->buf_vacancy();
    return 0 if ($vacancy < $#contents+1-$i);

    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 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());
    my $suit = $contents[0]->{'-suit'};
    my $number = ($self->empty())?1:1+$self->count();
    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 1;
}

# end

package SeeHeavenBoard;
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(@_);
    $self->{'-auto_play'} = 1;
    bless $self;
}

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

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

sub buf_vacancy {
    my ($self) = @_;
    my ($i) = 1;
    foreach my $j ( @{$self->{'-bufPiles'}} ) {
    $i++ if ($j->empty);
    }
    return $i;
}

sub auto_play {
    my ($self) = @_;
    my ($done) = 1;
    my ($cardpile);
    my ($finish);
    my ($card);
    my ($dest);
#    my ($c) = $self->{'-tempPiles'}->[0]->{'-canvas'};
    my ($c) = $self->{'-canvas'};
    my @list = (@{$self->{'-tempPiles'}},@{$self->{'-bufPiles'}}) ;

    retry: while ($done) {
    $done = 0;
    foreach $cardpile ( @list ) {
        $card = $cardpile->last();
        next if (! defined($card));
        foreach $finish ( @{$self->{'-finishPiles'}} ) {
        if ($finish->empty()) {
            if ($card->{'-number'}==1) {
            $finish->do_merge($cardpile->do_split(-1));
            $done=1;
            $c->update;
            next retry;
            }
        } else {
            $dest = $finish->last();
            if ($card->{'-number'}==$dest->{'-number'}+1
            && $card->{'-suit'} eq $dest->{'-suit'}) {
            $finish->do_merge($cardpile->do_split(-1));
            $done=1;
            $c->update;
            next retry;
            }
        }
        }
    }
    }
}

#sub enable_undo  {
#    my ($self) = @_;
#    $self->{'-undoButton'}->configure(-state=>'normal');
#    $self->{'-redoButton'}->configure(-state=>'normal');
#    $self->{'-canvas'}->update;
#}

#sub disable_undo  {
#    my ($self) = @_;
#    $self->{'-undoButton'}->configure(-state=>'disabled');
#    $self->{'-redoButton'}->configure(-state=>'disabled');
#    $self->{'-canvas'}->update;
#}

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

sub display {
    my $self = shift;
    $self->SUPER::display( -title=>'SeeHeaven');
    my $c = $self->{'-canvas'};
    my $x = $CardPlay::Card::cx+10; 
    my $y = 20;
    my @finish;
    my @cp;
    my @buff;
    my $i;
    
    $self->{'-mainWindow'}->geometry(
    sprintf("%dx%d",
        ($CardPlay::Card::cx+10)*10,
        ($CardPlay::Card::cy)*7
    ));
    $self->new_cards;

    for($i=0;$i<4;$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 = $x+10; 
    for($i=0;$i<4;$i++) {
    $buff[$i] = TempCardPile->new(-canvas=>$c,-base=>1,
        -tempPiles=>\@cp,
        -board=>$self,-max=>1
    );
    $buff[$i]->display('-x'=>$x,'-y'=>$y);
    $x += $CardPlay::Card::cx+5; 
    }
    $self->{'-bufPiles'} = \@buff;
    $self->add_piles(@buff);

    $x = 5;
    $y = 20;
    my $dl = CardPlay::CardPile->new();
    $self->{'-dealPile'}=$dl;
    $self->add_piles($dl);

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

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

    $self->{'-tempPiles'} = \@cp;
    $self->add_piles(@cp);

    $self;
}

sub setup {
    my $self = shift;

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

    # remove all CardPile
    $self->clear;
    # make new board by saved card array
    @{$dl->{'-contents'}} = @{$self->{'-cards'}}; # copy
    for($i=0;$i<=$#count;$i++) {
    $cp->[$i]->merge($dl->split(- $count[$i]));
    }
    $self;
}

# end

package main;

use strict;
use CardPlay::CardBoard;

my $board = SeeHeavenBoard->new();

$board->game();

1;

# end