#!/usr/bin/perl

=begin metadata

Name: fish
Description: plays the children's game of Go Fish
Author: Clinton Pierce, clintp@geeksalad.org
License: perl

=end metadata

=cut


use strict;
use Getopt::Std;
$Getopt::Std::STANDARD_HELP_VERSION = 1;

my( @DECK, @PLAYERS_HAND, @COMPUTERS_HAND, @BOOKS, %BOOKS);
my(@HIS_PAST_GUESSES, @MY_PAST_GUESSES);
my($asker, $opponent, $professional, $whoseturn, $status, $myb, $yourb);
my %so=( 'A'=>1, 'J'=>11, 'Q'=>12, 'K'=>13 );  # For sort ranking, below.

sub pickone {		# Computer's card-picking routine.  Dumb or smart.
	my($myarr)=@_;

	my %h;
	map($h{$_}=1, @$myarr);

	return( (keys %h)[rand scalar keys %h] ) if (! $professional);

	# Reasonably "smart" picker.
	my(@saveguess,$guess)=();
	while(@HIS_PAST_GUESSES) {
		$guess=shift @HIS_PAST_GUESSES;   # use his past guesses as a guide
		next if (grep($guess eq $_, keys %{$BOOKS{'You'}}));
		next if (grep($guess eq $_, @MY_PAST_GUESSES));
		if ( ! grep($guess eq $_, @COMPUTERS_HAND)  ) {
			push(@saveguess, $guess);	# come back to it later.
			next;
		}
		push(@MY_PAST_GUESSES, $guess);
		return($guess);
	}
	@HIS_PAST_GUESSES=@saveguess;
	$guess=(keys %h)[rand scalar keys %h];  # degrade to blind guesses
	push(@MY_PAST_GUESSES, $guess);
	return($guess);

}
sub compguess {                # Return 0 if hit, nonzero (the card) if miss
	my($guess, $stat);

	do {
		print "\nI ask you for: ";
		$guess=pickone(\@COMPUTERS_HAND);
		print $guess, "\n";
	} while(! defined ($stat=askfor(\@COMPUTERS_HAND, \@PLAYERS_HAND, $guess)));

	havebook(\@COMPUTERS_HAND);
	return($stat?0:$guess);
}
sub playguess {
	my($guess, $stat);

	do {
		print "\nYou ask me for: ";
		$guess=<STDIN>;  chomp($guess);
	} while(! defined ($stat=askfor(\@PLAYERS_HAND, \@COMPUTERS_HAND, $guess)));

	# Professional mode....is watching you.
	push(@HIS_PAST_GUESSES, $guess);

	havebook(\@PLAYERS_HAND);
	return($stat?0:$guess);
}
sub draw {
	my($drawarr, $guess)=@_;
	my($foo);

	$foo=pop @DECK;
	die("No more cards: S.N.H.") if (!$foo);
	if ($foo eq $guess) {
		print "$asker drew the guess\n";
		print "$asker get to go again\n";
		push(@$drawarr, $foo);
	} else {
		print "$asker drew a $foo\n" if ($asker eq 'You');
		# Professional mode...is watching you
		@MY_PAST_GUESSES=();
		push(@$drawarr, $foo);
	}
	return($foo);
}

sub askfor {
	my($askarr, $vicarr, $card)=@_;   # The asker, the victim, and the card

	if ($card eq "") {
		print "I have ", scalar(@COMPUTERS_HAND), " cards in my hand ";
		printhand(\@COMPUTERS_HAND, 'I', 1);
		print "There are ", scalar(@DECK), " cards remaining in the stock\n";
		return;
	}
	exit if ($card eq 'quit');
	if ($card eq 'p') {
		$professional=!$professional;
		print $professional?"Entering":"Leaving", " professional mode\n";
		return;
	}
	if (! grep($card eq $_, (keys %so, 2..10) )) {
		print "I don't understand!\n";
		return;
	}
	if (! grep($card eq $_, @$askarr)) {
		print "$asker dont have any $card" . "s!\n";
		return;
	}

	if (! grep($card eq $_, @$vicarr)) {
		print "$opponent say \"GO FISH!\"\n";
		return 0;
	}

	my @GOOD=grep($card eq $_, @$vicarr);
	@$vicarr=(grep($card ne $_, @$vicarr));

	print "$opponent have ", scalar(@GOOD), " $card", (scalar(@GOOD)>1)?"s":"", "\n";
	print "$asker get another guess!\n";
	push(@$askarr, @GOOD);
}

sub havebook {
	my $array=shift;

	my(%hash,$flag);  $flag=0;
	foreach(@$array){ $hash{$_}++;}
	foreach my $value (keys %hash) {
		if ($hash{$value}==4) {
			@$array=grep( ($_ ne $value),@$array);
			print "$asker made a book of ", $value, "s\n";
			$BOOKS{$asker}{$value}=1;
			$flag=1;
		}
	}
	return($flag);
}

sub fisher_yates_shuffle { # From The Perl Cookbook, recipe 4.17
	my $array=shift;
	my $i;
	for($i=@$array; --$i;) {
		my $j=int rand ($i+1);
		next if $i==$j;
		@$array[$i,$j]=@$array[$j,$i];
	}
}

