By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
446,218 Members | 1,194 Online
Bytes IT Community
Submit an Article
Got Smarts?
Share your bits of IT knowledge by writing an article on Bytes.

Word Guess game (similar to Hangman)

KevinADC
Expert 2.5K+
P: 4,059
This is not a "Howto" article but a complete script. I wrote this script a few years back for a competition on another forum and its really just sat around collecting dust since then.

Ask questions about how the script works if you don't understand some of the code. This is not intended to be technical support but for learning purposes. There is no doubt the code could be improved upon so if you see something that makes you cringe feel free to discuss it. It should be a fair-to-good example of a CGI script and how to use the CGI module and a couple of other core modules.

My hope is that it may be used as a learning tool but if someone wanted to post it on a website for their visitors to use thats OK.

There is no support for the script but if you try and use it and get stuck getting it to run I might try and help you via this forum. But I will not try and try and try to help you get it to run. If after a few suggestions you are still unable to get it working I will not offer anymore help.

There is a word file attached that is a little more than 2,000 words of varying difficulty to guess. One file has the words in alphabetical order and the other file, words.dat, is the one to use with the game. The words are in random order and seperated by a space which is how to script expects to find them. There should be no vulgar words but you may wish to check.

The perl script is attached as wordguess.txt because this forum does not allow .pl files to be uploaded. If you use that file just change the name to wordguess.pl

Regards,
Kevin

