#!/usr/bin/env perl

use 5.008001;

use strict;
use warnings;

use Getopt::Long 2.33 qw{ :config auto_version };
use List::Util qw{ max };
use Pod::Usage;
use Scalar::Util qw{ looks_like_number };
use Term::ReadLine;
use Text::ParseWords qw{ shellwords };

BEGIN {
    local $@ = undef;
    eval {
	require Time::HiRes;
	Time::HiRes->import( 'sleep' );
	*_validate_pause = sub {
	    my ( $name, $val ) = @_;
	    looks_like_number( $val )
		and $val >= 0
		or die "\u$name must be a non-negative number\n";
	    return;
	};
	1;
    } or do {
	*_validate_pause = sub {
	    my ( $name, $val ) = @_;
	    $val =~ m/ \A [0-9]+ \z /smx
		and $val >= 0
		or die "\u$name must be a non-negative integer\n";
	    return;
	};
	warn "Time::HiRes unavailable. Pause values must be integers\n";
    };
}

our $VERSION = '0.007';

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_faster.ini' :
    IS_WINDOWS ?
	"@{[ $ENV{USERPROFILE} || $ENV{WINDIR} ]}/game_life_faster.ini" :
    "$ENV{HOME}/.game-life-faster.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,
    breed	=> [ 3 ],
    dead	=> '.',
    faster	=> 1,
    live	=> [ 2, 3 ],
    living	=> 'X',
    pause	=> 0,
    profile	=> -f PROFILE ? PROFILE : undef,
    size	=> 20,
);

my $living_case;

GetOptions( \%opt,
    qw{ autoclear! autoprint! faster! },
    'dead=s'	=> \&_state_opt,
    'living=s'	=> \&_state_opt,
    'pause=f'	=> \&_pause_opt,
    'profile=s'	=> sub {
	-f $_[1]
	    or die "File $_[1] not found\n";
	$opt{$_[0]} = $_[1];
	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 );

cmd_new( @ARGV );

$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_active {
    my ( $living, $dead ) = @_;
    my ( $min_x, $min_y, $rslt ) = $life->get_active_text_grid(
	$living, $dead );
    print "$min_x,$min_y\n$rslt";
    return;
}

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

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

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 {
    local @ARGV = @_;
    my %o = %opt;
    GetOptions( \%o,
	qw{ living=s },
    ) or return;
    my ( $file, $x, $y ) = @ARGV;
    $x ||= 0;
    $y ||= 0;
    my @rows;
    local $_ = undef;
    open my $fh, '<:encoding(utf-8)', $file
	or die "Unable to open $file: $!\n";
    while ( <$fh> ) {
	s/ \s+ \z //smx;
	push @rows, $_;
    }
    close $fh;
    $life->place_text_points( $x, $y, $o{living}, @rows );
    return;
}

sub cmd_new {
    my @arg = @_;
    Getopt::Long::GetOptionsFromArray( \@arg, \%opt, qw{ faster! } )
	or return;
    my ( $size, $breed, $live ) = @arg;
    _size( size => $size );
    _rule( breed => $breed );
    _rule( live => $live );
    my $class;
    if ( $opt{faster} ) {
	$class = 'Game::Life::Faster';
	require Game::Life::Faster;
    } else {
	$class = 'Game::Life';
	require Game::Life;
    }
    print "$class->new( ", join( ', ', map{ _expand( $opt{$_} ) } qw{
	    size breed live } ), ")\n";
    $life = $class->new( map { $opt{$_} } qw{ size breed live } );
    return;
}

sub cmd_pause {
    my ( $pause ) = @_;
    defined $pause
	and _pause_opt( pause => $pause );
    print "pause $opt{pause}\n";
    return;
}

sub cmd_used {
    my ( $living, $dead ) = @_;
    my ( $min_x, $min_y, $rslt ) = $life->get_used_text_grid(
	$living, $dead );
    print "$min_x,$min_y\n$rslt";
    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 ) = @_;
    ( $steps, my $iter8 ) = $opt{pause} ? ( 1, $steps ) : ( $steps, 1 );
    for ( 1 .. $iter8 ) {
	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();
	$opt{pause}
	    and sleep $opt{pause};
    }
    return;
}

