#!/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.2
# By J.R. Greer  jrg@albedo.net
# ftp://ftp.albedo.net/pub/games/html/
# 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 = "/games/hangman/";

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

# the URL to go back to leave the game  ie: http://www.albedo.net/
$HOMEP = "http://www.joehollywood.com/";

# The location of the word file (FULL PATH!)
$DATAFILE = "/home/virtual/site9/fst/home/joehollywood/mainwebsite_html/games/hangman/hangman.words";

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

$bgcolour="white";
$textcolour="black";
$linkcolour="blue";
$vlinkcolour="blue";
$alinkcolour="black";

# use background
$BG=0;
$BGGIF="/games/hangman/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="/home/virtual/site9/fst/home/joehollywood/mainwebsite_html/games/hangman";
$ctlfile="/home/virtual/site9/fst/home/joehollywood/mainwebsite_html/games/hangman";
#
# Turn on scoreing
$score=1;
#
# top ten players list;  (not working)
$ttpl="/home/virtual/site9/fst/home/joehollywood/mainwebsite_html/games/hangman/ttpl.html";
##################################################################
###################################################################
#  Do not edit below this line
#  (Well unless you know what You are doing :)
###################################################################
$VER="1.3.2";
###
&cgi_receive;
   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/;
  #  $FINPUT{'word'} =~ y/a,b,c,d,e,f,g,h-z/u,t,y,x,w,v,z,a-s/;   
     $ctlnum=$FINPUT{'control'};
     $score=$FINPUT{'score'};
     $gn=$FINPUT{'gn'};
     if ($wac == 1){
        &read_wac;
     }
     if ($FINPUT{'done'} eq 'done')               ### guessed the word
	{ if ($FINPUT{'word'} eq $FINPUT{'new'})  ### get it right?
           {
             print "<DIV ALIGN=CENTER><FONT SIZE=+4 COLOR=\"#3333ff\">";
             print "You Won!</FONT><BR></TD><TD>";
             print "<img src=\"",$GIF_DIR,"hangw.gif\" height=100 width=100 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=100 width=100 alt=\"\n O \n \\\|/\n \| \n/ \\\"><BR>";                
               print "It was really <B>",$FINPUT{'word'},".</B>";
               }
print "</TD><TD>";
               print "<BR>Play another game of <a href=\"/games/hangman/\" target=\"_top\">Hangman</A>";
#    print " | go <A HREF=\"$HOMEP\">back</a> to the homepage";
          print "</DIV></TD></TR></TABLE></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
     @rword = split(/ */,$FINPUT{'word'}); 
     print "<TABLE WIDTH=99\% BORDER=0 CELLPADDING=3 CELLSPACING=2><TR><TD WIDTH=150>";
     print "<DIV ALIGN=CENTER><FONT SIZE=5 color=\"#336699\">";
     $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 $temp;
		if ($TEST !~ /$temp/) {         # is there dupe letters 
                  $gotten = $gotten +1;         # no up count
                }
                $TEST= "$TEST$temp";		# build autotest string    
                next LET;
	      }
	    }
            print "_<font size=-2> </font>";                         # if no match print this
            $TEST = "$TEST _";
	  }
     print "</FONT></DIV><BR>";
############################################
######  Test if they got it right  
     if ($TEST eq $FINPUT{'word'}) {
        print "<DIV ALIGN=CENTER><FONT SIZE=+3 COLOR=\"#ff3333\">";
        print "You Won!!!</FONT><BR></TD><TD>";
        print "<img src=\"",$GIF_DIR,"hangw.gif\"><BR>";
        print "<BR>Play another game of <a href=\"/games/hangman/\" target=\"_top\">Hangman</A>";
#        print " | go <A HREF=\"$HOMEP\">back</a> to the homepage</DIV>";
        print "</TD></TR></TABLE></BODY></HTML>";
        exit;
     }
############################################
##### Print new page
     print "<DIV ALIGN=CENTER>";
     print "<img src=\"",$GIF_DIR,"hang",($gue-$gotten),".gif\" height=75 width=75 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
print "</TD><TD WIDTH=50\%>";
       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\">Category: <B>$type</B></FONT>";
       }
       print "</DIV><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=\"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 "Solve It:<p>"; 
#       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=\"$FINPUT{'word'}\">";
#       print "<input type=\"submit\" value=\"Guess It\">\n";
#	print "</form>";
       print "</DIV></TD></TR></TABLE></BODY></html>\n";

       }
     ### You are Hung!!
     else{ 
	print "</TD><TD>";                                     
       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 "<BR>Play another game of <a href=\"/games/hangman/\" target=\"_top\">Hangman</A>";
#       print " | go <A HREF=\"$HOMEP\">back</a> to the homepage</DIV>";
       print "</TD></TR></TABLE></BODY></HTML>";
       exit;
       }
     }
else {
########################################################
# First time through the program  generate the data
########################################################
    &p_head;
    # read word file
    open (WF, $DATAFILE) || die "file not found";
      @word_list=<WF>;
    close (WF);
    srand(time ^ $$);$num = rand(@word_list); 
    ($word, $type) = split(/,/, $word_list[$num]);
    $word =~ s/\r//g;
    $type =~ s/\r//g;
     print "<TABLE BORDER=0 CELLPADDING=3 CELLSPACING=2><TR><TD WIDTH=150>";
    print "<DIV ALIGN=CENTER><FONT SIZE=5 color=\"#336699\">";
    $num = length($word);
    for ($i=1;$i<=$num;$i++)
        { print '_<font size=-2> </font>';	  
    }
    $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=75 width=75 alt=\"\"><BR>";
    print "</TD><TD WIDTH=50\%>";
    print "Click a button below to guess:<BR>";
    print "<font color=\"#0033ff\">Category: <B>",$type,"</B></FONT>";
    print "<form method=\"post\" action=\"",$CGI_BIN,"\">";
    print "<input type=\"hidden\" name=\"guess\" value=\"\">";
    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 "Know what it is? ";
#    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>\n";
    print "</TD></TR></TABLE></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 FACE=helvetica,arial>";
     print "<FONT COLOR\=\"#ff3333\" SIZE\=4>HangMan at The Bang &nbsp;&nbsp; <A HREF\=\"/games/\" target\=\"_top\">[Quit Game]</A></FONT>";
     print "</DIV>\n";
     }
#####################################################
## print the A-Z buttons
sub buttons {
     print "";
    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 \">";}
print "<BR>";
    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=75 width=75 alt=\"\n O \n \\\|/\n \| \n/ \\\"><BR>";                
               print "<BR>Play another game of <a href=\"/games/hangman/\" target=\"_top\">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;
}