#
#
# $Id: seeheaven.pl,v 4.6 2000/01/16 10:00:53 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+6)*10,500));
    $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();

if (grep /-large/,@ARGV) {
    $board->{'-large'}=1;
} 

$board->game();

1;

# end
