#
#  $Id: CardPile.pm,v 4.9 2002/07/21 06:49:52 kono Exp $
#
package CardPlay::CardPile;

use strict;

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

require Exporter;
require AutoLoader;

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

@EXPORT = qw( );

$VERSION = "0.2";

use Tk;
use Carp;
use CardPlay::Card;
use CardPlay::SimpleCardPile;
use CardPlay::CardPileUndo;
# use CardPlay::CardBoard;

$CardPlay::CardPileTag = 'cardpile000';

sub new {
    my $type = shift;
    my %arg = @_;
    my $self;
    
    $self = CardPlay::SimpleCardPile->new(@_);
    defined($arg{'-tag'}) or $self->{'-tag'} = $CardPlay::CardPileTag++;
    defined($arg{'-deltax'}) or $self->{'-deltax'} = 0;
    defined($arg{'-deltay'}) or $self->{'-deltay'} = $CardPlay::Card::deltax;

    defined($arg{'-contents'}) or $self->{'-contents'} = [];
    $self->{'-bind'} = {};
    bless $self;
}

sub bind {
    my ($self) = shift;
    my (%args) = @_;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    my ($bind) = $self->{'-bind'};

    if ($#_ == -1) {
# print STDERR "binding...\n";
    foreach my $key ( keys %{$bind} ) {
        $c->bind($tag, $key => $bind->{$key});
    }
    } else {
    foreach my $key ( keys %args ) {
        if (defined( $args{$key} )) { 
        $bind->{$key} = $args{$key}; 
        }
    }
    }
}

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

    $self->bind('<1>' => sub {$self->plot_down(@_)});
#    $self->bind('<2>' => sub {$self->hide(@_)});
#    $self->bind('<3>' => sub {$self->open(@_)});
    $self->bind('<ButtonRelease-1>' => sub {shift->dtag('selected')});
    $self->bind('<B1-Motion>' => sub {$self->plot_move(@_)});
    $self->bind();
}

sub unbind {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    foreach my $key ( keys %{$self->{'-bind'}} ) {
    $c->bind($tag, $key => "");
    }
}

sub display {
    my ($self,%args) = @_;
    $self->merge_args(%args);

    my ($tag) = $self->{'-tag'};
    my ($x) = defined($self->{'-x'})?$self->{'-x'}:0;
    my ($y) = defined($self->{'-y'})?$self->{'-y'}:0;
    my ($dx) = $self->{'-deltax'};
    my ($dy) = $self->{'-deltay'};
    my ($xx,$yy);
    my ($ctag,$basetag);
    my ($first) = 0;
    my ($c) = $self->{'-canvas'} or  carp "needs -canvas\n";

    if (defined( $self->{'-base'} )) { 
    if (defined( $self->{'-basetag'} )) {
        ($xx,$yy) = $c->coords($self->{'-basetag'});
        if($xx != $x || $yy != $y) {
        $c->move($self->{'-basetag'},$x-$xx,$y-$yy);
        }
    } else {
        $self->{'-basetag'} = $basetag = 
        $c->create('rectangle',$x,$y,$x+$CardPlay::Card::cx,$y+$CardPlay::Card::cy);
        $c->addtag($tag, withtag => $basetag);
    }
    }
    foreach my $i ( @{$self->{-contents}} ) {
    $first = $i if (! $first);
    if (defined( $i->{'-tag'})) {
        ($xx,$yy) = $i->coords();
        if($xx != $x || $yy != $y) {
        $c->move($i->{'-tag'},$x-$xx,$y-$yy);
        }
    } else {
        $i->display('-x'=>$x,'-y'=>$y);
        $c->addtag($tag, withtag => ($i->{'-tag'}));
    }
    $i->raise();
    $x += $dx;
    $y += $dy;
    } 
    # if (defined( $self->{'-basetag'} ) && $first) { 
    #     $c->lower($self->{'-basetag'},$first->{'-tag'});
    # }
    if ($self->{'-movable'}) {
    $self->movable();
    } elsif ($self->{'-splitable'}) {
    $self->splitable();
    }
    if ($self->{'-mergeable'}) {
    $self->mergeable();
    }
    if ($self->{'-auto_open'}) {
    $self->open();
    }
    $self->bind();
    return $self;
}
 
sub raise {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    $c->raise($tag);
}

sub plot_down {
    my ($self) = shift;
    my ($w) = @_;
    my ($e) = $w->XEvent;
    my ($x, $y) = ($e->x, $e->y);
    my ($tag) = $self->{'-tag'};

    $w->dtag('selected');
    $w->addtag('selected', withtag => $self->{'-tag'});
    $w->raise($tag);
    $self->{'-lastX'} = $x;
    $self->{'-lastY'} = $y;
} # end plot_down


sub plot_move {
    my ($self) = shift;
    my ($w) = @_;
    my $e = $w->XEvent;
    my ($x, $y) = ($e->x, $e->y);
    $w->move('selected',  $x-$self->{'-lastX'}, $y-$self->{'-lastY'});
    $self->{'-lastX'} = $x;
    $self->{'-lastY'} = $y;
} # end plot_move

