#!/usr/bin/perl
# You may need to change the above line to  #!/usr/local/bin/perl
# Do not edit this file in Windows!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
# this file MUST be saved in a UNIX file format!!!!!!!!!!!!!!!!
###############################################################
# Hangman 1.3.4
# By J.R. Greer  jrg@albedo.net
# (c) 1997,1998,1999,2000,2001
# ftp://trillian.bbs42.com/pub/games/hamgman/
# http://www.albedo.net/pub/cgi-games.html
# 
# game based on code by  Nik Swoboda  nswoboda@cs.indiana.edu
# http://blackcat.brynmawr.edu/~nswoboda/prog-html.html
#
# cgi_receive routine loosely based on code developed at the 
# National Center for Supercomputing Applications (NCSA) at 
# the University of Illinois at Urbana-Champaign.
# 
# (c) 1997,1998 all rights reserved
#
# The program is placed under the GNU Public License (GPL)
# You may copy freely or modify the code in anyway as long
# as the above information stays intact. 
#
#################################################################
# Configuration

# The Directory where the .gif files are  ie: /game/hangman/image/
$GIF_DIR = "/game/image/";

# The cgi-bin dir and the name of the cgi ie: /cgi-bin/hangman.pl
$CGI_BIN = "/cgi-bin/hangman.1.3.4.pl";

# the URL to go back to leave the game  ie: http://www.albedo.net/
$HOMEP = "http://www.albedo.net/pub/cgi-games.html";

# The location of the word file (FULL HARD DRIVE PATH!   NOT HTML URL!!!!!!!)
$DATAFILE = "/usr/local/etc/httpd/cgi-bin/data/hangman.words";

# This line is to filter 0x0D from the word file to prevent poblems
# with word files done in Notepad or Word
$DATAFILE =~ s/\r//g;

# If the Clue stays on the screen
$CLUE=1;

$bgcolour="white";
$textcolour="#000010";
$linkcolour="blue";
$vlinkcolour="#FF00FF";
$alinkcolour="#FFFF00";

# use background
$BG=0;
$BGGIF="/game/image/bg.gif";
#####################################################################
# The following options require write permission for the html server
# You must use FULL PATH NAMES,
# Write anticheat file
# this writes the IP and guess number of the user to prevent cheating
$wac=1;
$wacfile="/httpd/htdocs/game/hangwac";
$ctlfile="/httpd/htdocs/game/hangctl";
#
# Turn on scoreing
$score=1;
#
# top ten players list;  (not working)
$ttpl="/httpd/htdocs/game/ttpl.html";
###################################################################
###################################################################
#  Do not edit below this line
#  (Well unless you know what You are doing ;-)
###################################################################
$VER="1.3.4";
#############
# Read input into array
&cgi_receive;
#############
   ($win,$streak) = split (',',$FINPUT{'wlt'});