sub cmd_save {
    my ( $fn ) = @_;
    defined $fn
	or die "File name must be specified\n";
    my $rows = my @grid = $life->get_text_grid( 'X', '.' );
    my $cols = max( map { length } @grid );
    my $size = ( $rows == $cols ) ? $rows : "$cols,$rows";
    open my $fh, '>:encoding(utf-8)', $fn	## no critic (RequireBriefOpen)
	or die "Failed to open $fn: $!\n";
    print { $fh } join( ' ', new =>
	$life->isa( 'Game::Life::Faster' ) ? '-faster' : '-nofaster',
	$size,
	join( ',', $life->get_breeding_rules() ),
	join( ',', $life->get_living_rules() ),
    ), "\n";
    my $x = 0;
    foreach my $row ( @grid ) {
	$row =~ s/ [.]+ \z //smx;
	'' eq $row
	    or print { $fh } join( ' ', place_points => $x, 0, $row), "\n";
	$x++;
    }
    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	## no critic (RequireBriefOpen)
	or die "Failed to open $path: $!\n";
    push @reader_stack, sub { <$fh> };
    return;
}

sub cmd_step {
    goto &cmd_process;
}

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

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 _expand {
    my ( $val ) = @_;
    return ref $val ?
	1 == @{ $val } ?
	    $val->[0] :
	    q<'> . join( ',', @{ $val } ) . q<'> :
	$val;
}

sub _pause_opt {
    my ( $name, $val ) = @_;
    _validate_pause( $name, $val );
    $opt{$name} = $val;
    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 _rule {
    my ( $name, $val ) = @_;
    defined $val
	and '' ne $val
	or return;
    $val =~ m/ \A [0-9]+ (?: \s* , \s* [0-9]+ )* \z /smx
	or die "\u$name must be a comma-separated list of non-negative integers\n";
    $opt{$name} = [ split qr< \s* , \s* >smx, $val ];
    return;
}

sub _set_living_case {
    $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] };
}

sub _size {
    my ( $name, $val ) = @_;
    defined $val
	and '' ne $val
	or return;
    if ( $val =~ m/ \A [1-9][0-9]* \z /smx ) {
	$opt{$name} = +$val;
    } elsif ( $val =~ m/ \A ( [1-9][0-9]* ) , ( [1-9][0-9]* ) \z /smx ) {
	$opt{$name} = [ +$1, +$2 ];
    } else {
	die "\u$name must be a positive integer, or two such comma-separated\n";
    }
    return;
}

__END__

=head1 TITLE

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

=head1 SYNOPSIS

 game-life-faster -help
 game-life-faster -version
 game-life-faster
 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 -pause

 -pause 0.25

This option specifies the pause after each iteration, in seconds. It
takes fractional values, but these are only useful if
L<Time::HiRes|Time::HiRes> can be loaded.

The default is C<-pause 0>.

=head2 -profile

 -profile game-life-faster.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_faster.ini'

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

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

=back

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

=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>.

In addition to the above options this script accepts one to three
arguments:

=over

=item size

This is the size of the grid to produce. It is either a positive
integer, or two positive integers separated by a comma. The former
produces a square grid of the given size. The latter produces a
rectangular grid of the given width and height.

The default is C<20>.

=item breed

This is the breeding rule, specified as a comma-separated list of
non-negative integers. "Dead" cells having one of the specified numbers
of "living" neighbors will become "living" in the next generation.

The default is C<3>.

=item live

This is the living rule, specified as a comma-separated list of
non-negative integers. "Living" cells having one of the specified
numbers of "living" neighbors will remain "living" in the next
generation; all other "living" cells will become "dead" in the next
generation.

The default is C<2,3>.

=back

=head1 COMMANDS

The following commands are implemented:

=head2 active

 life> active

This command displays the active portion of the grid as returned by the
L<get_active_text_grid()|Game::Life::Faster/get_active_text_grid>
method.

=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 -living * grid.txt 2 2

This command loads the grid with the contents of the file specified as
the first argument. This file is a picture of the desired grid as "ASCII
art".

The second and third arguments specify the row and column coordinates of
the top left corner of the grid. Both default to C<0>.

This command also takes the option C<-living>, which specifies the
character which represents a living cell. The default is the value of
C<-living> which was specified when the script was launched. Any cell
represented by a character other than this is considered dead.

=head2 new

 life> new -faster 20 2 2,3

This command replaces the old game object with a new one. The arguments
are the same as for the script itself, but the only supported option is
L<-faster|/-faster>. All arguments and options default to their previous
value.

=head2 pause

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

=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 save

 life> save life.txt

This command saves the current object in a text file which contains the
F<game-life-faster> commands needed to recreate it. These commands can be
re-executed by:

 life> source life.txt

=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 step

This is just a synonym for L<process|/process>.

=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>.

=head2 used

 life> used

This command displays the used portion of the grid as returned by
the
L<get_used_text_grid()|Game::Life::Faster/get_used_text_grid>
method.

=head1 AUTHOR

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

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2019-2022 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 :
