Go Fish/Raku: Difference between revisions
< Go Fish
Content deleted Content added
m Categorization now in master page |
m remove unneeded parens and 'do' |
||
Line 37:
sub readpip (@user_hand) {
my @choices = grep { @user_hand[$^p] }, ^@pips;
if
say "You're obliged to ask for { @ppips[@choices[0]] }.";
return @choices[0];
Line 126:
@.h[$pip] = 0;
while none @.h and $.deck.elems {
say
?? "The dealer's hand is empty, so $foe_nominative_pronoun draws a new card."
!! "Your hand's empty, so you draw a new card.";
|
Revision as of 07:11, 17 September 2010
Go Fish/Raku is part of Go Fish. You may find other members of Go Fish at Category:Go Fish.
<lang perl6>constant BOOKSIZE = 4; constant HANDSIZE = 9; constant Str @pips = <two three four five six seven eight nine ten jack queen king ace>;
# The elements of @pips are only names. Pips are represented internally # as indices of this array.
constant Str @piparticles = <a a a a a a an a a a a a an>; constant Str @ppips = <deuces threes fours fives sixes sevens eights nines tens jacks queens kings aces>; constant Str @shortpips = <2 3 4 5 6 7 8 9 T J Q K A>; constant $foe_nominative_pronoun = pick 1, <he she it e xe>;
sub count ($x, *@a) {
my $n = 0; $_ eqv $x and ++$n for @a; return $n;
}
sub find ($x, *@a) {
for @a.kv -> $k, $v { $v eqv $x and return $k; } fail 'Not found';
}
sub maxes (&f, *@a) {
my $x = [max] map &f, @a; return grep { f($^e) eqv $x }, @a;
}
sub ncard ($n, $pip) {
$n > 1 ?? "$n {@ppips[$pip]}" !! "{@piparticles[$pip]} {@pips[$pip]}"
}
sub readpip (@user_hand) {
my @choices = grep { @user_hand[$^p] }, ^@pips; if @choices == 1 { say "You're obliged to ask for { @ppips[@choices[0]] }."; return @choices[0]; } loop { print 'For what do you ask? (', join(', ', @shortpips[@choices]), '): '; my $in = substr uc($*IN.get or next), 0, 1; my $pip = find $in, @shortpips; if defined $pip { @user_hand[$pip] and return $pip; say "You don't have any { @ppips[$pip] }."; } else { say 'No such rank.'; } }
}
enum Maybe <No Yes Dunno>;
class Knowledge {
- The computer player has an instance of this class for each pip.
- Each instance tracks whether the computer thinks the user has at
- least one card of the corresponding pip.
has Maybe $.maybe = Dunno; # Yes if the user definitely has this pip, No if they didn't # have it the last time we checked, Dunno if we haven't yet # checked. has Int $.n = 0; # If $.maybe is No, $.n counts how many cards the user # has drawn since we last checked.
method set (Maybe $!maybe) { $!n = 0 }
method incr { $.maybe == No and ++$!n }
}
class Player {
has Int @.h; # @h[$n] is number of cards of pip $n in this player's hand. has $.deck; # A reference to whatever deck the player's playing with. has Int $.books = 0; has Bool $.cpu; has Knowledge @.know;
method new ($cpu, @deck is rw) { my Int @h = 0 xx @pips; ++@h[$_] for @deck[^HANDSIZE]; @deck = @deck[HANDSIZE ..^ @deck]; Player.bless(*, h => @h, cpu => $cpu, deck => \@deck, know => ($cpu ?? map { Knowledge.new() }, @pips !! ()) ); }
method showhand { say ($.cpu ?? 'The dealer has ' !! 'You have '), join(' ', map { join ' ', @shortpips[.key] xx .value }, grep { .value }, pairs @.h), '.'; }
method draw () { my $new = shift $.deck; $.cpu or print "You got { ncard 1, $new }. "; say "({ $.deck.elems or 'No' } card{ $.deck.elems == 1 ?? !! 's' } left.)"; self.getcards(1, $new); }
method getcards (Int $quantity, Int $pip) { @!h[$pip] += $quantity; @.h[$pip] == BOOKSIZE or return; ++$!books; say ($.cpu ?? "The dealer puts down a book of { @ppips[$pip] }" !! "That's a book"), " (for a total of $.books book{ $.books == 1 ?? !! 's' })."; self.losecards($pip); }
method losecards (Int $pip) { @.h[$pip] = 0; while none @.h and $.deck.elems { say $.cpu ?? "The dealer's hand is empty, so $foe_nominative_pronoun draws a new card." !! "Your hand's empty, so you draw a new card."; self.draw; } }
method learn (Int $pip, Maybe $m) { @.know[$pip].set($m) }
method notice_draw () { .incr for @.know }
method choose_request () returns Int { #self.showhand; #say 'Know: ', join ', ', map # { .maybe ~~ Yes ?? 'Yes' !! .maybe ~~ Dunno ?? 'Dunno' !! .n }, # @.know; my @ps = map { .key }, grep { .value }, pairs @.h; return pick 1, maxes { @.h[$^p] }, do # Most of all we should ask for cards we know the # user has. grep { @.know[$^p].maybe ~~ Yes }, @ps or # Then try asking for one we haven't requested # before. grep { @.know[$^p].maybe ~~ Dunno }, @ps or # Then try asking for one we least recently # asked about. maxes { @.know[$^p].n }, @ps; }
}
sub play () {
my Int @deck; # Shuffle the deck until the first two hands contain no books. # (If BOOKSIZE is greater than 2 and HANDSIZE is reasonably # small, this'll probably take only one shuffle.) repeat { @deck = pick *, ^@pips xx BOOKSIZE } until none(map { count $^x, @deck[^HANDSIZE] }, ^@pips) >= BOOKSIZE and none(map { count $^x, @deck[HANDSIZE ..^ 2*HANDSIZE] }, ^@pips) >= BOOKSIZE;
my Player $user .= new(False, @deck); my Player $foe .= new(True, @deck); while any |$user.h or any |$foe.h { # The user goes first. while any |$user.h { say ; $user.showhand; my $request = readpip $user.h; $foe.learn($request, Yes); if $foe.h[$request] -> $quantity is copy { say 'The dealer reluctantly hands over ', ncard($quantity, $request), '.'; $foe.losecards($request); $user.getcards($quantity, $request); } else { say '"Go fish!"'; $user.draw; $foe.notice_draw; last; } }
while any |$foe.h { my $request = $foe.choose_request; say "\n\"Got any ", @ppips[$request], '?"'; $foe.learn($request, No); if $user.h[$request] -> $quantity is copy { say '"Thanks!"'; $foe.getcards($quantity, $request); $user.losecards($request); } else { say 'The dealer goes fishing.'; $foe.draw; last; } }
}
say "\nGame over!"; say 'Your books: ', $user.books; say "The dealer's books: ", $foe.books; say do $user.books > $foe.books ?? 'A winner is you!' !! $user.books < $foe.books ?? 'Alas, you have lost.' # A draw is possible if @pips !% 2. !! "It's a draw.";
}
sub MAIN () { play }</lang>