gitea-mirror/basic-computer-games
1
0
Fork 0
mirror of https://github.com/coding-horror/basic-computer-games.git synced 2026-02-05 19:32:48 -08:00
Code Issues Packages Projects Releases Wiki Activity

Clean up dead code left over from cut-and-paste development.

Browse Source
This commit is contained in:
Tom Wyant
2022-01-07 10:49:49 -05:00
parent ec591376cc
commit 9df2579cdb
1 changed files with 4 additions and 265 deletions
Download Patch File Download Diff File Expand all files Collapse all files

269
81_Splat/perl/splat.pl
View File

@@ -298,281 +298,20 @@ sub get_yes_no {
__END__
print <<'EOD' if get_yes_no( 'Do you want instructions' );
We are going to play a game based on one of the chess
moves. Our queen will be able to move only to the left,
down, or diagonally down and to the left.
The object of the game is to place the queen in the lower
left hand square by alternating moves between you and the
computer. The first one to place the queen there wins.
You go first and place the queen in any one of the squares
on the top row or right hand column.
That will be your first move.
We alternate moves.
You may forfeit by typing '0' as your move.
Be sure to press the return key after each response.
EOD
while ( 1 ) {
say '';
foreach my $row ( 0 .. 7 ) {
printf ROW_TPLT, map { ( $_ + $row ) * 10 + $row + 1 } reverse 1 .. 8;
}
}
# Get input from the user. The arguments are:
# * The prompt
# * A reference to validation code. This code receives the response in
# $ARG and returns true for a valid response.
# * A warning to print if the response is not valid. This must end in a
# return.
# The first valid response is returned. An end-of-file terminates the
# script.
sub get_input {
my ( $prompt, $validate, $warning ) = @ARG;
# If no validator is passed, default to one that always returns
# true.
$validate ||= sub { 1 };
# Create the readline object. The 'state' causes the variable to be
# initialized only once, no matter how many times this subroutine is
# called. The do { ... } is a compound statement used because we
# need to tweak the created object before we store it.
state $term = do {
my $obj = Term::ReadLine->new( 'reverse' );
$obj->ornaments( 0 );
$obj;
};
while ( 1 ) { # Iterate indefinitely
# Read the input into the topic variable, localized to prevent
# Spooky Action at a Distance. We exit on undef, which signals
# end-of-file.
exit unless defined( local $ARG = $term->readline( $prompt ) );
# Return the input if it is valid.
return $ARG if $validate->();
# Issue the warning, and go around the merry-go-round again.
warn $warning;
}
}
# Get a yes-or-no answer. The argument is the prompt, which will have
# '? [y/n]: ' appended. The donkey work is done by get_input(), which is
# requested to validate the response as beginning with 'y' or 'n',
# case-insensitive. The return is a true value for 'y' and a false value
# for 'n'.
sub get_yes_no {
my ( $prompt ) = @ARG;
state $map_answer = {
n => 0,
y => 1,
};
my $resp = lc get_input(
"$prompt? [y/n]: ",
sub { m/ \A [yn] /smxi },
"Please respond 'y' or 'n'\n",
);
return $map_answer->{ substr $resp, 0, 1 };
}
__END__
# Display the rules if desired. There is no straightforward way to
# interpolate a manifest constant into a string, but @{[ ... ]} will
# interpolate any expression.
print <<"EOD" if get_yes_no( 'Do you want the rules' );
This is the game of 'Reverse'. To win, all you have
to do is arrange a list of numbers (1 through @{[ NUMBER_OF_NUMBERS ]})
in numerical order from left to right. To move, you
tell me how many numbers (counting from the left) to
reverse. For example, if the current list is:
2 3 4 5 1 6 7 8 9
and you reverse 4, the result will be:
5 4 3 2 1 6 7 8 9
Now if you reverse 5, you win!
1 2 3 4 5 6 7 8 9
No doubt you will like this game, but
if you want to quit, reverse 0 (zero).
EOD
while ( 1 ) { # Iterate until something interrupts us.
# Populate the list with the integers from 1, shuffled. If we
# accidentally generate a winning list, just redo the loop.
my @list = shuffle( 1 .. NUMBER_OF_NUMBERS );
redo if is_win( \@list );
print <<"EOD";
Here we go ... The list is:
EOD
my $moves = 0; # Move counter
while ( 1 ) { # Iterate until something interrupts us.
print <<"EOD";
@list
EOD
# Read the number of values to reverse. Zero is special-cased to
# take us out of this loop.
last unless my $max_index = get_input(
'How many shall I reverse (0 to quit)? ',
sub {
return m/ \A [0-9]+ \z /smx &&
$ARG <= NUMBER_OF_NUMBERS;
},
"Oops! Too many! I can reverse at most " .
NUMBER_OF_NUMBERS,
);
--$max_index; # Convert number to reverse to upper index
# Use a Perl array slice and the reverse() built-in to reverse
# the beginning of the list.
@list[ 0 .. $max_index ] = reverse @list[ 0 .. $max_index ];
$moves++; # Count a move
# If we have not won, iterate again.
next unless is_win( \@list );
# Announce the win, and drop out of the loop.
print <<"EOD";
You won it in $moves moves!!!
EOD
last;
}
# Drop out of this loop unless the player wants to play again.
say '';
last unless get_yes_no( 'Try again' );
}
print <<'EOD';
O.K. Hope you had fun!!
EOD
# Get input from the user. The arguments are:
# * The prompt
# * A reference to validation code. This code receives the response in
# $ARG and returns true for a valid response.
# * A warning to print if the response is not valid. This must end in a
# return.
# The first valid response is returned. An end-of-file terminates the
# script.
sub get_input {
my ( $prompt, $validate, $warning ) = @ARG;
# If no validator is passed, default to one that always returns
# true.
$validate ||= sub { 1 };
# Create the readline object. The 'state' causes the variable to be
# initialized only once, no matter how many times this subroutine is
# called. The do { ... } is a compound statement used because we
# need to tweak the created object before we store it.
state $term = do {
my $obj = Term::ReadLine->new( 'reverse' );
$obj->ornaments( 0 );
$obj;
};
while ( 1 ) { # Iterate indefinitely
# Read the input into the topic variable, localized to prevent
# Spooky Action at a Distance. We exit on undef, which signals
# end-of-file.
exit unless defined( local $ARG = $term->readline( $prompt ) );
# Return the input if it is valid.
return $ARG if $validate->();
# Issue the warning, and go around the merry-go-round again.
warn $warning;
}
}
# Get a yes-or-no answer. The argument is the prompt, which will have
# '? [y/n]: ' appended. The donkey work is done by get_input(), which is
# requested to validate the response as beginning with 'y' or 'n',
# case-insensitive. The return is a true value for 'y' and a false value
# for 'n'.
sub get_yes_no {
my ( $prompt ) = @ARG;
state $map_answer = {
n => 0,
y => 1,
};
my $resp = lc get_input(
"$prompt? [y/n]: ",
sub { m/ \A [yn] /smxi },
"Please respond 'y' or 'n'\n",
);
return $map_answer->{ substr $resp, 0, 1 };
}
# Determine if a given list represents a win. The argument is a
# reference to the array containing the list. We return a true value for
# a win, or a false value otherwise.
sub is_win {
my ( $list ) = @_;
my $expect = 1; # We expect the first element to be 1;
# Iterate over the array.
foreach my $element ( @{ $list } ) {
# If the element does not have the expected value, we return
# false. We post-increment the expected value en passant.
$element == $expect++
or return 0;
}
# All elements had the expected value, so we won. Return a true
# value.
return 1;
}
__END__
=head1 TITLE
reverse.pl - Play the game 'reverse' from Basic Computer Games
splat.pl - Play the game 'splat' from Basic Computer Games
=head1 SYNOPSIS
reverse.pl
splat.pl
=head1 DETAILS
This Perl script is a port of C<reverse>, which is the 73rd entry in
This Perl script is a port of C<splat>, which is the 73rd entry in
Basic Computer Games.
The cool thing about this port is the fact that, in a language with
array slices, list assignments, and a C<reverse()> built-in, the
reversal is a single assignment statement.
This is a very basic port. All I really did was untangle the spaghetti.
=head1 PORTED BY