Permalink
Browse files

[wip] clean up hangman a bit

This uses a few more advanced Perl 6 features, but that's fine since we
already have an introductory example
  • Loading branch information...
moritz committed Oct 30, 2009
1 parent cf217d1 commit 2c3ebdb26a977620fe60912c65fc4ab41cde2354
Showing with 27 additions and 35 deletions.
  1. +27 −35 wip/hangman.p6
View
@@ -9,44 +9,43 @@ use v6;
my $dictionary = shift(@*ARGS) // 'words';
my @words = read-dictionary($dictionary);
-my $alphabet = "abcdefghijklmnopqrstuvwxyz";
+my $alphabet = join '', 'a'..'z';
my @hangman = <head torso left_arm right_arm left_leg right_leg>;
loop {
- my $word = @words[rand * +@words];
+ my $word = @words.pick();
my @blanks = "_" xx chars($word);
- my (@hanging,%missed,%guessed);
+ my (@hanging,%missed,%guessed);
my $i = 0;
while @hanging != @hangman {
say " Word: " ~ join(" ", @blanks);
say "Letters missed: " ~ join(" ", sort keys %missed);
say " Hangman: " ~ join(" ", @hanging);
if join('',@blanks) eq $word { say "\t\tYou Win!"; last; }
- say "Enter a letter ...";
- my $guess = substr(lc(get($*IN)), 0, 1); # only take first char
- if not defined(index($alphabet,$guess)) {
- say "That's not a letter!";
- next;
+ my $guess = lc prompt('Enter a letter: ');
+ if not defined(index($alphabet,$guess)) {
+ say "That's not a letter!";
+ next;
}
- if %guessed{$guess} {
- say "You already guessed that letter!";
- next;
+ if %guessed{$guess} {
+ say "You already guessed that letter!";
+ next;
}
%guessed{$guess}++;
- if defined(index($word,$guess)) {
- say "yes";
- @blanks = fill-blanks(@blanks,$word,$guess);
+ if defined(index($word,$guess)) {
+ say "yes";
+ @blanks = fill-blanks(@blanks,$word,$guess);
}
- else {
+ else {
say "no";
- push(@hanging, @hangman[$i++]);
- %missed{$guess}++;
+ push(@hanging, @hangman[$i++]);
+ %missed{$guess}++;
}
}
say "\t\tYou lose!\nThe word was ''$word''" if @hanging == @hangman;
- say "Try again? (Y/n)";
- my $answer = get($*IN);
+
+ my $answer = prompt('Try again? (Y/n) ');
last if lc(substr($answer,0,1)) eq 'n';
}
say "Thanks for playing!";
@@ -55,26 +54,19 @@ exit;
sub read-dictionary ($dictionary) {
say "Reading dictionary...";
my $fh = open $dictionary, :r or die;
- my @words;
- for lines($fh) <-> $line {
- chomp($line); # remove newline
- $line = lc($line); # make all words lower case
- next unless chars($line) > 4; # only take words with more than 4 characters
- push(@words,$line);
+ my @words = gather for lines($fh) -> $line {
+ # take only words of at least 5 charaters
+ if chars($line) > 4 {
+ # ... and conver to lower case
+ take lc $line;
+ }
}
say "Done.";
return @words;
}
-sub fill-blanks(@blanks is copy,$word,$letter) {
- return unless $letter;
- @blanks = "_" xx chars($word) if !@blanks;
- my $next_pos = 0;
- loop {
- my $pos = index($word,$letter,$next_pos);
- last unless defined $pos;
- @blanks[$pos] = $letter;
- $next_pos = $pos+1;
+sub fill-blanks(@blanks, $word,$letter) {
+ gather for @blanks Z $word.split('') -> $b, $w {
+ take $w eq $letter ?? $w !! $b;
}
- return @blanks;
}

0 comments on commit 2c3ebdb

Please sign in to comment.