# 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";
}