#!/usr/bin/env perl

use 5.008;

use strict;
use warnings;

use Getopt::Long 2.33 qw{ :config auto_version };
use Pod::Usage;
use Term::ReadLine;
use Text::ParseWords qw{ shellwords };

our $VERSION = '0.000_90';

use constant IS_VMS	=> { map { $_ => 1 } qw{ VMS } }->{$^O};
use constant IS_WINDOWS	=> { map { $_ => 1 } qw{ MSWin32 } }->{$^O};

use constant PROFILE	=> IS_VMS ? 'sys$login:game_life.ini' :
    IS_WINDOWS ? "@{[ $ENV{USERPROFILE} || $ENV{WINDIR} ]}/game_life.ini" :
    "$ENV{HOME}/.game-life.ini";

use constant CLEAR_STRING	=> -t STDOUT ? IS_WINDOWS ? do {
    require Win32::Console;
    Win32::Console->new( STD_OUTPUT_HANDLE )->Cls();
} : do {
    require Term::Cap;
    Term::Cap->Tgetent( { OSPEED => 9600 } )->Tputs( 'cl' );
} : '';

use constant READER => -t STDIN ? do {
    my $rl = Term::ReadLine->new( 'life' );
    sub { return $rl->readline( $_[0] ) };
} : sub { return <STDIN> };

my %opt = (
    autoclear	=> 0,
    autoprint	=> 0,
    dead	=> '.',
    faster	=> 1,
    living	=> 'X',
    profile	=> -f PROFILE ? PROFILE : undef,
    size	=> 10,
);

my $living_case;

GetOptions( \%opt,
    qw{ autoclear! autoprint! faster! size=s },
    'dead=s'	=> \&_state_opt,
    'living=s'	=> \&_state_opt,
    'profile=s'	=> sub {
	-f $_[1]
	    or die "File $_[1] not found\n";
	$opt{$_[0]} = $_[1];
	return;
    },
    'size=s'	=> sub {
	if ( $_[1] =~ m/ \A [1-9][0-9]* \z /smx ) {
	    $opt{$_[0]} = $1;
	} elsif ( $_[1] =~ m/ \A ( [1-9][0-9]* ) , ( [1-9][0-9]* ) \z /smx ) {
	    $opt{$_[0]} = [ +$1, +$2 ];
	} else {
	    die "-size must be a positive integer, or two such comma-separated\n";
	}
	return;
    },
    help => sub { pod2usage( { -verbose => 2 } ) },
) or pod2usage( { -verbose => 0 } );

# This is needed only if -living was not specified.
$living_case
    or _state_opt( living => $opt{living} );

my $life;
my @reader_stack = ( READER );

if ( $opt{faster} ) {
    warn "Using Game::Life::Faster\n";
    require Game::Life::Faster;
    $life = Game::Life::Faster->new( $opt{size} );
} else {
    warn "Using Game::Life\n";
    require Game::Life;
    $life = Game::Life->new( $opt{size} );
}

$opt{profile}
    and cmd_source( $opt{profile} );

