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

use strict;

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

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);

@EXPORT = qw( );

$VERSION = "0.2";

use Carp;

sub new {
    my $type = shift;
    my %arg = @_;
    my $self;
    
    %$self = @_;
    defined($arg{'-contents'}) or $self->{'-contents'} = [];
    bless $self;
}

sub merge_args {
    my ($self,%args) = @_;
    foreach my $key ( keys %args ) {
    if (defined( $args{$key} )) { 
        $self->{$key} = $args{$key}; 
    }
    }
}
 
sub shuffle {
    my ($self) = @_;
    my ($card) = $self->{'-contents'};
    my (@old) = @{$self->{'-contents'}};

    $#{$card} = -1;
    while(@old) {
    push(@{$card},splice(@old,rand(@old),1));
    }
    $self;
}

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

sub print {
    my ($self) = @_;
    print STDERR map($_->{'-suit'} . $_->{'-number'}." ",
    @{$self->{'-contents'}}),"\n";
}

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

    return 0 if (! @contents);
    $new = $self->class->new(-contents=>\@contents);
    if (defined($self->{'-reverse_merge'})) {
        $new->reverse();
    }
    return $new;
}

sub reverse {
    my ($self) = @_;
    @{$self->{'-contents'}} = reverse(@{$self->{'-contents'}});
}

sub count {
    my ($self) = @_;
    return $#{$self->{'-contents'}}+1;
}

sub empty {
    my ($self) = @_;
    return !defined($self->{'-contents'}->[0]);
}

sub clear {
    my ($self) = @_;
    $#{$self->{'-contents'}}= -1;
}

sub last {
    my ($self) = @_;
    return $self->{'-contents'}->[$#{$self->{'-contents'}}];
}

sub first {
    my ($self) = @_;
    return $self->{'-contents'}->[0];
}

sub at {
    my ($self,$i) = @_;
    return $self->{'-contents'}->[$i];
}

sub close_all {
    my ($self) = shift;
    local ($_);
    grep($_->{'-state'}='close',@{$self->{'-contents'}});
}

sub open_all {
    my ($self) = shift;
    local ($_);
    grep($_->{'-state'}='open',@{$self->{'-contents'}});
}

1;

# end