program hangman;
{plays one game of fortune hangman}
var
	WordSoFar, word, WrongList: string;
	numofwords, earnings, Totearn, SpinAmt,totalwords,rightwords,wrongwords : integer;
	quit : boolean;
	choice : char;
	wordlist : array[1..50] of string;
	
procedure LOADWORDS;
{loads the wordlist into the global arrray}
var
	counter : integer;
	Infile : text;
	
begin
	counter := 0;
	assign (Infile,'word.dat');
	reset (Infile);
	while not seekeof(Infile) do
		begin
			counter := counter + 1;
			readln(Infile,wordlist[counter]);
		end; {while}
		numofwords := counter;
end; {procedure LOADWORDS}
	
procedure SELECTWORD (var word: string);
{pick a word at random from the wordlist array}
var
	num: integer;
	
begin
	num := random(numofwords - 1) + 1;
	word := wordlist[num];
	wordlist[num]:= wordlist[numofwords];
	numofwords := numofwords - 1;
	
end; {procedure SELECTWORD}

procedure INITIALIZE (word : string; var WordSoFar,
					  Wronglist : string; var earnings : integer);
{procedure to initialize all the variables}

const null = '';
	  dash = '-';

var
	i : integer;

begin
	WordSoFar := null;
	for i := 1 to length(word) do
		WordSoFar := WordSoFar + dash;
	WrongList := null;
	earnings := 0;
end; {procedure INITIALIZE}

procedure GUESS_PROMPT (WordSoFar, WrongList : string;
						var SpinAmt: integer);
{print status of game and prompt for guesses}

begin
	writeln;
	SpinAmt := 100 * (random(5) + 1);
	writeln ('Word so far : ',WordSoFar);
	writeln ('   Incorrect guesses : ',WrongList);
	writeln ('   This guess is worth $ ',SpinAmt);
	write ('    Pick a letter ');
end; {procedure GUESS_PROMPT}

procedure PROCESS_GUESS (SpinAmt : integer; word : string;
						 var WordSoFar, WrongList : string;
						 var earnings : integer);
{ read in a player's guess and process it}
var
	i, count : integer;
	guess : char;
	
begin
	readln (guess);
	count := 0;
	for i := 1 to length (word) do
		if word[i] = guess then
			begin
				WordSoFar[i] := guess;
				count := count + 1;
			end;
		if count > 0 then
			earnings := earnings + count * SpinAmt
		else
			WrongList := WrongList + guess;
end; {procedure PROCESS_GUESS}

begin {main}

	quit := false;
	rightwords := 0;
	wrongwords := 0;
	totalwords := 0;
	Totearn := 0;
	
	LOADWORDS;
	Writeln ('****************************************************');
	writeln ('*                                                  *');
	writeln ('*               Pascal Hangman                     *');
	writeln ('*               by Jeff Wilson 1994                *');
	writeln ('*                                                  *');
	writeln ('****************************************************');
	writeln ('              Press CR Key to continue');
	readln;
	writeln;
	writeln;
	writeln;
	writeln;
	
		
	while not quit do
		begin
			randomize;
			SELECTWORD (word);
			INITIALIZE (word, WordSoFar, WrongList, earnings);
			repeat
				GUESS_PROMPT (WordSoFar, WrongList, SpinAmt);
				PROCESS_GUESS (SpinAmt, word, WordSoFar, WrongList, earnings);
			until (length(WrongList) = 8) or (word = WordSoFar);
			if word = WordSoFar then
				begin
					writeln;
					writeln;
					writeln ('Congratulations! You Won $ ',earnings);
					writeln ('The full word is : ',word);
					rightwords := rightwords + 1;
					Totearn := earnings;
					writeln ('Your total earnings to date are $ ',Totearn);
				end
			else
				begin
					writeln;
					writeln;
					writeln ('Sorry, you lost. The word was ',word);
					wrongwords := wrongwords + 1;
					writeln ('Your total earnings remain at $ ',Totearn);
				end; {if else}
			totalwords := totalwords + 1;	
			write ('Would you like another go Y/N : ');
			readln (choice);
			choice := upcase(choice);
			if (choice = 'N')or (numofwords < 1) then
				quit :=true;
		end; {while}
		writeln;
		writeln;
		writeln ('You have got ',rightwords,' correct and ',wrongwords,
				 ' wrong for a total of ',totalwords,' words attempted.');
		writeln ('You earned $ ',Totearn,' for this effort.');
		writeln;
		writeln('Press the CR key to continue');
		readln;
end.