Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

Ovid (2709)

Ovid
  (email not shown publicly)
http://publius-ovidius.livejournal.com/
AOL IM: ovidperl (Add Buddy, Send Message)

Stuff with the Perl Foundation. A couple of patches in the Perl core. A few CPAN modules. That about sums it up.

Journal of Ovid (2709)

Wednesday December 31, 2008
11:13 AM

Hangman in Perl 6

[ #38191 ]

Create a file named 'wordlist' and list only one word: mississipi. Then you can play hangman in Perl 6.

use v6;

class Hangman {
    has $.wordlist;

    has $!word           is rw;
    has $!finished       is rw;
    has @!man            is rw;
    has @!bodyparts      is rw;
    has $!num_misses     is rw = 0;
    has @!guess          is rw;
    has %!missed_letters is rw;
    has $!state          is rw;

    subset Letter of Str where { $_ =~ /^ <[a..z]> $/ };

    method init() {
        my @words = =open($.wordlist);
        my $attempts = 0;

        repeat until self!valid_word or $attempts > 100 {
            $attempts++;
            $!word = @words.pick;
        }

        if $attempts > 100 {
            die "Quit trying to find valid word in ($.wordlist) after 100 tries";
        }
        @!man = (
            [ < + - - - - - + >   ],
            [ '|', ' ' xx 5, '|'  ],
            [ '|', ' ' xx 5, '|'  ],
            [ '|', ' ' xx 5, '|'  ],
            [ < + - - - - - + >   ],
        );
        @!bodyparts = (
            [ 2, 3, '|' ],    # torso
            self!shuffle(
                [ 2, 2, '-'  ],     # left arm
                [ 2, 4, '-'  ],     # right arm
                [ 3, 2, '/'  ],     # left leg
                [ 3, 4, '\\' ],     # right leg '
            ),
            [ 1, 3, 'o' ],
        );
        @!guess = '_' xx $!word.chars;
        $!state = join("\n", self!render_man, self!render_guess) ~ "\n";
    }

    # Letter $letter is broken
    method guess_letter ($letter) {
        say "You guessed '$letter'";

        if %!missed_letters.exists($letter) {
            warn "You've already guessed '$letter'\n";
            return;
        }
        if $!finished {
            warn $!state;
            return;
        }

        my @found;
        my @letters = $!word.split('');
        my $ord = $letter.ord;
        for 0..(@letters.elems - 1) -> $i {
            if @letters[$i].ord == $ord {
                @found.push($i);
            }
        }
        #if not $!word ~~ /$letter/ {
        if not @found.elems {
            %!missed_letters{$letter} = 1;
            self!handle_bad_guess;
            return;
        }
        else {
            self!handle_good_guess($letter, @found);
            return 1;
        }
    }

    my method handle_bad_guess {
        my $part = @!bodyparts.shift;
        @!man[ $part[0] ][ $part[1] ] = $part[2];

        if not @!bodyparts.elems {
            $!state = "You've been hanged!  The word was '$!word'\n"
                ~ self!build_state;
            $!finished = 1;
        }
        else {
            $!state = "Wrong!\n" ~ self!build_state;
        }
    }

    my method build_state {
        return sprintf "%s\n%s\nMissed: %s\n",
            self!render_man,
            self!render_guess,
            join( ' ', %!missed_letters.keys.sort );
    }

    my method handle_good_guess ($letter, @found) {

        @!guess[@found] = $letter xx @found.elems;

        if not grep { $_ eq '_' }, @!guess {
            $!state = "You won!  The word was '$!word'\n"
                ~ self!build_state;
            $!finished = 1;
        }
        else {
            $!state = "Right!\n" ~ self!build_state;
        }
    }

    my method render_guess () {
        return @!guess.join(' ');
    }

    my method render_man () {
        my $man;
        for @!man -> $array {
            $man ~= $array.join('') ~ "\n";
        }
        return $man;
    }

    # XXX File bug report on slurpy copy
    #my method shuffle (*@items is copy) {
    my method shuffle (*@items) {
        # Fisher-Yates shuffle
        my $i = @items.elems;
        while ($i) {
            my $j = $i.rand.int;
            $i--;
            @items[ $i, $j ] = @items[ $j, $i ];
        }
        return @items;
    }

    my method valid_word () {
        return $!word ~~ /^ <[a..z]> ** 6..* $/;
    }

    method get_word () {
        return $!word;
    }

    method is_hung () {
        return not @!bodyparts.elems;
    }

    method to_string () {
        return $!state;
    }
}

my $man = Hangman.new( wordlist => './wordlist' );
$man.init();

for <m a b c d e i s p> -> $letter {
    $man.guess_letter($letter);
    say $man.to_string;
}

Output:

You guessed 'm'
Right!
+-----+
|     |
|     |
|     |
+-----+

m _ _ _ _ _ _ _ _ _
Missed:

You guessed 'a'
Wrong!
+-----+
|     |
|  |  |
|     |
+-----+

m _ _ _ _ _ _ _ _ _
Missed: a

You guessed 'b'
Wrong!
+-----+
|     |
| -|  |
|     |
+-----+

m _ _ _ _ _ _ _ _ _
Missed: a b

You guessed 'c'
Wrong!
+-----+
|     |
| -|- |
|     |
+-----+

m _ _ _ _ _ _ _ _ _
Missed: a b c

You guessed 'd'
Wrong!
+-----+
|     |
| -|- |
|   \ |
+-----+

m _ _ _ _ _ _ _ _ _
Missed: a b c d

You guessed 'e'
Wrong!
+-----+
|     |
| -|- |
| / \ |
+-----+

m _ _ _ _ _ _ _ _ _
Missed: a b c d e

You guessed 'i'
Right!
+-----+
|     |
| -|- |
| / \ |
+-----+

m i _ _ i _ _ i _ i
Missed: a b c d e

You guessed 's'
Right!
+-----+
|     |
| -|- |
| / \ |
+-----+

m i s s i s s i _ i
Missed: a b c d e

You guessed 'p'
You won!  The word was 'mississipi'
+-----+
|     |
| -|- |
| / \ |
+-----+

m i s s i s s i p i
Missed: a b c d e

Code suggestions welcome! Many of the strange things you see are due to limitations in either the current revision of Rakudo (r34706) or in my knowledge.

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • Great work. Here is the same code in different formats generated using Syntax::Highlight::Perl6 [cpan.org].

    HTML with tree viewer (needs JavaScript) [perl6.nl]

    Snippet HTML (No JavaScript) [perl6.nl]

    Note: i modified line 15 to be STD-parsable.

  • Nice script.

    You've liberated yourself from the parens in if statements and loops. Good work.

    Now liberate yourself from the parens around the rvalue in array assignments. my @a = 1,2,3; FTW.

  • Take this f.ex.:

    my @found;
    my @letters = $!word.split('');
    my $ord = $letter.ord;
    for 0..(@letters.elems - 1) -> $i {
        if @letters[$i].ord == $ord {
            @found.push($i);
        }
    }

    In Perl 6 you write this like so:

    my $ord = $letter.ord;
    my @found = map { .key }, grep { .value.ord == $ord }, $!word.split('').pairs;

    Although I don’t know why you don’t simply say this:

    my $l = $letter.substr(0,1);

    The resulting simplification should be obvious. Maybe yo

  • It's "Mississippi".

    Or as my momma taught me: "Eme eye crooked letter crooked letter eye crooked letter crooked letter eye humpback humpback eye".

  • I didn’t do so immediately because of the large amount of code, which seemed somewhat shocking for something like Hangman. Now that I have read it… who are you and what have you done with Ovid?

    Seriously – I am now even more shocked to see you of all people produce a God object. The way you’ve designed the class, it’s impossible to test or use any of the functionality in isolation. So I wonder why you used a class at all?

    • I wasn't too worried about producing particularly good or reusable code here, I just wanted to see what I could do with Rakudo. Oddly, I also thought that it would be a much smaller bit of code. Your turn to write hangman ... :)