sub printhand {
	unless ($_[2]) {
		print "$_[1] hand is: " , join(' ', sort
			{ (($a=~/^\d+$/)?$a:$so{$a}) <=> (($b=~/^\d+$/)?$b:$so{$b}); }
			@{$_[0]});
	}
	my @bl=keys %{$BOOKS{$_[1]}};
	if (@bl) {
		print " + Book", scalar(@bl)>1?"s ":" ", join(' ', @bl);
	}
	print "\n";
}

#
# MAIN
#

$main::opt_p=0;       # Is this necessary for strict?
getopts('p') || die <<USAGE;
Usage: $0 [-p]
USAGE
$professional=$main::opt_p;

print "Do you want to see instructions (y/n)?";
$status=<STDIN>;
if ($status=~/^y/i) {
	print <DATA>;
	print "Press <return>"; $status=<STDIN>;
}

@DECK=split(//, 'A'x4 . 'K'x4 . 'Q'x4 . 'J'x4);
foreach(1..4) {foreach(2..10) { push(@DECK, $_) } }
fisher_yates_shuffle(\@DECK);

foreach(1..7) {
	push(@PLAYERS_HAND, pop @DECK);
	push(@COMPUTERS_HAND, pop @DECK);
}

$whoseturn=int(rand(2));  # True for player
print $whoseturn?"You":"I", " get to start\n";

while(1) {
	print "\n";
	last if ( (!@PLAYERS_HAND) or (!@COMPUTERS_HAND) );

	printhand(\@PLAYERS_HAND,"You");
	$asker=$whoseturn?"You":"I";
	$opponent=(!$whoseturn)?"You":"I";
	if ($whoseturn) {
		$status=playguess();
		if ($status) {
			if (&draw(\@PLAYERS_HAND, $status) eq $status) {
				havebook(\@PLAYERS_HAND);
				redo;
			} else {
				redo if (havebook(\@PLAYERS_HAND));
				$whoseturn=!$whoseturn;
			}
		}
		redo;
	} else {
		$status=compguess();
		if ($status) {
			if (&draw(\@COMPUTERS_HAND, $status) eq $status) {
				havebook(\@COMPUTERS_HAND);
				redo;
			} else {
				redo if (havebook(\@COMPUTERS_HAND));
				$whoseturn=!$whoseturn;
			}
		}
		redo;
	}
}

print @COMPUTERS_HAND?"You":"I", " ran out of cards\n";
$myb=scalar(keys %{$BOOKS{'I'}});
$yourb=scalar(keys %{$BOOKS{'You'}});
print "I had $myb Books and you had $yourb\n";
if ($myb==$yourb) {
	print "It's a tie!\n";
} else {
	print $myb>$yourb?"I":"You", " win!\n";
}

=pod

=head1 NAME

fish - plays the children's game of Go Fish

=head1 SYNOPSIS

fish [-p]

=head1 DESCRIPTION

I<fish> plays the children's game of Go Fish.  The computer plays against
the player.  The object of the game is to collect more "books" of cards
than your opponent by querying each other's hand.

This version implements the child-friendly rules outlined
in I<Hoyle's Rules of Games>.

=head2 OPTIONS

I<fish> accepts the following option:

=over 4

=item -p

Puts I<fish> into "professional mode".

=back

=head1 BUGS

Strategy employed by I<fish>'s "professional mode" could be
somewhat smarter.

User interaction resembles BSD's implementation which is rather...spartan.

=head1 AUTHOR

The Perl implementation of I<fish> was written by Clinton Pierce, I<clintp@geeksalad.org>.

=head1 COPYRIGHT and LICENSE

This program is Copyright 1999, by Clinton Pierce.

Freely redistributable under the Perl Artistic License.

=cut

__DATA__
This is the traditional children's card game "Go Fish".  We each get seven
cards, and the rest of the deck is kept to be drawn from later.  The
object of the game is to collect "books", or all of the cards of a single
value.  For example, getting four 2's would give you a "book of 2's".

We take turns asking each other for cards, but you can't ask me for a card
value if you don't have one of them in your hand!  If I have any cards of
the value you ask for, I have to give them to you.  As long as I have one
of the cards you ask for, you get to keep asking.  If you ask me for a
card of which I don't have any, then I'll tell you to "Go Fish!"  This
means that you draw a card from the deck.  If you draw the card you asked
me for, you get to keep asking me for cards.  If not, it's my turn and I ask
you for a card.

Sometimes you get to ask first, sometimes I do.  I'll tell you when it's
your turn to move, I'll draw cards from the deck for you, and I'll tell
you what you have in your hand.  (Don't worry, I don't look at your hand
when I'm trying to decide what card to ask for, honest!)

Your input can be a card name ("A", "2", "3", "4", "5", "6", "7", "8",
"9", "10", "J", "Q" or "K") or the letter "p", or "quit".  The letter "p"
makes my game much smarter, and the line "quit" stops the game.  Just
hitting the carriage return key displays how many cards I have in my hand,
how many are left in the deck, and which books I've gotten.

Normally, the game stops when one of us runs out of cards, and the winner
is whoever has the most books!

Good luck!