while ( defined( my $line = reader( 'life> ' ) ) ) {
    chomp $line;
    $line =~ m/ \A \s* (?: \z | \# ) /smx
	and next;
    my ( $verb, @arg ) = shellwords( $line );
    if ( my $code = __PACKAGE__->can( "cmd_$verb" ) ) {
	eval {
	    $code->( @arg );
	    1;
	} or warn $@;
    } else {
	warn "Verb '$verb' not recognized\n";
    }
}

print "\n";

sub cmd_autoclear {
    return _bool_opt( autoclear => @_ );
}

sub cmd_autoprint {
    return _bool_opt( autoprint => @_ );
}

sub _bool_opt {
    my ( $name, $val ) = @_;
    if ( @_ > 1 ) {
	$val =~ m/ \A (?: false | no | off ) \z /smxi
	    and $val = 0;
	$opt{$name} = $val ? 1 : 0;
    }
    print "$name ", $opt{$name} ? "on\n" : "off\n";
    return;
}

sub cmd_clear_grid {
    $life->clear();
    return;
}

sub cmd_clear_point {
    my ( $x, $y ) = @_;
    $life->unset_point( $x, $y );
    return;
}

sub cmd_clear_screen {
    print CLEAR_STRING;
    return;
}

sub cmd_dead {
    return _state_opt( dead => @_ );
}

sub cmd_dump {
    my ( $method, @arg ) = @_;
    my $data = $method ? $life->$method( @arg ) : $life->{grid};
    if ( eval { require Data::Dump; 1; } ) {
	print Data::Dump::dump( $data ), "\n";
    } elsif ( eval { require Data::Dumper; 1; } ) {
	no warnings qw{ once };
	local $Data::Dumper::Terse = 1;
	local $Data::Dumper::Sortkeys = 1;
	print Data::Dumper::Dumper( $data );
    } else {
	die "No dumper available\n";
    }
    return;
}

sub cmd_exit {
    pop @reader_stack;
    return;
}

sub cmd_grid {
    $opt{autoclear}
	and cmd_clear_screen();
    print "$_\n" for $life->get_text_grid( $opt{living}, $opt{dead} );
    return;
}

sub cmd_help {
    pod2usage( { -verbose => 2, -exitval => 'NOEXIT' } ),
    return;
}

sub cmd_living {
    _state_opt( living => @_ );
    return;
}

sub cmd_load {
    my ( $fn, $layers ) = @_;
    defined $fn
	or die "File name must be specified\n";
    defined $layers
	or $layers = '';
    $layers =~ s/ \A (?= [^:] ) /:/smx;
    open my $fh, "<$layers", $fn
	or die "Failed to open $fn <$layers: $!\n";
    my @array;
    while ( <$fh> ) {
	chomp;
	push @array, $living_case->( $_ );
    }
    close $fh;
    $life->clear();
    $life->place_text_points( 0, 0, $opt{living}, @array );
    return;
}

sub cmd_place_points {
    my ( $x, $y, @array ) = @_;
    $life->place_text_points( $x, $y, $opt{living}, map { $living_case->(
	    $_ ) } @array );
    return;
}

sub cmd_process {
    my ( $steps ) = @_;
    my $changes = $life->process( $steps );
    $opt{autoclear}
	and cmd_clear_screen();
    local $opt{autoclear} = 0;
    $opt{faster}
	and print "$changes cells changed state on the last iteration\n";
    $opt{autoprint}
	and cmd_grid();
    return;
}

sub cmd_save {
    my ( $fn, $layers ) = @_;
    defined $fn
	or die "File name must be specified\n";
    defined $layers
	or $layers = '';
    $layers =~ s/ \A (?= [^:] ) /:/smx;
    open my $fh, ">$layers", $fn
	or die "Failed to open $fn >$layers: $!\n";
    foreach ( $life->get_text_grid() ) {
	print { $fh } "$_\n";
    }
    close $fh;
    return;
}

sub cmd_set_point {
    my ( $x, $y ) = @_;
    $life->set_point( $x, $y );
    return;
}

sub cmd_source {
    my ( $path ) = @_;
    open my $fh, '<', $path
	or die "Failed to open $path: $!\n";
    push @reader_stack, sub { <$fh> };
    return;
}

sub cmd_unset_point {
    my ( $x, $y ) = @_;
    $life->unset_point( $x, $y );
    return;
}

sub reader {
    my ( $arg ) = @_;
    while ( @reader_stack ) {
	my $rslt;
	defined( $rslt = $reader_stack[-1]->( $arg ) )
	    and return $rslt;
	pop @reader_stack;
    }
    return;
}

sub _state_opt {
    my ( $name, $val ) = @_;
    if ( @_ > 1 ) {
	length $val
	    or die "\u$name value must not be ''\n";
	$opt{$name} = substr $val, 0, 1;
	if ( my $code = __PACKAGE__->can( "_set_${name}_case" ) ) {
	    $code->();
	}
    }
    # The following is a kluge. I don't want this printed until the game
    # is underway.
    $life
	and print "$name $opt{$name}\n";
    return;
}

sub _set_living_case {
    my ( $arg ) = @_;
    $opt{living} =~ m/ \A [[:upper:]] \z /smx
	and return $living_case = sub { uc $_[0] };
    $opt{living} =~ m/ \A [[:lower:]] \z /smx
	and return $living_case = sub { lc $_[0] };
    return $living_case = sub { $_[0] };
}

__END__

=head1 TITLE

game-life - Interactive wrapper for L<Game::Life::Faster|Game::Life::Faster>

=head1 SYNOPSIS

 game-life -help
 game-life -version
 game-life
 life> place_points 0 0 .x ..x xxx
 life> process
 life> grid
 ..........
 X.X.......
 .XX.......
 .X........
 ..........
 ..........
 ..........
 ..........
 ..........
 ..........
 life> exit

=head1 OPTIONS

=head2 -autoclear

If this Boolean option is asserted, the screen is cleared before the
grid is printed.

The default is C<-noautoclear>.

=head2 -autoprint

If this Boolean option is asserted, the grid is printed after it is
processed.

The default is C<-noautoprint>.

=head2 -dead

 -dead +

This option specifies the character to be used for "dead" cells. If a
letter is specified, uses of this letter on input will be case-blind.

The default is C<-dead .>.

=head2 -faster

If this Boolean option is asserted,
L<Game::Life::Faster|Game::Life::Faster> is used; if not,
L<Game::Life|Game::Life> is used.

The default is C<-faster>, but it can be negated using C<-nofaster>.

=head2 -help

This option displays the documentation for this script. The script then
exits.

=head2 -living

 -living *

This option specifies the character to be used for "living" cells. If a
letter is specified, uses of this letter on input will be case-blind.

The default is C<-living X>.

=head2 -profile

 -profile game-life.ini

This option specifies a profile file to read before prompting the user.
The default depends on the operating system:

=over

=item * VMS: 'sys$login:game_life.ini'

=item * Windows: "$ENV{USERPROFILE}/game_life.ini"

=item * anything else: "$ENV{HOME}/.game-life.ini"

=back

B<Note> that any explicitly-specified file B<must> exist, but the defaut
file need not exist.

=head2 -size

 -size 20
 -size 10,12

This option specifies the size of the grid. It takes as its value either
a single positive integer specifying a square grid of that size, or two
comma-separated positive integers specifying a rectangular grid of that
width and height.

The default is C<-size 10>.

=head2 -version

This option displays the version of this script. The script then exits.

=head1 DETAILS

This Perl script provides an interactive interface to
L<Game::Life::Faster|Game::Life::Faster>, or optionally to
L<Game::Life|Game::Life>.

=head1 COMMANDS

The following commands are implemented:

=head2 autoclear

This command displays the L<-autoclear|/-autoclear> setting. If an
argument is provided, the setting is changed to that value, which is
interpreted as a Perl Boolean value, except for special-case values
C<false>, C<no>, or C<off> (case-insensitive), which are treated as
false.

=head2 autoprint

This command displays the L<-autoprint|/-autoprint> setting. If an
argument is provided, the setting is changed to that value, which is
interpreted as a Perl Boolean value, except for special-case values
C<false>, C<no>, or C<off> (case-insensitive), which are treated as
false.

=head2 clear_grid

This command clears the grid.

=head2 clear_point

 life> clear_point 1 1

This command clears the point at the given row and column. It is
a synonym for L<unset_point|/unset_point>.

=head2 clear_screen

This command clears the screen. It does nothing if standard out is not a
terminal.

=head2 dead

This command displays the L<-dead|/-dead> setting. If an argument is
provided, the setting is changed to the first character of that value.

=head2 dump

This command is unsupported, in the sense that the author reserves the
right to change or revoke it without notice.

If arguments are specified, the first argument is the name of a
L<Game::Life::Faster|Game::Life::Faster> method, and the value dumped is
the result of calling that method with the subsequent arguments.

If no arguments are specified, the internal representation of the grid
is dumped.

The output is serialized using C<Data::Dump::dump()> if that can be
loaded, otherwise with C<Data::Dumper::Dumper()>.

=head2 exit

This command is the equivalent of end-of-file. If issued in a source
file it terminates processing of that file. If issued from standard
input or in response to a command prompt, this script exits.

=head2 grid

This command displays the grid. "Living" cells are represented by
C<'X'>, "dead" cells by C<'.'>.

=head2 help

This command displays the same help provided by the L<-help|/-help>
option, but the script does not exit.

=head2 living

This command displays the L<-living|/-living> setting. If an argument is
provided, the setting is changed to the first character of that value.

=head2 load

 life> load game.life

This command clears the grid and then loads the given file into it. The
file is expected to specify "living" points by C<'X'> or C<'x'>; any
other character represents a "dead" cell. Line breaks delimit rows.

An optional second character can specify L<PerlIO|PerlIO> layers, eg:

 life> load game.life :crlf:encoding(cp1252)

=head2 place_points

 life> place_points 0 0 .x ..x xxx

This command places points into the grid. The first two arguments are
the row and column coordinates of the first point. Subsequent arguments
are string representations of the points to be placed, with each
argument representing consecutive cells in consecutive rows. "Living"
cells are represented by C<'X'> or C<'x'>; any other character
represents a "dead" cell.

The example places a glider in the top-left corner of the grid.

=head2 process

This command causes the game to be processed. An optional parameter
specifies the number of iterations, the default being C<1>.

=head2 set_point

 life> set_point 1 2

This command causes the cell in the specified row and columns to be set
"living."

=head2 source

 life> source life.source

This command opens the given file and reads commands from it.

=head2 unset_point

 life> unset_point 1 1

This command clears the point at the given row and column. It is
a synonym for L<clear_point|/clear_point>.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2019 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :
