Program HangEMhigh (input, output);
{Gary Hartman did the procedure, cleanup, and graphics;
Phil Hurak did the supporting procedures--ETC;
Jason Linkhart did the main, procedure, and the pre/post statements}
Uses
Crt;
Const
maxlong = 50;
maxguess = 8;
Type
guesstring = string[30];
guesstype = array[1..maxlong] of char;
Var
used:guesstring;
guessword:guesstring;
realword:guesstype;
again,inst:char;
V:integer;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure TheWord (VAR actual:guesstype);
{Pre: stores a string of the word with blanks
Post: has been written to screen with blanks where not guessed}
Var
I:integer;
Begin
For I := 1 to maxlong do
write (actual[I]);
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Function HowLong (VAR str: guesstype): integer;
{Pre:N/A
Post:Returns the actual length of the string stored in .
The string is assumed to be padded with blanks }
Var
pos:integer;
Begin
pos := maxlong;
While (Pos > 1) and (str[Pos] = ' ') do
Begin
pos := pos - 1;
If str[pos] = ' ' then
HowLong := 0
Else HowLong := pos;
end;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Function Insert(Ch:char; VAR str: guesstype): Boolean;
{Pre: is the letter guess. is the actual word.
Post: Enters letter in the array to see if any match. is the letter guess.
is the actual word.}
Var
I,let:integer;
Begin
I := 1;
let := HowLong(str);
While (str[I] <> Ch) and (I <= let) do
I := I+1;
insert := str[I] = Ch
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure PutIn(Ch: char; var Source,Dest:guesstype);
{ Pre: N/A is the letter guessed
Post: The letter is inserted in place of a blank.}
var
I: integer;
begin
for I := 1 to HowLong(Source) do
if Source[I] = Ch then
Dest[I] := Ch
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure GuessWhole (last:integer; VAR gesit:guesstype);
{Pre: is the length of the actual word. is blank.
Post: is the length of the actual word is the whole word guess.}
Var
A:integer;
guessing:guesstring;
Begin
clrscr;
write ('You Chose to guess the whole word, what is your answer?: ');
readln (guessing);
For A := 1 to last do
Begin
guessing[A] := upcase(guessing[A]);
end;
For A := 1 to last do
Begin
gesit[A] := guessing[A];
end;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure Title;
{Pre:N/A
Post:N/A}
Var
E,W:integer;
Begin
clrscr;
randomize;
For W:= 1 to 12 do
Begin
E := random(15);
textcolor(E);
writeln ('ئق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±° WELL- °ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±µ':72);
writeln ('ئ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق HUNG ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²µ':72);
writeln ('ئ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق² â ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°قµ':72);
writeln ('ئ°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²± â ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°µ':72);
delay(100);
clrscr;
E := random(15);
textcolor(E);
writeln ('ئ°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²± WELL- ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°µ':72);
writeln ('ئق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±° HUNG °ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±µ':72);
writeln ('ئ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق â ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²µ':72);
writeln ('ئ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق² â ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°قµ':72);
delay(100);
clrscr;
E := random(15);
textcolor(E);
writeln ('ئ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق² WELL- ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°قµ':72);
writeln ('ئ°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²± HUNG ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°µ':72);
writeln ('ئق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±° â °ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±µ':72);
writeln ('ئ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق â ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²µ':72);
delay(100);
clrscr;
E := random(15);
textcolor(E);
writeln ('ئ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق WELL- ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²µ':72);
writeln ('ئ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق² HUNG ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°قµ':72);
writeln ('ئ°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²± â ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°µ':72);
writeln ('ئق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±° â °ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±µ':72);
delay(100);
clrscr;
end;
textcolor(11);
writeln ('ئق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±° WELL- °ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±µ':72);
writeln ('ئ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق HUNG ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²µ':72);
writeln ('ئ±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق² â ²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°قµ':72);
writeln ('ئ°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²± â ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°ق²±°µ':72);
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure TakeOut (VAR nomore:guesstring;whatlett:char);
Var
takeloop:integer;
Begin
For takeloop := 1 to 26 do
Begin
If (whatlett = nomore[takeloop]) then
Begin
nomore[takeloop] := ('غ');
end;
end;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure StrngRead (Var s: guesstype );
{Pre: user is prepared to enter a string
Post: characters have been read from the keyboard and placed into .
The unused portion of s is filled with blanks. key ends the run.}
Var
blankpos, currlength:integer;
Begin
currlength:=0;
While (not Eoln) and (currlength < maxlong) do
Begin
currlength:= currlength + 1;
read (s[currlength]);
end;
readln;
For blankpos := currlength + 1 to maxlong do
s[blankpos] := ' '
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure GuessEntry (VAR wordz:guesstype; VAR already:guesstring);
{Pre: has to be entered by the guesser.
Post: Win or lose is decided upon completion or tries.}
Var
V,W,I,S,X,mis,let,try:integer;
ch:char;
spare,letr:guesstype;
Begin
mis:=0;
let := HowLong(wordz);
clrscr;
write ('UNUSED LETTERS: ³');
For V := 1 to 26 do
Begin
write (already[V],'³');
end;
writeln;
Writeln(' You are allowed to have ',maxguess,' mistakes');
Writeln('Word is ');
For X := 1 to let do
Begin
wordz[X] := upcase(wordz[X]);
letr[X] := '*';
Write('-')
end;
For X := let + 1 to maxlong do
letr[X] := ' ';
WriteLn;
try := 0;
Repeat
Write('Enter a letter or to guess the word? ');
ch := ReadKey;
ch := UpCase(ch);
TakeOut (already,ch);
WriteLn(ch);
delay(600);
CLRSCR;
If ch = '!' then
Begin
For W := 1 to let do
Begin
spare[W] := letr[W];
end;
GuessWhole (let,letr);
If (letr <> wordz) then
Begin
for W := 1 to let do
Begin
letr[W] := spare[W];
end;
try := try + 1;
mis := mis + 1;
writeln ('WRONG....You have incorrectly guessed the word!');
WRITELN;
writeln ('You took ',try,' turns and made ',mis,' mistakes');
WriteLn ('Word is ', letr);
end;
end
Else If ch <> '!' then
Begin
If insert(ch, wordz) then
Begin
PutIn (ch, wordz, letr);
write ('UNUSED LETTERS: ³');
For V := 1 to 26 do
Begin
write (used[V],'³');
end;
writeln;
writeln;
WriteLn ('Word is ', letr)
end
Else
Begin {graphics}
write ('UNUSED LETTERS: ³');
For V := 1 to 26 do
Begin
write (used[V],'³');
end;
writeln;
writeln;
writeln ('Sorry, there are no ', ch, '''s');
writeln ('In the word ', letr);
mis:= mis + 1;
If mis = 1 then
Begin
for I := 800 downto 700 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛\ ');
writeln('ضؤؤؤؤؤؤؤؤؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =2 then
Begin
for I := 700 downto 600 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛\ ');
writeln('ضؤؤؤؤؤؤؤؤؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =3 then
Begin
for I := 600 downto 500 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln(' ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛');
writeln(' ؛\ ');
writeln('ضؤؤؤؤؤؤؤؤؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =4 then
Begin
for I := 500 downto 400 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln(' ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' \ ؛');
writeln(' ف ؛');
writeln(' ف ؛');
writeln(' ف ؛');
writeln(' ف ؛\ ');
writeln('ضؤؤؤؤؤؤؤتؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =5 then
Begin
for I := 400 downto 300 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln(' ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' / \ ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛\ ');
writeln('ضؤؤؤتؤؤؤتؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =6 then
Begin
for I := 300 downto 200 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln('\ ؛');
writeln(' \ ² ؛');
writeln(' \ ² ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' / \ ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛\ ');
writeln('ضؤؤؤتؤؤؤتؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis =7 then
Begin
for I := 200 downto 100 do
BEGIN
sound(I);
delay(10);
END;
NOSOUND;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( 0؟0 )@ ؛');
writeln(' \ ى / ؛');
writeln('\ / ؛');
writeln(' \ ² / ؛');
writeln(' \ ²/ ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' / \ ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛\ ');
writeln('ضؤؤؤتؤؤؤتؤؤؤؤؤؤ¶ \');
writeln('؛ ؛ \');
end
Else If mis=8 then
Begin
begin
for I := 400 downto 50 do
BEGIN
sound(I);
DELAY(1);
END;
sound(400);
delay(20);
sound(300);
delay(20);
sound(200);
delay(20);
sound(100);
delay(20);
SOUND(50);
DELAY(20);
nosound;
end;
clrscr;
writeln (' رحححححححح»');
writeln (' ³ ؛');
writeln(' /^^^\ ؛');
writeln(' @( ي؟ي )@ ؛');
writeln(' \ ى / ؛');
writeln(' ؛');
writeln(' ² ؛');
writeln(' ² ؛');
writeln(' / ² \ ؛');
writeln(' ³ ² ³ ؛');
writeln(' ³ / \ ³ ؛');
writeln(' ُق فُ ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛');
writeln(' ق ف ؛\ ');
writeln('ضؤؤ\ /ؤؤؤؤ¶ \');
writeln('؛ \ / ؛ \');
writeln ('...YOU DIED!...');
WRITELN;
end;
end; {graphics}
If (mis < maxguess) and (letr <> wordz) then
Begin
try := try + 1;
writeln ('You took ',try,' turns and made ',mis,' mistakes');
writeln;
end;
end;
Until (letr = wordz) or (mis >= maxguess);
If (letr = wordz) then
Begin
for I := 550 to 800 do
BEGIN
sound(I);
delay(2);
END;
SOUND(50);
DELAY(80);
sound(100);
delay(80);
sound(200);
delay(80);
sound(300);
delay(80);
sound(400);
delay(80);
sound(500);
delay(80);
sound(600);
delay(80);
NOSOUND;
writeln ('Congratulations!, You have correctly guessed the word!');
try := try+1;
writeln ('You took ',try,' turns and made ',mis,' mistakes');
delay(4000);
end
Else If (mis >= maxguess) then
Begin
writeln ('You have incorrectly guessed the word!');
try := try+1;
write ('The word was ');
TheWord (wordz);
WRITELN;
writeln ('You took ',try,' turns and made ',mis,' mistakes');
writeln ('Sorry.....Try again!.......');
DELAY(4000);
clrscr;
end;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure Intro (ans:char);
{Pre:N/A is nothing.
Post: tells player instructions to game if requested. is Y or N.}
Begin
While ((ans <>'N') and (ans <>'Y')) do
Begin {check}
write ('You may only answer Y or N: ');
readln (ans);
ans := upcase(ans);
end; {check}
If (ans = 'Y') then
Begin {need info}
writeln;
writeln ('A word was entered by another player. You have ',maxguess,' to guess the word.');
writeln;
writeln ('DO NOT press the bar or key after your entry, They are counted ');
writeln;
writeln ('as a guess and will be counted against you if pressed!');
writeln;
writeln ('The program will automatically read your entry WITHOUT pressing them, so don''t');
writeln;
writeln ('press them!');
writeln;
writeln ('Strike a key to begin......');
readkey;
end; {need info}
clrscr;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure AlreadyTried (VAR entry:guesstring);
Var
current,L:integer;
Begin
current := 65;
For L := 1 to 26 do
Begin
entry[L] := (char(current));
current := current + 1;
end;
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure StringEntry (VAR enigma:guesstype);
{Pre: The user is told to enter a word that will be .
Post: letters have been read from the keyboard and placed into .
The unused part of is filled with blanks.}
Var
blanks,preslngth:integer;
Begin
preslngth:=0;
While (not eoln) and (preslngth < maxlong) do
Begin {take in}
preslngth:= preslngth + 1;
read (enigma[preslngth]);
end; {take in}
readln;
For blanks := preslngth + 1 to maxlong do
Begin {empty fill}
enigma[blanks] := ' ';
end; {empty fill}
end;
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure Charerrck (var rep:char);
Begin {check ans}
While (rep <> 'Y') and (rep <> 'N') do
Begin {while}
textcolor(33);
writeln;
writeln ('°±²!ERROR!²±°':45);
delay(2500);
clrscr;
textcolor(11);
writeln;
writeln;
write ('Enter only Y/Nؤؤ ':45);
rep := readkey;
rep := upcase (rep);
end; {while}
end; {check ans}
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Procedure Repit (VAR ch:char);
Var
cr:char;
rid:integer;
Begin {goagain}
textcolor(2);
write ('Do you wish to try again? Y/Nؤؤ ');
ch := readkey;
ch := upcase (ch);
charerrck (ch);
If (ch = 'N') then
begin
clrscr;
Title;
textcolor(37);
writeln;
writeln ('Thanks for playing WELL-HUNG....Bye!':58);
textcolor(11);
delay(4000);
end;
If (ch = 'Y') then
begin
writeln;
writeln;
end;
end; {goagain}
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
{’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’’}
Begin {main}
Title;
Repeat
AlreadyTried (used);
clrscr;
Write('Enter word that is to be guessed: ');
StringEntry(realword);
clrscr;
Write ('Do you need instuctions to play HANG-MAN (Y/N)?: ');
inst := readkey;
inst := upcase(inst);
Intro (inst);
GuessEntry (realword,used);
clrscr;
Repit (again);
Until (again = 'N');
end. {main}
( geocities.com/~franzglaser)