[SPOILER] (Not a) solution to QOTW #17

Hi,

run the following as perl Hangman.pm or
perl Hangman.pm [m|f [ n ] ]

(i.e. perl Hangman.pm m 6, perl Hangman.pm f, etc).

where the 'm' or 'f' is for male or female (yes,
we have Hangwoman!  Possibly the first ever 
implementation!), and "n" is for the number of
allowed guesses.

no "n" defaults to the constant in the package,
"n" of 6 or 8 are good choices.

Send me subclasses for Hangdog and Hangcat!  Go
nuts! :).

mike

package Hangman::Victim ;
use constant MAX_GUESSES => 10;

use constant CANVAS => [
'   ____',
'  |    |',
'  |     ',
'  |       ',
'  |       ',
'__|__',
];

#'   ____',
#'  |    |',
#'  |    O',
#'  |  >-|-<',
#'  |  _/ \_',
#'__|__',

use constant BODY_PARTS =>
[
    ['O'=>[2,-1]],
    ['|'=>[3,-3]],
    ['/'=>[4,-4]],
    ['\\'=>[4,-2]],
    ['-'=>[3,-4]],
    ['-'=>[3,-2]],
    ['>'=>[3,-5]],
    ['<'=>[3,-1]],
    ['_'=>[4,-5]],
    ['_'=>[4,-1]],
];
    
sub new {
    my $class = shift;
    $class = ref($class) if ref $class;
    my %args = @_;
    my $this = {
        bad_guesses=>0,
        max_guesses=>$args{max_guesses} || $class->MAX_GUESSES,
    };
    return bless $this, $class;
}

sub bad_guess {
    my $this = shift;
    $this->{bad_guesses}++;
}
sub draw {
    my $this = shift;
    my @rows = @{$this->CANVAS};
    my @body_parts = @{$this->BODY_PARTS};
    for (1 .. $this->{bad_guesses}) {
        my $partnum = $_ - 1 ;
        my ($body_part,$loc) = @{$body_parts[$partnum]};
        my ($row,$index) = @$loc;
        substr( $rows[$row],$index, length($body_part) ) = $body_part;
    }
    return join ("\n", @rows) . "\n";
}

sub AUTOLOAD {
    our $AUTOLOAD;
    my $this =shift;
    return if $AUTOLOAD =~ /DESTROY$/;
    (my $method = $AUTOLOAD ) =~ s/.*:://;
    return $this->{$method};
}


package Hangwoman::Victim ;
use base qw(Hangman::Victim) ;
use constant CANVAS => [
'   ____',
'  |    |',
'  |      ',
'  |        ',
'  |       ',
'__|__',
];
#'   ____',
#'  |    |',
#'  |    {\',
#'  |  >-oo-<',
#'  |   _/\_',
#'__|__',
use constant BODY_PARTS =>
[
    ['{\\'=>[2,-2]],
    ['oo'=>[3,-4]],
    ['/'=>[4,-3]],
    ['\\'=>[4,-2]],
    ['-'=>[3,-5]],
    ['-'=>[3,-2]],
    ['>'=>[3,-6]],
    ['<'=>[3,-1]],
    ['_'=>[4,-4]],
    ['_'=>[4,-1]],
];



package main;

my $sex = shift @ARGV;
my $max_guesses = shift @ARGV;

my $package = 'Hangman::Victim';
if ($sex =~ /^[wf]/i) {
    $package = 'Hangwoman::Victim';
}

my %args = ();
if ($max_guesses ) {
    $args{max_guesses} = $max_guesses;
}

my $victim = $package->new(%args);

foreach (1 .. $victim->max_guesses) {
    $victim->bad_guess;
    print $victim->draw;
    print "\n\n";
}