Expand|Select|Wrap|Line Numbers
  1. #!/usr/bin/perl -T
  2.  
  3. ######################################################
  4. # Wordguess Game, similar to Hangman
  5. # Kevin Ruggles 2004
  6. # There is no help or tech support for this script.
  7. # Use at your own risk.
  8. # Edit and distribute as you like.
  9. # See comments in script for hints on how to set it up
  10. # or to change stuff.
  11. ######################################################  
  12.  
  13. ####################################
  14. ####  script environment stuff  ####
  15. ####  do not edit unless you    ####
  16. ####  know what you are doing!  ####
  17. ####################################
  18. use CGI qw(-no_xhtml);
  19. #use CGI::Carp qw(fatalsToBrowser);
  20. $CGI::POST_MAX = 128;  # max 128 byte posts, we don't need much for this script so keep it low
  21. $CGI::DISABLE_UPLOADS = 1;  # no uploads, to prevent funny business
  22. use Fcntl;
  23. use Tie::File;
  24. use strict;
  25. use warnings;
  26.  
  27. ##########################################################
  28. ####  Paths to files                                  ####
  29. ####  Should be above the web root folder.            ####
  30. ####  Create a folder and name it hangman.            #### 
  31. ####  Put the words.txt file in it.                   ####
  32. ####  Change "/home/yoursite" to work on your website ####
  33. ##########################################################
  34. my $path_words = '/home/yoursite/hangman/words.txt';
  35. my $path_games = '/home/yoursite/hangman/data/';
  36.  
  37. ########################################################
  38. ####  scoring data - you can edit them if you like  ####
  39. ########################################################
  40. my @v = q(3 7 10 15);
  41. my %points = (
  42.    a=>$v[0],e=>$v[0],i=>$v[0],o=>$v[0],u=>$v[0],
  43.    b=>$v[1],c=>$v[1],d=>$v[1],f=>$v[1],g=>$v[1],
  44.    h=>$v[1],l=>$v[1],m=>$v[1],n=>$v[1],p=>$v[1],
  45.    r=>$v[1],s=>$v[1],t=>$v[1],
  46.    j=>$v[2],k=>$v[2],y=>$v[2],
  47.    v=>$v[3],q=>$v[3],w=>$v[3],x=>$v[3],z=>$v[3]
  48. );
  49.  
  50. ############################################################
  51. ####  Appearance stuff - you can edit them if you like. ####
  52. ####  The code is CSS and is inserted as an inline      ####
  53. ####  style sheet or directly into html tags. Its up to ####
  54. ####  you to figure it out.                             ####
  55. ############################################################
  56. my $body_definitions = qq(
  57. body {
  58.    background-color:#C0C0FF;
  59.    font-family:Verdana;
  60.    font-size:16px;
  61. }
  62. input {
  63.    font-family:Verdana;
  64.    font-size:12px;
  65.    font-weight:bold;
  66.    background-color:#C0C0FF;
  67.    border:solid 1px #0000C0;
  68. }
  69. );
  70. my $div_enter_page = qq(background-color:#D4D5EC; text-align:center; width:400px; padding:8px 5px 0 5px; border:solid 1px #0000C0; margin-top: 15%; margin-left: auto; margin-right: auto;);
  71. my $div_style = qq(background-color:#D4D5EC; text-align:center; width:480px; padding:8px 0 0 0; border:solid 1px #0000C0; margin-top: 15%; margin-left: auto; margin-right: auto;);
  72. my $H1 = qq(font-family:Arial; font-size:24px;);
  73. my $rules = qq(font-size:10pt;width:100%;text-align:left;padding:0 5px 0 5px;);
  74. my $secret_word_span = qq(color:#0000C0;letter-spacing:5px;font-size:24px;font-weight:bold;font-family:Courier;);
  75. my $text_field = qq(background-color:cornsilk;text-align:center;);
  76.  
  77. ########################################################
  78. ####  game options - you can edit them if you like  ####
  79. ########################################################
  80. # maximum number of incorrect tries
  81. my $max_tries = 10;
  82.  
  83. # maximum amount of time in seconds to complete a game (60 = 1 minute, etc)
  84. # set to zero '0' or leave blank '' to NOT have a time limit.
  85. my $max_time = 60;
  86.  
  87. # the number of days until old games that were not deleted by the script during play
  88. # will be deleted, the minimum value is one '1' (one day more or less).
  89. # set to zero '0' or leave blank '' to NOT auto delete old game files.
  90. my $delete = 1;
  91.  
  92. ##############################################
  93. ####  you should not edit below here      ####
  94. ####  unless you know what you are doing! ####
  95. ##############################################
  96. my $q = new CGI;
  97. print $q->header();
  98.  
  99. my ($flag,$t,%h,$id) = (0,time,'','');
  100.  
  101. if ($q->param('new_game') || $q->param('start_game') || $q->param('submit') || $q->param('hint')) {
  102.    GetData();
  103.    my $this_guess = ProcessData() unless $q->param('new_game') || $q->param('start_game');
  104.    Win()  if ($h{'word'} eq $h{'revealed'} && $h{'tries_left'} <= $max_tries);
  105.    Lose() if ($t >= $h{'time'} && $max_time);
  106.    Lose() if ($h{'tries_left'} < 1 && $this_guess);
  107.    PrintGame();
  108.    PrintData();
  109.    AutoDelete() if $delete;
  110. }
  111. else {Enter()}
  112. exit(0);
  113. ########################################
  114. ####  normal termination of script  ####
  115. ########################################
  116.  
  117. #######################
  118. ####  subroutines  ####
  119. #######################
  120. sub AutoDelete {
  121.    $path_games .= '/' unless $path_games =~ m/\/$/; # make sure we have the trailing slash
  122.    my @games = <$path_games*.game>;
  123.    for (@games) {
  124.         if (/$path_games([\w]{20})\.game/) {# untaint the path
  125.            my $game = "$path_games$1.game";
  126.          unlink($game) if (int(-M $game) >= $delete);
  127.       }
  128.       else {next;}
  129.    }
  130. }
  131.  
  132. sub DeleteOld {
  133.    my $old_id = shift;
  134.    die "Unable to continue.\n" unless ($old_id =~ m/^([\w.-]+)$/); #untaint $old_id
  135.    $old_id = "$path_games$1.game";
  136.    unlink($old_id);
  137.    undef $old_id;
  138. }
  139.  
  140. sub EndHTML {
  141.    print $q->start_form(-name=>'hangman'),
  142.          $q->submit (-name=>'new_game', -label=>'Play Again'),
  143.          $q->end_form,
  144.          "\n</div>\n",
  145.          $q->end_html;
  146.    exit(0);
  147. }
  148.  
  149. sub Enter {
  150.    my $the_time = 'run out.';
  151.    $the_time = 'run out or the time runs out.' if $max_time;
  152.    my $the_time2 = '';
  153.    $the_time2 = "and $max_time seconds" if $max_time;
  154.    print $q->start_html(-title=>'Word Guess / Hangman!',-style=>"$body_definitions",-onLoad=>'document.hangman.start_game.focus()'),
  155.          qq~
  156. <div style="$div_enter_page">
  157.    <h1 style="$H1">Lets Play Word Guess (Hangman)!</h1>
  158.       <div style="$rules">
  159.          <b>&nbsp;&nbsp;&nbsp;The Rules:</b>
  160.             <ol>
  161.                 <li>Guess letters to reveal the secret word.</li>
  162.                 <li>You win if you guess the secret word before your tries remaining $the_time</li>
  163.                 <li>You have $max_tries tries $the_time2 to start with.</li>
  164.                 <li>An incorrect guess will take away one try.</li>
  165.                 <li>A correct guess will not take away from your $max_tries tries but does add to your total tries.</li>
  166.             </ol>
  167.       </div>
  168. ~,
  169.          $q->start_form(-name=>'hangman'),
  170.          $q->submit(-name=>'start_game', -label=>'Start Game'),
  171.          $q->end_form,
  172.          "\n</div>\n",
  173.          $q->end_html;
  174. }
  175.  
  176. sub GetData {
  177.    if($q->param('new_game') || $q->param('start_game')) {
  178.       &DeleteOld($q->param('gameid')) if $q->param('gameid');
  179.       $id = &MakeGameId();
  180.       $id = &MakeGameId() if (-e "$path_games$id.game"); #just to be safe
  181.       tie my @DATA, 'Tie::File', $path_words, recsep => ' ', mode => O_RDWR || die print "<h2>$!</h2>\n";
  182.       print "<h1>There are no words. Please upload the words.dat file</h1>" unless @DATA;
  183.       my $word = lc $DATA[int(rand @DATA)];
  184.       untie(@DATA);
  185.       ($h{'hints'},$h{'total'},$h{'word'},$h{'tries_left'},$h{'letters'},$h{'time'}) = (0,0,$word,$max_tries,'',($t+$max_time));
  186.       ($h{'revealed'} = $word) =~ tr/a-z/_/; 
  187.       open(GAME, ">$path_games$id.game") or die print "<h2>Can't find game file: $!</h2>\n";
  188.       print(GAME "$h{'time'}\t$h{'hints'}\t$h{'hint_letters'}\t$h{'total'}\t$h{'word'}\t$h{'tries_left'}\t$h{'letters'}\t$h{'revealed'}");
  189.    }
  190.    else {
  191.       $id = $q->param('gameid');
  192.       die "Unable to continue.\n" unless ($id =~ m/^([\w.-]+)$/); #untaint $id
  193.       $id = $1;
  194.       open(GAME, "$path_games$id.game") or die print "<h2>Can't find game file: $!</h2>\n";
  195.       ($h{'time'},$h{'hints'},$h{'hint_letters'},$h{'total'},$h{'word'},$h{'tries_left'},$h{'letters'},$h{'revealed'}) = split(/\t/,<GAME>);
  196.    }
  197.    close(GAME);
  198. }
  199.  
  200. sub GuessLetter {
  201.    my $guess = shift;
  202.    my @word = split(//,$h{'word'});
  203.    my @new_revealed = split(//,$h{'revealed'});
  204.    my ($pass,$count) = (0,0);
  205.    foreach (@word) {
  206.       ($pass,$new_revealed[$count]) = (1,$guess) if ($guess eq $_);
  207.       $count++;
  208.    }
  209.    $h{'revealed'} = join("",@new_revealed);
  210.    return $pass;
  211. }
  212.  
  213. sub Hint {
  214.    my $bonk = 0;
  215.    my @word = split(//,$h{'word'});
  216.    my $hint = lc $word[int(rand @word)];
  217.    my %revealed = map {$_ => $_} split(//,$h{'revealed'});
  218.    $bonk++ if $hint eq $revealed{$hint};
  219.    if ($bonk) {&Hint;}
  220.    else {return $hint;}
  221. }
  222.  
  223. sub Lose {
  224.    &DeleteOld($q->param('gameid'));
  225.    my ($score,$max_score) = &Score();
  226.    my $effort = '';
  227.    $effort = 'that sucked'  if $score < 1;
  228.    $effort = 'good try'     if $score > 0;
  229.    $effort = 'time ran out' if ($t > $h{'time'} && $max_time);
  230.    print $q->start_html(-title=>'Word Guess / Hangman - Sorry!',-style=>"$body_definitions",-onLoad=>'document.hangman.new_game.focus()'),
  231.          qq~
  232. <div style="$div_style">Sorry, $effort, the secret word was:<p>
  233.    <span style="$secret_word_span">$h{'word'}</span><p>
  234.    Your score was <b>$score</b> of a possible <b>$max_score</b> points.
  235.    <br>
  236. ~;
  237.   &EndHTML;
  238. }
  239.  
  240. sub MakeGameId {
  241.    my @digits = ('a'..'z', 'A'..'Z', '0'..'9');
  242.    $id .= $digits[int(rand @digits)] for (1..10);
  243.    return ($id.time);
  244. }
  245.  
  246. sub PrintData {
  247.    open(GAME, ">$path_games$id.game") || die "$!\n";
  248.    print(GAME "$h{'time'}\t$h{'hints'}\t$h{'hint_letters'}\t$h{'total'}\t$h{'word'}\t$h{'tries_left'}\t$h{'letters'}\t$h{'revealed'}");
  249.    close(GAME);
  250. }
  251.  
  252. sub PrintGame {
  253.    my ($time_limit,$color,$t_color) = ('','#000000','#000000');
  254.    if ($h{'tries_left'} < 3) {$color = '#FF0000';}#alert when 2 tries remain
  255.    my $time_left = ($h{'time'} - $t);
  256.    my $t_percent = int($max_time * .2);
  257.    if ($time_left <= $t_percent) {$t_color = '#FF0000';}#alert when %20 of time remains
  258.    $time_limit = qq~Time Remaining: <span style="color:$t_color;font-weight:bold;">$time_left sec</span><br>~ if ($max_time);  
  259.    print $q->start_html( -title=>'Word Guess / Hangman!',-style=>"$body_definitions",-onLoad=>'document.hangman.guess.select()'),
  260.          qq~
  261. <div style="$div_style">
  262.    <span style="font-size:20px;font-weight:bold;">Secret Word: </span>
  263.    <span style="$secret_word_span">$h{'revealed'}</span>
  264.    <p>
  265. ~,
  266.          $q->start_form(-name=>'hangman'),
  267.          "Enter a guess: ",
  268.          $q->textfield ( -name=>'guess', -size=>1, -maxlength=>1, -default=>'', -style=>"$text_field", override=>1,),
  269.          "&nbsp;",
  270.          $q->hidden (-name=>'gameid', -default=>$id, override=>1),
  271.          $q->submit (-name=>'submit', -label=>'Submit Guess'),
  272.          qq~
  273.    <p>Tries Remaining: 
  274.    <span style="color:$color;font-weight:bold;">$h{'tries_left'}</span>
  275.    <br>$time_limit
  276.    Total Tries: <b>$h{'total'}</b>
  277.    <br>
  278.    Incorrect Guesses: <b style="letter-spacing:6px;">$h{'letters'}</b>
  279.    <p>
  280.    &nbsp;&nbsp;
  281. ~,
  282.          $q->submit(-name=>'hint', -label=>'Hint'),
  283.          "\n   <span style=\"font-size:16px;\"> * </span><p>\n",
  284.          $q->submit(-name=>'new_game', -label=>'New Game'),
  285.          "\n   <p>\n",
  286.          $q->end_form,
  287.          qq~\n   <span style="font-size:10px;">* Takes away 2 tries remaining and adds 2 to total tries.<br>* No points awarded for hints.</span>\n</div>\n~,
  288.          $q->end_html;
  289. }
  290.  
  291. sub ProcessData {
  292.    my $this_guess = $q->param('guess');
  293.    $this_guess = &Hint if $q->param('hint');
  294.    $this_guess =~ tr/a-zA-Z//cd; #we only want a-z
  295.    $this_guess = substr $this_guess,0,1; #we only want one character
  296.    if ($this_guess) {
  297.       $h{'total'}++;
  298.       ($h{'tries_left'}-=2,$h{'total'}++,$h{'hints'}++,$h{'hint_letters'} .= $this_guess) if $q->param('hint');
  299.       unless (&GuessLetter($this_guess)) {
  300.          $h{'tries_left'}--;
  301.          $h{'letters'} .= $this_guess;
  302.       }
  303.       return($this_guess);
  304.    }
  305.    else {return(0);}
  306. }
  307.  
  308. sub Score {
  309.    # the scoring system is very simple and only intended for fun
  310.    # the basic concept is:
  311.    #   1. each unique letter in a word is given a points value (%points)
  312.    #   2. any letters revealed by using the hint button are not awarded points.
  313.    #   3. the total points are added up and multiplied by the number of tries remaining if any.
  314.     $h{'tries_left'} = 1 if $h{'tries_left'} < 1;
  315.    my ($score,$score2,$max_score) = (0,0,0);
  316.    my %guess = map {$_ => $_ } split(//,$h{'revealed'});
  317.    my %word  = map {$_ => $_ } split(//,$h{'word'});
  318.    my %hints = map {$_ => $_ } split(//,$h{'hint_letters'});
  319.    for (keys %guess) {
  320.         $guess{$_} = 0 if $_ eq $hints{$_};
  321.    }
  322.    $score+=$points{$_}  for values %guess;
  323.    $score2+=$points{$_} for keys %word;
  324.    $max_score = $score2*$max_tries;  # maximum possible score
  325. print qq~   $score = $score*$h{'tries_left'}; # actual score~;
  326.    $score = $score*$h{'tries_left'}; # actual score
  327.    return ($score,$max_score);
  328. }
  329.  
  330. sub Win {
  331.    my $time_used = $max_time - ($h{'time'} - $t);
  332.    my $time_stat = '';
  333.    $time_stat = qq~<br>Time: <b>$time_used sec</b>~ if ($max_time);  
  334.    &DeleteOld($q->param('gameid'));
  335.    my ($score,$max_score) = &Score();
  336.    my $congrats = 'Congratulations!';
  337.    $congrats .= ' Perfect Score!' if $score == $max_score;
  338.    print $q->start_html(-title=>'Word Guess / Hangman - Congratulations!',-style=>"$body_definitions",-onLoad=>'document.hangman.new_game.focus()'),
  339.          qq~
  340. <div style="$div_style">
  341.    $congrats<br>You guessed the secret word:
  342.    <p>
  343.    <span style="$secret_word_span">$h{'word'}</span>
  344.    <p>
  345.    Total Guesses: <b>$h{'total'}</b>
  346.    $time_stat
  347.    <p>
  348.    Your score was <b>$score</b> of a possible <b>$max_score</b> points.
  349.    <br>
  350. ~;
  351.    &EndHTML;  
  352. }
  353. __END__
Attached Files
File Type: txt words.txt (15.1 KB, 760 views)
File Type: txt words_abc_order.txt (17.4 KB, 716 views)
File Type: txt wordguess.txt (13.6 KB, 594 views)
Dec 8 '08 #1
Share this Article
Share on Google+