#!perl

$| = 1;

use strict;
use warnings;

use Scalar::Util qw( blessed );
use Try::Tiny;

use Games::Dukedom;

my $VERSION = '0.1.1';

my $input_yn = sub {
    my $default = shift || '';

    my $ans = <>;
    chomp($ans);
    $ans ||= $default;

    return ( $ans =~ /^(?:q|quit)\s*$/i || $ans =~ /^(?:y|n)$/i )
      ? lc($ans)
      : undef;
};

my $input_value = sub {
    my $default = shift || 0;

    my $ans = <>;
    chomp($ans);
    $ans = $default unless length($ans);

    return ( $ans =~ /^(?:q|quit)\s*$/i || $ans !~ /\D/ ) ? $ans : undef;
};

my %actions = (
    get_yn    => $input_yn,
    get_value => $input_value,
);

while (1) {
    play_game();

    print "Do you want to play again [Y/n]? ";
    my $play = <>;
    chomp($play);
    $play ||= 'Y';

    last unless $play =~ /^y/i;
    print "Okay, let's go again. Good luck!\n\n";
}

exit;

sub play_game {
    my $game = Games::Dukedom->new;

    do {
        try {
            $game->play_one_year;
        }
        catch {
            if ( blessed($_) && $_->isa('Games::Dukedom::Signal') ) {
                print $_->msg if $_->msg;
                return unless defined( $_->action );

                my $action = $_->action;
                $game->input( &{ $actions{$action} }( $_->default ) );
            }
            else {
                die $_;
            }
        };
    } until ( $game->game_over );

    return;
}

__END__

=pod

=head1 NAME

dukedom - The classic big iron game of land management

=head1 SYNOPSIS

  
 $ dukedom
   
  
=head1 DESCRIPTION

=head1 GAMEPLAY

=head1 SEE ALSO

This package is based on the logic found in this C code, which appears to
have been derived from an older source written in Basic:

L<https://github.com/caryo/Dukedom/blob/master/imports/dukedom.c>

=head1 BUGS

Seriously? Look at the version number.

=head1 AUTHOR

Jim Bacon, E<lt>jim@nortx.comE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014 by Jim Bacon

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 or,
at your option, any later version of Perl 5 you may have available.

=cut
