From 49a342e2bf9c9b9627567b091b38ba0f0df93bd6 Mon Sep 17 00:00:00 2001 From: Tom Wyant Date: Sun, 2 Jan 2022 13:30:14 -0500 Subject: [PATCH] Perl port of 96_Word. --- 96_Word/perl/word.pl | 169 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 169 insertions(+) create mode 100755 96_Word/perl/word.pl diff --git a/96_Word/perl/word.pl b/96_Word/perl/word.pl new file mode 100755 index 00000000..5369cc71 --- /dev/null +++ b/96_Word/perl/word.pl @@ -0,0 +1,169 @@ +#!/usr/bin/env perl + +use 5.010; # To get 'state' and 'say' + +use strict; # Require explicit declaration of variables +use warnings; # Enable optional compiler warnings + +use English; # Use more friendly names for Perl's magic variables +use Term::ReadLine; # Prompt and return user input + +our $VERSION = '0.000_01'; + +print <<'EOD'; + WORD + Creative Computing Morristown, New Jersey + + + +I am thinking of a word -- you guess it. I will give you +clues to help you get it. Good luck!! + + +EOD + +# Read the content of __DATA__, remove the trailing newlines, and store +# each line into @words. Stop at __END__, since Perl does not see this +# as an end-of-file. +my @words; +while ( ) { + chomp; + last if $ARG eq '__END__'; + push @words, lc $ARG; # Normalize case to lower. +} + +# This loop represents an actual game. We execute it until the player +# does something that makes us explicitly break out. +while ( 1 ) { + print <<'EOD'; + + +You are starting a new game ... +EOD + + # Choose a random target word. The rand() function returns a number + # from 0 to its argument, and coerces its argument to a scalar. In + # scalar context, an array evaluates to the number of elements it + # contains. + my $target = $words[ rand @words ]; + + # We generalize the code by using the actual length of the target. + my $target_length = length $target; + + my $count = 0; # Number of guesses + + # Make an array of the individual letters in the target. We will + # iterate over this to determine matching letters. + my @target_array = split qr<>, $target; + + # Make a hash of those letters. We will use this to determine common + # letters. Any true value will do for the value of the hash. By + # making use of this hash we avoid the nested loops of the original + # BASIC program. + my %target_hash = map { $ARG => 1 } @target_array; + + # We keep prompting the player until we get a response that causes + # us to break out of the loop. + while ( 1 ) { + + # Create the readline object. The state keyword means the + # variable is only initialized once, no matter how many times + # execution passes this point. + state $term = Term::ReadLine->new( 'word' ); + + # Read the next guess. A return of undef means end-of-file. + my $guess = $term->readline( "Guess a $target_length letter word: " ); + exit unless defined $guess; + + last if $guess eq '?'; # A question mark means we give up + if ( length( $guess ) != $target_length ) { + # Wrong length. Ask again. + say "You must guess a $target_length letter word. Try again."; + redo; # Redo the innermost loop + } + + $guess = lc $guess; # Lower-case the guess + $count++; # Count another guess + + if ( $guess eq $target ) { + # We guessed the word. + say "You have guessed the word. It took $count guesses!"; + my $answer = $term->readline( 'Want to play again? [y/N]: '); + exit unless defined $guess; # End of file + exit unless $guess =~ m/ \A y /smxi; + last; # Exit the innermost loop. + } + + my @common_letters; # Letters common to guess and target + my $match = '-' x length $target; # Assume no matches + my $inx = 0; # Iterator + foreach my $letter ( split qr<>, $guess ) { + if ( $target_hash{$letter} ) { + # If the letter is in the hash, it occurs in the target + push @common_letters, $letter; + # If it is at the current position in the target, it is + # an actual match. + $target_array[$inx] eq $letter + and substr $match, $inx, 1, $letter; + } + $inx++; + } + + say 'There were ', scalar @common_letters, + ' matches and the common letters were... ', @common_letters; + say "From the exact letter matches, you know................ $match"; + say ''; + say q; + redo; + } + +} +__DATA__ +dinky +smoke +water +grass +train +might +first +candy +champ +would +clump +dopey +__END__ + +=head1 TITLE + +word.pl - Play the game 'word' from Basic Computer Games + +=head1 SYNOPSIS + + word.pl + +=head1 DETAILS + +This Perl script is a port of C, which is the 96th entry in Basic +Computer Games. + +=head1 PORTED BY + +Thomas R. Wyant, III F + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 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 Artistic +License 1.0 at +L, and/or the +Gnu GPL at L. + +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 expandtab tabstop=4 textwidth=72 :