#!/usr/bin/perl

#
# Released under LGPL or Artistic License
#
# Console based HangMan Game
# http://www.perl.com/pub/a/2004/05/28/testing.html
#

use strict;
use diagnostics;
use Data::Dumper;

use vars qw/
  $LIFE

  $DEBUG
  $VERBOSE

  $HAS_TERM_READ_KEY
  $HAS_MATH_RANDOM

  %h_letters
  $life
/;

sub BEGIN
{
  #
  # Setup constants
  #
  $DEBUG   = undef;
  $VERBOSE = undef;
  $LIFE    = 5;

  #
  # Term::ReadKey
  # http://www.perldoc.com/perl5.6/lib/Term/ReadKey.html
  #
  eval
  {
    require Term::ReadKey;
  };

  if ( $@ )
  {
    print "Using <STDIN> with return \n"    if ( $DEBUG );
    $HAS_TERM_READ_KEY = 0;
  }
  else
  {
    # Reset tty mode before exiting
    print "Using Term::ReadKey \n"          if ( $DEBUG );

    # Turn off controls keys
    # Raw mode selected
    Term::ReadKey::ReadMode( 0 );
    $HAS_TERM_READ_KEY = 1;
  }

  #
  # Math::Random
  # http://search.cpan.org/~grommel/Math-Random-0.67/Random.pm
  #
  eval
  {
    require Math::Random;
  };

  if ( $@ )
  {
    print "Using normal random function\n"  if ( $DEBUG );
  }
  else
  {
    print "Using Math::Random\n"            if ( $DEBUG );
  }
}

sub initRandom()
{
  # Programming Perl, page 223
  # Mangle time with PID for more randomness
  # especially for CGI scripts
  my $seed = (time()) ^ ( $$ + ($$<<15));

  # Doesn't work that great
  srand( $seed ) if ( $$ > 0 );
}

sub error($$)
{
  my ( $error_code, $error_msg ) = @_;

  print "\n";
  print "Syntax: perl $0 dict.txt (life)\n\n";
  print "Error:  ". $error_msg;
  print "\n";

  exit( $error_code );
}

sub getRange($)
{
  my $max = $_[0];

  if ( $HAS_MATH_RANDOM )
  {
    return Math::Random::random_uniform( 1, 0, $max );
  }
  else
  {
    return ( rand $max );
  }
}

sub pickWord($)
{
  my $file_path = $_[0];

  # Programming Perl, page 85
  my $file_size = (  -s $file_path );
  my $range = getRange( $file_size );
  my $word;

  open( FH, "< $file_path\0" );
  seek( FH, $range, 0 );
  my $first_word  = <FH> || "";
  my $second_word = <FH> || "";

  chomp $first_word   if ( $first_word  );
  chomp $second_word  if ( $second_word );

  print "\n[".$first_word."][".$second_word."]\n"  if ( $DEBUG );

  # The file is too small or we are at the end of the file
  # Reset the location to the first words...
  if ( $range == 0 )
  {
    $word = $first_word;
  }
  elsif (!$second_word || $second_word !~ /\w+/ )
  {
    seek( FH, 0, 0 );
    $first_word  = <FH>;

    if ( $first_word  )
    {
      chomp $first_word;
      $word = $first_word;
    }
    else
    {
      close( FH );
      error( 4, "The dictionnary is empty.\n" );
    }
  }
  else
  {
    $word = $second_word;
  }

  close( FH );
  return $word;
}

sub checkFile($)
{
  my $file_path = $_[0];
  error( 1, "Please provide a dictionary file name.\n" ) if (    ! 
$file_path );
  error( 2, "The dictionnary file does not exist.\n"   ) if ( ! -e 
$file_path );
  error( 3, "The dictionnary path is not a file.\n"    ) if ( ! -f 
$file_path );
  error( 4, "The dictionnary is empty.\n"              ) if (   -z 
$file_path );
  error( 5, "The dictionnary is not a text file.\n"    ) if ( ! -T 
$file_path );
}

sub main($$)
{
  my $file_path = $_[0];
          $life = $_[1];

  initRandom();
  checkFile( $file_path );

  my $word = pickWord( $file_path );
  print "Answer: [$word]\n"   if ( $DEBUG );

  #
  # Initialized letters with value _
  #
  my $value     = ",_,";
  my $letters   = join( $value, ( 'a' .. 'z', '-' ) ). $value;
     %h_letters = split /,/, $letters;
     $life      = $LIFE  if ( !$life );

  playHangMan($word);
  exit;
}

sub playHangMan($)
{
  my $key     = undef;
  my $done    = 0;
  my $letters = "";
  my $word    = $_[0];

  while( !$done )
  {
    hangman( $word, $letters );

    if ( $HAS_TERM_READ_KEY )
    {
      while(  !defined( $key = Term::ReadKey::ReadKey(-1) )  )
      {
        # No key yet
      }
    }
    else
    {
      $key = <STDIN>;
    }

    $done = 1 if ($key eq '0'     );  # 0
    $done = 1 if ($key eq chr(3)  );  # CTRL-C
    $done = 1 if ($key eq chr(26) );  # CTRL-Z

    $key = substr($key, 0, 1);
    $key = lc $key;

    my $okey = ord($key);

    if (( $okey >= ord('a') && $okey <= ord('z') ) || ( $key eq '-' ) )
    {
      $letters .= $key;

      if ( $word =~ m/$key/ )
      {
        $h_letters{ $key } = $key;
      }
      else
      {
        $life--;
      }
    }
    elsif(!$done)
    {
      print "Press a valid key... CTRL-C, CTRL-Z or 0 to exit.\n" if ( 
$VERBOSE );
      #print "\n[$key]". ord($key);
    }
  }
}

sub hangman($$)
{
  my ( $word, $letters ) = @_;

  my $answer = $word;

  for my $letter ( keys ( %h_letters ))
  {
    my $value = $h_letters{ $letter };
    $word    =~ s/$letter/$value/g;
  }

  print "LIFE $life:\t "        if ( $VERBOSE );
  print "$word";
  print "\t LETTERS: $letters"  if ( $VERBOSE );
  print "\n";

  if ( $word !~ m/_/ )
  {
    print "\nLIFE!";
    exit( 0 );
  }
  elsif( $life <= 0 )
  {
    print "\nAnswer: $answer\n" if ( $VERBOSE );
    print "\nDEATH!";
    exit( 6 );
  }
}

#################################################
# perl hangman.pl dict.txt life=5
#################################################

main( $ARGV[0], $ARGV[1] );
exit;

#################################################

sub END
{
  if ( $HAS_TERM_READ_KEY )
  {
    # Reset tty mode before exiting
    Term::ReadKey::ReadMode( 0 );
  }
}

1;
__END__