Skip to content
This repository
tree: 5965554329
Fetching contributors…

Cannot retrieve contributors at this time

executable file 72 lines (63 sloc) 2.017 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
#!/usr/bin/perl6

# Simple hangman game to illustrate Perl 6.
# Very procedural. No OOP. Uses scalars, arrays, and hashes

# TODO: needs cleaning

use v6;

my $dictionary = shift(@*ARGS) // 'words';
my @words = read-dictionary($dictionary);
my $alphabet = join '', 'a'..'z';
my @hangman = <head torso left_arm right_arm left_leg right_leg>;

loop {
    my $word = @words.pick();
    my @blanks = "_" xx chars($word);

    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; }
        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;
        }
        %guessed{$guess}++;
        if defined(index($word,$guess)) {
            say "yes";
            @blanks = fill-blanks(@blanks,$word,$guess);
        }
        else {
            say "no";
            push(@hanging, @hangman[$i++]);
            %missed{$guess}++;
        }
    }
    say "\t\tYou lose!\nThe word was ''$word''" if @hanging == @hangman;

    my $answer = prompt('Try again? (Y/n) ');
    last if lc(substr($answer,0,1)) eq 'n';
}
say "Thanks for playing!";
exit;

sub read-dictionary ($dictionary) {
    say "Reading dictionary...";
    my $fh = open $dictionary, :r or die;
    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, $word, $letter) {
    gather for @blanks Z $word.split('') -> $b, $w {
        take $w eq $letter ?? $w !! $b;
    }
}
Something went wrong with that request. Please try again.