sub hide {
    my ($self) = @_;

    my ($card) = $self->last();
    if (defined($card)) {
    if ($card->{'-state'} eq 'open') {
        $card->hide();
    }
    }
}

sub open {
    my ($self) = @_;

    my ($card) = $self->last();
    if (defined($card)) {
    if ($card->{'-state'} eq 'hide') {
        $card->open();
    }
    }
}


sub splitable {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    my ($i,$j);
    $j = 0;
    foreach $i ( @{$self->{-contents}} ) {
    my ($jj) = $j;
    $c->bind($i->{'-tag'}, '<1>' => sub {$self->split_event($jj,@_)});
    $j++;
    } 
#    $self->bind('<2>' => sub {$self->hide(@_)});
#    $self->bind('<3>' => sub {$self->open(@_)});
#    $self->bind('<ButtonRelease-1>' => sub {$self->merge_event(@_)});
#    $self->bind('<B1-Motion>' => sub {$self->plot_move(@_)});
    $self->bind();
}

sub unsplitable {
    my ($self) = shift;
    my ($c) = $self->{'-canvas'};
    my ($tag) = $self->{'-tag'};
    my ($i);
    foreach $i ( @{$self->{-contents}} ) {
    $c->bind($i->{'-tag'}, '<1>' => "");
    } 
    $self->unbind();
}

sub clear {
    my ($self) = @_;
    my ($card);

    foreach $card ( @{$self->{'-contents'}} ) {
    $card->clear;
    }
    $self->SUPER::clear();
    $self->unbind();
    
    # $self->{'-canvas'}->delete($self->{'-tag'});
    if (defined($self->{'-mergeable'})) {
    $self->{'-board'}->delete_drag($self);
    }
}

sub DESTROY {
    my ($self) = @_;

    $self->unbind();
    $self->{'-canvas'}->dtag($self->{'-tag'});
    if (defined($self->{'-mergeable'})) {
    $self->{'-board'}->delete_drag($self);
    }
    1;
}

sub mergeable {
    my ($self) = shift;
    $self->{'-mergeable'}=1;
    $self->{'-board'}->add_drag($self);
}

sub merge {
    my ($self,$cardpile) = @_;
    return if ($cardpile==0);
    my ($contents) = $cardpile->{'-contents'};
    my ($c) = $self->{'-canvas'};
    if (defined($self->{'-reverse_merge'})) {
    $cardpile->reverse();
    }
    if (! $c ) {
    push(@{$self->{-contents}},@{$cardpile->{-contents}});
    $cardpile='';
    return;
    }

    $c->addtag($self->{'-tag'}, withtag => $cardpile->{'-tag'});
    $c->dtag($cardpile->{'-tag'},$cardpile->{'-tag'});
    push(@{$self->{-contents}},@{$cardpile->{-contents}});
    $self->display();
    $cardpile = '';
    # if ($self-> {'-splitable'}) {  # this has been done by display
    #     $self->splitable();
    # } 
}

sub merge_event {
    my ($self,$w) = @_;
    my ($e) = $w->XEvent;
    my ($x, $y) = ($e->x, $e->y);
    my ($draggedPile);
    my ($c) = $self->{'-canvas'};

# print STDERR "merge_event ";$self->print;
    if (! $self->{'-prevSplit'}) {
#    print STDERR "reenter merge_event..\n";
    return;
    }
    if (defined($self->{'-board'})) {
    return 0 if ($self->{'-board'}->{'-auto_playing'}) ;
    $self->{'-board'}->log_commit(0);
    }
    $w->dtag('selected');
    my $cx = $c->canvasx($x);
    my $cy = $c->canvasy($y);
    if (defined(($draggedPile = $self->{'-board'}->check_drag($cx,$cy)))) {
# print STDERR "drag on ";$draggedPile->print;
    if (! $draggedPile->can('can_merge')) {
        $draggedPile->do_merge($self);
        $draggedPile->auto_play();
        return;
    } 
    # before checking prevSplit==$self, try intelligent move
        my $ret = $draggedPile->can_merge($self);
    if ($ret == 1) {
        # yes we can merge
        if ($draggedPile eq $self->{'-prevSplit'}) {
        # but this is myself
        $self->unsplit();
        return;
        }
        $draggedPile->do_merge($self);
        $draggedPile->auto_play();
        return;
    } elsif ($ret == 2) {
        # can_merge done everything forget unsplit
        $self->{'-prevSplit'}=0;
        $draggedPile->auto_play();
        return;
    }
    # go into unsplit
    } 
    $self->unsplit();
}

sub auto_play {
    my ($self) = @_;
    my ($board) = $self->{'-board'};
   
    return if (! $board);     
    if ($board->{'-auto_play'} && $board->can('auto_play')
        && ! $board->{'-auto_playing'}) {
        $board->{'-auto_playing'}=1;
        $board->auto_play();
        $board->{'-auto_playing'}=0;
    }
}

