package Games::Sequential;
use Carp;
use 5.006001;
use strict;
use warnings;
our $VERSION = '0.4.2';
=head1 NAME
Games::Sequential - sequential games framework with OO interface
=head1 SYNOPSIS
package My::GamePos;
use base qw(Games::Sequential::Position);
sub apply { ... }
package main;
use My::GamePos;
use Games::Sequential;
my $pos = My::GamePos->new;
my $game = Games::Sequential->new($pos);
$game->debug(1);
$game->move($mv);
$game->undo;
=head1 DESCRIPTION
Games::Sequential is a framework for producing sequential games.
Among other things it keeps track of the sequence of moves, and
provides an unlimited C<undo()> mechanism. It also has methods to
C<clone()> or take a C<snapshot()> of a game.
Users must pass an object representing the initial state of the
game as the first argument to C<new()>. This object must provide
the two methods C<copy()> and C<apply()>. You can use
L<Games::Sequential::Position> as a base class, in which case the
C<copy()> method will be provided for you. The C<apply()> method
must take a move and apply it to the current position, producing
the next position in the game.
=head1 METHODS
Users must not modify the referred-to values of references
returned by any of the below methods.
=over 4
=item new $initialpos [@list]
Create and return a new L<Games::Sequential> object. The first
argument must be an object representing the initial position of
the game. The C<debug> option can also be set here.
=cut
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $self = bless {}, $class;
$self->_init(@_) or carp "Failed to init object!";
return $self;
}
=item _init [@list]
I<Internal method>
Initialize a L<Games::Sequential> object.
=cut
sub _init {
my $self = shift;
my $pos = shift or croak "No initial position given!";
my $args = @_ && ref($_[0]) ? shift : { @_ };
my %config = (
# Stacks for backtracking
pos_hist => [ $pos ],
move_hist => [],
# Debug and statistics
debug => 0,
);
# Set defaults
@$self{keys %config} = values %config;
# Override defaults
while (my ($key, $val) = each %{ $args }) {
$self->{$key} = $val if exists $self->{$key};
}
croak "no apply() method defined for position object"
unless $pos->can("apply");
return $self;
}
=item debug [$value]
Return current debug level and, if invoked with an argument, set
to new value.
=cut
sub debug {
my $self = shift;
my $prev = $self->{debug};
$self->{debug} = shift if @_;
return $prev;
}
=item peek_pos
Return reference to current position.
Use this for drawing the board etc.
=cut
sub peek_pos {
my $self = shift;
return $self->{pos_hist}[-1];
}
=item peek_move
Return reference to last applied move.
=cut
sub peek_move {
my $self = shift;
return $self->{move_hist}[-1];
}
=item move $move
Apply $move to the current position, keeping track of history.
A reference to the new position is returned, or undef on failure.
=cut
sub move {
my ($self, $move) = @_;
my ($pos, $npos) = $self->peek_pos;
$npos = $pos->copy or croak "$pos->copy() failed";
$npos->apply($move) or croak "$pos->apply() failed";
push @{ $self->{pos_hist} }, $npos;
push @{ $self->{move_hist} }, $move;
return $self->peek_pos;
}
=item undo
Undo last move. A reference to the previous position is returned,
or undef if there was no more moves to undo.
=cut
sub undo {
my $self = shift;
return unless pop @{ $self->{move_hist} };
pop @{ $self->{pos_hist} }
or croak "move and pos stack out of sync!";
return $self->peek_pos;
}
1; # ensure using this module works
__END__
=back
=head1 TODO
Implement the missing methods C<clone()>, C<snapshot()>,
C<save()> E<amp> C<resume()>.
=head1 SEE ALSO
The author's website, describing this and other projects:
L<http://brautaset.org/software/>
=head1 AUTHOR
Stig Brautaset, E<lt>stig@brautaset.orgE<gt>
=head1 COPYRIGHT AND LICENCE
Copyright (C) 2004-2005 by Stig Brautaset
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.3 or,
at your option, any later version of Perl 5 you may have available.
=cut
# vim: shiftwidth=4 tabstop=4 softtabstop=4 expandtab