# now test to see if this is the first time through
   if ($FINPUT{'word'}) {
     &p_head;
     $type = $FINPUT{'clue'};
     ### un-encrypt word
     $FINPUT{'word'} =~ y/a-s,t,u,v,w,x,y,z/h-z,b,a,f,e,d,c,g/;
     $ctlnum=$FINPUT{'control'};
     $score=$FINPUT{'score'};
     $gn=$FINPUT{'gn'};
     if ($wac == 1){
        &read_wac;
     }
     if ($FINPUT{'done'} eq 'done')               ### guessed the word
	{ 
	$BG = $FINPUT{'new'};
	$BG =~ y/A-Z/a-z/;
	$BW = $FINPUT{'word'};
	$BW =~ y/A-Z/a-z/;
	if ($BW eq $BG)  ### get it right?
           {
             print "<DIV ALIGN=CENTER><FONT SIZE=+4 COLOR=\"#3333ff\">";
             print "You were right.</FONT><BR>";
	     print "it is <B>$FINPUT{'new'}</B><BR>";
             print "<FONT SIZE=+4 COLOR=\"#ff3333\">";
             print "You Won!!!</FONT><BR>";
             print "<img src=\"",$GIF_DIR,"hangw.gif\" height=150 width=150 alt=\"\"><BR>";
           }
           else {
               print "<DIV ALIGN=CENTER><FONT SIZE=+4 COLOR=\"#cc6633\">";
               print "You were WRONG!</FONT><BR>";
               print "<img src=\"",$GIF_DIR,"hang6.gif\" height=150 width=150 alt=\"\n O \n \\\|/\n \| \n/ \\\"><BR>";                
               print "It was really <B>",$FINPUT{'word'},".</B>";
               }
          print "<BR>Play another game of <a href=\"",$CGI_BIN,"?oldword=$FINPUT{'word'}&wlt=$win,$streak\">Hangman</A>";
          print " | go <A HREF=\"$HOMEP\">back</a> to the homepage";
          print "</DIV></BODY></HTML>\n";
          exit;
          return;
       }
     
     chop($FINPUT{'st'});                       # kill newline 
     $FINPUT{'st'} =~ s/\s//g;                  # Kill spaces
     $FINPUT{'st'} =~ s/^(.)(.*)/$1/;           # strip all but 1st char  
     $guess = $FINPUT{'st'}.' '.$FINPUT{'guess'};
     $guess =~ y/A-Z/a-z/;                      # lower case
     @sofar = split(/\s+/,$guess);              # make guess into an array 
     $gue = @sofar;                             # get number of letters
     $num = length($FINPUT{'word'});
     ### make the real word into an array buy splitting on space or nil
     $TEPE=$FINPUT{'word'};
     @Rword = split(//,$TEPE); 
     $TEPE =~ y/A-Z/a-z/;                      # lower case
     @rword = split(//,$TEPE); 
     print "<DIV ALIGN=CENTER><FONT SIZE=+3 color=\"#336699\">";
#####  Main test loop  
     $gotten = 0;
     $TEST = "";
     LET: for ($i=0;$i<$num;$i++) {             # match letters 
            $temp = $rword[$i];
	    for ($g=0;$g<$gue;$g++) { 
              if ($sofar[$g] eq $temp) { 
                print "@Rword[$i]";
		if ($TEST !~ /$temp/) {         # is there dupe letters 
                  $gotten = $gotten +1;         # no up count
                }
                $TEST= "$TEST$temp";		# build autotest string    
                next LET;
	      }
	    }

   	    if (@rword[$i] eq " "){ 
	  	print "&nbsp;&nbsp;&nbsp;"; 
     	    }
	    else {
            	print "_ ";                         # if no match print this  	  
		$TEST = "$TEST _";
	    }
	  }
     print "</FONT></DIV><BR>";
############################################
######  Test if they got it right  
     $TEPE =~ s/\s//g;
     $TEST =~ s/\s//g;

#print "-$TEST,$TEPE-";
     if ($TEST eq $TEPE) {
        print "<DIV ALIGN=CENTER><FONT SIZE=+3 COLOR=\"#ff3333\">";
        $win = $win + 1;
        print "You Won!!!</FONT><BR>";
        print "<img src=\"",$GIF_DIR,"hangw.gif\"><BR>";
        print "Play another game of <a href=\"",$CGI_BIN,"?oldword=$FINPUT{'word'}&wlt=$win,$streak\">Hangman</A>";
        print " | go <A HREF=\"$HOMEP\">back</a> to the homepage</DIV>";
        print "</BODY></HTML>";
        exit;
     }
############################################
##### Print new page
     print "<DIV ALIGN=CENTER>";
     print "<img src=\"",$GIF_DIR,"hang",($gue-$gotten),".gif\" height=150 width=150 alt=\"\"><BR>";
     if (($gue-$gotten) < 6) {                  # still guesses left
       $FINPUT{'word'} =~ y/a,b,c,d,e,f,g,h-z/u,t,y,x,w,v,z,a-s/;          # encrypt word
       if ((6-($gue-$gotten)) == 1) {           # lets make it 
          print "You have 1 guess left!";        # look nice
       }
       else {
          print "You have ",(6-($gue-$gotten))," guesses left!";
       }
       ########   Print clue
       if ($CLUE==1){
          print "<BR><font color=\"#0033ff\">hint : <B>$type</B></FONT>";
       }
       print "</DIV><P><DIV ALIGN=CENTER>"; 
       print "\n<form method=\"post\" action=\"",$CGI_BIN,"\">";
       print "<INPUT type=\"hidden\" name=\"guess\" value=\"$guess\">";
       print "<INPUT type=\"hidden\" name=\"word\" value=\"$FINPUT{'word'}\">";
       print "<input type=\"hidden\" name=\"wlt\" value=\"$win,$streak\">\n";
       print "<input type=\"hidden\" name=\"score\" value=\"$score\"\n>";
       if ($wac == 1){
         print "<input type=\"hidden\" name=\"control\" value=\"$ctlnum\">\n";
         print "<input type=\"hidden\" name=\"gn\" value=\"$gn\">\n";
       }  
       ### add clue to form
       if ($CLUE == 1){
          print "<input type=\"hidden\" name=\"clue\" value=\"$type\">";   
       }
    &buttons;
       print "</form>\n";
       print "Or if you are daring type in what you think that the word is.<p>"; 
       print "<form method=\"post\" action=\"",$CGI_BIN,"\">";
       print "<INPUT name=\"new\" size=24> &nbsp; "; 
       print "<input type=\"hidden\" name=\"done\" value=\"done\">"; 
       print "<input type=\"hidden\" name=\"word\" value=\"$FINPUT{'word'}\">";
       print "<input type=\"submit\" value=\"Guess It\">\n";
       print "</form> </DIV></BODY></html>\n";

       }
     ### You are Hung!!
     else{                                      
       print "<DIV ALIGN=CENTER><FONT SIZE=+3 COLOR=\"#ff3333\">";
       print "Game over.</FONT><BR><FONT SIZE=+2 COLOR=\"#3333cc\">";
       print "The correct answer is <B>$FINPUT{'word'}</B>.</FONT><BR>";
       print "Play another game of <a href=\"",$CGI_BIN,"\">Hangman</A>";
       print " | go <A HREF=\"$HOMEP\">back</a> to the homepage</DIV>";
       print "</BODY></HTML>";
       exit;
       }
     }
else {
########################################################
# First time through the program  generate the data
########################################################
    &p_head;
    # read word file
    $streak = $streak + 1;
    $X=1;
      open (WF, $DATAFILE) || die "file not found";
        @word_list=<WF>;
      close (WF);
   while ($X == 1){
      srand(time ^ $$);$num = rand(@word_list); 
      ($word, $type) = split(/,/, $word_list[$num]);
      $word =~ s/\r//g;
      $type =~ s/\r//g;
      if ($word eq $FINPUT{'oldword'}){ $X=1;}
      else {$X=0;;} 
      if ($word eq ""){$X=1;}
    }
    print "<DIV ALIGN=CENTER><FONT SIZE=+3 color=\"#336699\">";
    $num = (length($word)-1);
    @rword = split(//,$word); 
    for ($i=0;$i<=$num;$i++){ 
	if (@rword[$i] eq " "){ 
	  print "&nbsp;&nbsp;&nbsp;"; 
	}
	else {
  	  print '_ ';
	}
    }
    $score =($num * 5);
    $word =~ y/a,b,c,d,e,f,g,h-z/u,t,y,x,w,v,z,a-s/;                     # encrypt word
    print "</FONT></DIV>\n<p><DIV ALIGN=CENTER>";
    print "<img src=\"",$GIF_DIR,"hang0.gif\" height=150 width=150 alt=\"\"><BR>";
    print "Guess your first letter of the above unknown word.<BR>";
    print "<font color=\"#0033ff\">hint : <B>",$type,"</B></FONT>";
    print "<form method=\"post\" action=\"",$CGI_BIN,"\">";
    print "<input type=\"hidden\" name=\"guess\" value=\"\">";
    print "<input type=\"hidden\" name=\"wlt\" value=\"$win,$streak\">\n";
    print "<input type=\"hidden\" name=\"score\" value=\"$score\">\n";
    if ($wac == 1) {
        &read_ctl;
        $ctln=$ctln+1;
        &write_ctl; 
        &new_wac;
        print "<input type=\"hidden\" name=\"control\" value=\"$ctln\">\n";
        print "<input type=\"hidden\" name=\"gn\" value=\"1\">\n";   
    }
    if ($CLUE==1){
        print "<input type=\"hidden\" name=\"clue\" value=\"$type\">";
    }
    print "<input type=\"hidden\" name=\"word\" value=\"$word\">";
    &buttons;
    print "</form>\n";
    print "Or if you are daring type in what you think that the word is.<BR>";
    print "<form method=\"post\" action=\"",$CGI_BIN,"\">";
    print "<input name=\"new\" size=12> &nbsp; ";
    print "<input type=\"hidden\" name=\"done\" value=\"done\">";
    print "<input type=\"hidden\" name=\"word\" value=\"$word\">";
    print "<input type=\"hidden\" name=\"clue\" value=\"$type\">";
    print "<input type=\"submit\" value=\"Guess It\">\n";
    print "</form> </html>\n";
    }
#####################################################
# Print a nice colourful header as well as HTML head 
sub p_head {
     print "Content-type: text/html\n\n";
     print "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Draft//EN\">";
     print "<HTML>\n";
     print "<HEAD><title> Hangman </title></HEAD>\n";
     print "<BODY bgcolor=\"$bgcolour\" ";
     if ($BG==1){ 
       print "background=\"$BGGIF\" ";
     }
     print "text=\"$textcolour\" link=\"$linkcolour\" "; 
     print "vlink=\"$vlinkcolour\" link=\"$alinkcolour\">";
     print "<DIV ALIGN=CENTER>";
     print "<FONT COLOR=\"#ff3333\" SIZE=+5>H</FONT>";
     print "<FONT COLOR=\"#cc6633\" SIZE=+5>a</FONT>";
     print "<FONT COLOR=\"#999900\" SIZE=+5>n</FONT>";
     print "<FONT COLOR=\"#33cc33\" SIZE=+5>g</FONT>";
     print "<FONT COLOR=\"#339999\" SIZE=+5>m</FONT>";
     print "<FONT COLOR=\"#3366cc\" SIZE=+5>a</FONT>";
     print "<FONT COLOR=\"#0033ff\" SIZE=+5>n</FONT>";
     print " &nbsp  ver $VER</DIV>\n";
#     print "--- $played $win $streak";
     }
#####################################################
## print the A-Z buttons
sub buttons {
     print "<BR>";
    if ($guess !~ /a/) { &pline; print "\" A \">";}
    if ($guess !~ /b/) { &pline; print "\" B \">";}
    if ($guess !~ /c/) { &pline; print "\" C \">";}
    if ($guess !~ /d/) { &pline; print "\" D \">";}
    if ($guess !~ /e/) { &pline; print "\" E \">";}
    if ($guess !~ /f/) { &pline; print "\" F \">";}
    if ($guess !~ /g/) { &pline; print "\" G \">";}
    if ($guess !~ /h/) { &pline; print "\" H \">";}
    if ($guess !~ /i/) { &pline; print "\" I \">";}
    if ($guess !~ /j/) { &pline; print "\" J \">";}
    if ($guess !~ /k/) { &pline; print "\" K \">";}
    if ($guess !~ /l/) { &pline; print "\" L \">";}
    if ($guess !~ /m/) { &pline; print "\" M \">";}
    if ($guess !~ /n/) { &pline; print "\" N \">";}
    if ($guess !~ /o/) { &pline; print "\" O \">";}
    if ($guess !~ /p/) { &pline; print "\" P \">";}
    if ($guess !~ /q/) { &pline; print "\" Q \">";}
    if ($guess !~ /r/) { &pline; print "\" R \">";}
    if ($guess !~ /s/) { &pline; print "\" S \">";}
    if ($guess !~ /t/) { &pline; print "\" T \">";}
    if ($guess !~ /u/) { &pline; print "\" U \">";}
    if ($guess !~ /v/) { &pline; print "\" V \">";}
    if ($guess !~ /w/) { &pline; print "\" W \">";}
    if ($guess !~ /x/) { &pline; print "\" X \">";}
    if ($guess !~ /y/) { &pline; print "\" Y \">";}
    if ($guess !~ /z/) { &pline; print "\" Z \">";}    
     }
    sub pline {print "<input type=\"submit\" name=\"st\" value=";}

#####################################################################
#  WAC user if he tries to use the backbutton cheat.
sub read_wac {
 open (WAC, "$wacfile") || &error ("can not read WAC file.");
   @LINES=<WAC>;
 close WAC;
   foreach (@LINES) {
   $_ =~s/\n//g;
   ($ip,$wc,$wg)= split(/,/,$_);
     if ($ip eq $ENV{'REMOTE_ADDR'}) {
        if ($wc eq $ctlnum) {
           if ($wg == $gn) {
             # WAC them
               print "<DIV ALIGN=CENTER><FONT SIZE=+4 COLOR=\"#cc6633\">";
               print "You Cant Cheat!</FONT><BR>";
               print "<img src=\"",$GIF_DIR,"hang6.gif\" height=150 width=150 alt=\"\n O \n \\\|/\n \| \n/ \\\"><BR>";                
               print "<BR>Play another game of <a href=\"",$CGI_BIN,"\">Hangman</A>";
               print " | go <A HREF=\"$HOMEP\">back</a> to the homepage";
               print "</DIV></BODY></HTML>\n";
               exit;
           }
         $wg=$gn;
         $gn=$gn+1;
        }
     }
     &read_ctl;
        $wcray{$ip} = $wc;  
        $wgray{$ip} = $wg;
   }
   &whip;
}
#####################################################################
sub whip {
 open (WAC, ">$wacfile") || &error ("can not read WAC file.");
 foreach $key (sort keys(%wcray)) {
    if ($key ne ""){
       print WAC "$key,$wcray{$key},$wgray{$key}\n";
    }
 }
 close WAC;
}
##########################################################
sub new_wac {
 open (WAC, "$wacfile") || open (WAC, ">$wacfile"); 
   @LINES=<WAC>;
 close WAC;
   foreach (@LINES) {
   $_ =~s/\n//g;
   ($ip,$wc,$wg)= split(/,/,$_);
     #strip it down to the last 30
     if ($wc >= ($ctln-30)){
        $wcray{$ip} = $wc;  
        $wgray{$ip} = $wg;
     }
   }
   $wip=$ENV{'REMOTE_ADDR'};
   $wcray{$wip} = $ctln;  
   $wgray{$wip} = "0";
   &whip;
}
#####################################################################
#  read ctlnum
sub read_ctl{
  open (CTL, "$ctlfile") || &make_ctl;
    $ctln=<CTL>;
  close CTL;
  if ($ctln <= 10000000) { $ctln=10000000;}
}
sub write_ctl {
  open (CTL, ">$ctlfile") || &make_ctl;
    print CTL "$ctln";
  close CTL;
}
sub make_ctl {
  open (CTL, ">$ctlfile") || &error ("Cant make CTL file");
    print CTL "10000000";
  close CTL;
  &read_ctl;
}
#####################################################################
##  receive & Decode the html data
sub cgi_receive {
  if ($ENV{'REQUEST_METHOD'} eq "POST") {
    read(STDIN, $incoming, $ENV{'CONTENT_LENGTH'});
  }
  else {
    $incoming = $ENV{'QUERY_STRING'};           # this should never happen
  }
  @pairs = split(/&/, $incoming);
  foreach (@pairs) {
    ($name, $value) = split(/=/, $_);
    $name  =~ tr/+/ /;
    $value =~ tr/+/ /;
    $name  =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
    $value =~ s/%([A-F0-9][A-F0-9])/pack("C", hex($1))/gie;
    $value =~ s/;/$$/g;                         # Strip out semicolons
    $value =~ s/&(\S{1,6})$$/&\1;/g;
    $value =~ s/$$/ /g;
    $value =~ s/\|/ /g;
    $value =~ s/^!/ /g;
    $value =~ s/\r//g;
    $name =~ s/\r//g;
    # $value =~ s/[\/;\[\]<\>&\t]/_/g;          #Sanitize! 
    next if ($value eq "");
    if ($name =~ /^assign-dynamic/) {
      $name = $value;
      $value = "on";
    }
    $FINPUT{$name} .= ", " if ($FINPUT{$name});
    $FINPUT{$name} .= $value;
  }
}
######
sub error {
  print "<H1>ERROR Can not Write file!</H1>";
exit;
}