sub do_merge {
    my ($self,$cardpile) = @_;
    # merge with undo log and -auto_open processing
    my ($prevSplit) = $cardpile->{'-prevSplit'};

    # usually self merge is not allowed but we don't prohibit it here
    $self->merge($cardpile);
    $self->mergeable() if ($self->{'-mergeable'});
    if (defined($self->{'-board'})) {
    $self->{'-board'}->log_move(
        CardPlay::CardPileUndo->new(
        -from=>$prevSplit,
        -to=>$self,
        -at=> - ($#{$cardpile->{'-contents'}}+1)));
    }
    $cardpile->{'-prevSplit'}=0;
    if ($prevSplit->{'-auto_open'}) {
    $prevSplit->open();
    }
    return;
}

sub split {
    my ($self,$i) = @_;
    my ($new);
    my ($tag,$j);
    my ($x,$y);
    my ($c) = $self->{'-canvas'};
    my (@contents);
    if ($i>=0) {
    @contents = splice(@{$self->{'-contents'}},$i);
    } else {
    @contents = splice(@{$self->{'-contents'}},$#{$self->{'-contents'}}+$i+1);
    }

    return 0 if (! @contents);
    $new = CardPlay::CardPile->new(-contents=>\@contents,-canvas=>$c);
    $new->{'-deltax'} = $self->{'-deltax'};
    $new->{'-deltay'} = $self->{'-deltay'};
    if (defined($self->{'-reverse_merge'})) {
    $new->reverse();
    }
    return $new if (! defined($c));

    if (defined($self->{'-board'})) {
    $new->{'-board'} = $self->{'-board'};
    }
    # push event traces $self's tag, so exchage it 
    $self->unbind();
    ($self->{'-tag'},$new->{'-tag'}) = ($new->{'-tag'},$self->{'-tag'});
    foreach $j ( @{$self->{'-contents'}} ) {
    $tag = $j->{'-tag'};
    $c->addtag($self->{'-tag'},withtag=>$tag);
    }
    $c->dtag($self->{'-tag'},$new->{'-tag'});
    if ($self->{'-basetag'}) {
    $c->dtag($self->{'-basetag'},$new->{'-tag'});
    $c->addtag($self->{'-tag'},withtag=>$self->{'-basetag'});
    }  
    $self->bind();
    if ($self->{'-splitable'}) {
    $new->unsplitable();
    }
    return $new;
}

sub split_event {
    my ($self,$i,$w) = @_;
# print STDERR "split_event ";$self->print;
    my ($e) = $w->XEvent;
    my ($lx, $ly) = ($e->x, $e->y);
    if (defined($self->{'-board'})) {
    return 0 if ($self->{'-board'}->{'-auto_playing'}) ;
    }
    return if ($self->{'-prevSplit'}); # reentering...
    return if ($self->can('can_split') && ! $self->can_split($i));
# print STDERR "splited... ",$new->print;
    my ($new) = $self->split($i); 
    return if (! $new);

    $new->{'-prevSplit'} = $self;
    $new->{'-lastX'} = $lx;
    $new->{'-lastY'} = $ly;
    $new->movable();
    $w->bind($new->{'-tag'}, 
    '<ButtonRelease-1>' => sub {$new->merge_event(@_)});

    $w->dtag('selected');
    $w->addtag('selected',withtag => $new->{-tag});
    $w->raise($new->{-tag});
}

sub do_split {
    my ($self,$i) = @_;
    my ($new) = $self->split($i); 
    return if (! $new);
    $new->{'-prevSplit'} = $self;
    $new->raise() if (defined($self->{'-contents'}));
    return $new;
}

sub unsplit {
    my ($self) = @_;
    my ($prevSplit) = $self->{'-prevSplit'};
    if ($prevSplit) {
# print STDERR "unsplit ",$prevSplit->print," merged ",$self->print;
    $prevSplit->merge($self);
    $self->{'-prevSplit'} = 0;
    } else {
    print STDERR "lost prevSplit\n";
    }
    # we should destory myself
}

sub coords {
    my ($self) = @_;
    my ($first) = $self->first();
    my ($x,$y);
    if (defined($first)) {
    ($x,$y) =  $first->coords();
    return ($x,$y);
    } elsif (defined($self->{'-basetag'})) {
    ($x,$y) =  $self->{'-canvas'}->coords($self->{'-basetag'});
    return ($x,$y);
    }
    return (undef,undef);
}

sub last_coords {
    my ($self) = @_;
    my ($last) = $self->last();
    my ($x,$y);
    if (defined($last)) {
    ($x,$y) =  $last->coords();
    return ($x,$y);
    } elsif (defined($self->{'-basetag'})) {
        ($x,$y) = $self->{'-canvas'}->coords($self->{'-basetag'});
    return ($x-$self->{'-deltax'},$y-$self->{'-deltay'});
    }
    return (undef,undef);
}

sub bbox {
    my ($self) = @_;
    return $self->{'-canvas'}->bbox($self->{'-tag'});
}

1;

# end