2009 material

1. Program Hangman;                    { Daniel Neville }
2. {
3.  
4.   this code should be used in conjunction with the Preliminary materials
5.   written by the AQA COMP1 Programmer Team
6.   developed in the Delphi 7 (Console Mode) programming environment (PASCAL)
7.   the DisplayMenu procedure has deliberately omitted a menu choice 3 and 4 }
8.  
9. {APPTYPE CONSOLE}
10.  
11. Uses
12.   {SysUtils,
13.   StrUtils;}
14. wincrt,
15. strings;         {changed to work on our pascal compiler CT}
16.  
17. Type
18.   TGuessStatusArray = Array[1..20] Of Char;
19.   TLettersGuessedArray = Array[1..26] Of Char;
20. Var
21.   NewPhrase : String;
22.   PhraseHasBeenSet : Boolean;
23.   PhraseGuessed : Boolean;
24.   Choice : Integer;
25.   GuessStatusArray : TGuessStatusArray;
26.   LettersGuessedArray : TLettersGuessedArray;
27.   NextGuessedLetter : Char;
28.   Index : Integer;
29.   CompleteGuess : String;
30.   DataFile : Text;
31.   RandomPhrases : Array[1..100] of String;
32.   NumberOfPhrases : Integer;
33.   Guesses : Integer;
34.  
35. Procedure DisplayMenu;
36.   Begin
37.     Writeln('__________________________________');
38.     Writeln;
39.     Writeln('1. SETTER - Makes new word/phrase');
40.     Writeln;
41.     Writeln('2. USER - Next letter guess');
42.     Writeln;
43.     Writeln('3. GUESSES - Make a full word guess');
44.     Writeln;
45.     Writeln('4. RANDOM PHRASE - Choose a random phrase from the text file.');
46.     Writeln;                                          
47.     Writeln('5. End');                      
48.     Writeln;                              
49.   End;                                                    
50.  
51.  
52.      
53.  
54. Function GetNewPhrase : String;
55.   Var
56.     PhraseOK : Boolean;
57.     ThisNewPhrase : String;
58.  
59.   Begin
60.     Repeat
61.       Write('Key in new phrase ...(letters and any Spaces) ');
62.       Readln(ThisNewPhrase);
63.       For Index := 1 to Length(ThisNewPhrase) do
64.         ThisNewPhrase[Index] := UpCase(ThisNewPhrase[Index]);  
65.       If Length(ThisNewPhrase) < 10
66.         Then
67.           Begin
68.             PhraseOK := False;
69.             Writeln('Not enough letters ... ');
70.             { possible further validation check(s) }
71.           End
72.         Else
73.           Begin
74.             PhraseOK := True;
75.             GetNewPhrase := ThisNewPhrase;
76.           End;
77.     Until PhraseOK = True;
78.   End;
79.  
80. Procedure SetUpGuessedLettersArray;
81.   Var
82.     Position : Integer;
83.   Begin
84.     For Position := 1 to 26 do
85.       LettersGuessedArray[Position] := '0';
86.   End;
87.  
88.  
89. Procedure SetUpGuessStatusArray(NewPhrase : String;
90.                                 Var GuessStatusArray : TGuessStatusArray);
91.   Var
92.     Position : Integer;
93.   Begin
94.     For Position := 1 To Length(NewPhrase)
95.       Do
96.         Begin
97.           If NewPhrase[Position] = ' '
98.             Then GuessStatusArray[Position] := ' '
99.             Else GuessStatusArray[Position] := '*';
100.         End;
101.   End;
102.  
103. Procedure DisplayCurrentStatus(PhraseLength : Byte;
104.                                GuessStatusArray : TGuessStatusArray);
105.   Var
106.     Position : Integer;
107.   Begin
108.     For Position := 1 To PhraseLength
109.       Do Write(GuessStatusArray[Position]);
110.     Writeln;
111.   End;
112.  
113. Function GetNextLetterGuess : Char;
114.   Var
115.     Position : Integer;
116.     GuessedLetter : Char;
117.  
118.   Begin
119.     Writeln;
120.     Write('Next guess ? ');
121.     Readln(GuessedLetter);
122.     GetNextLetterGuess := UpCase(GuessedLetter);
123.     LettersGuessedArray[Ord(UpCase(GuessedLetter))-64] := '1';
124.   End;
125.  
126.  
127. Function AllLettersGuessedCorrectly(GuessStatusArray: TGuessStatusArray;
128.                                     NewPhrase : String)  : Boolean;
129.   Var
130.     Position : Integer;
131.     MissingLetter : Boolean;
132.  
133.   Begin
134.     MissingLetter := False;
135.     Position := 1;
136.     Repeat
137.       If GuessStatusArray[Position] <> NewPhrase[Position]
138.         Then MissingLetter := True
139.         Else Position := Position+1;
140.     Until (MissingLetter = True) or (Position = Length(NewPhrase)+1);
141.  
142.     If MissingLetter = False
143.       Then AllLettersGuessedCorrectly := True
144.       Else AllLettersGuessedCorrectly := False;
145.   End;
146.  
147. Procedure SetUpTextFile(FileLocation : String; Var DataFile : Text);
148. Var
149.   S : String;
150.   I : Integer;    
151. Begin
152.   Assign(DataFile, 'N:\phrases.txt');
153.   Reset(DataFile);
154.   I := 0;
155.   While not EoF(DataFile) do begin
156.     Inc(I);
157.     ReadLn(DataFile, S);
158.     RandomPhrases[I] := S;
159.     NumberOfPhrases := I;
160.   End;
161.   Close(DataFile);
162. End;
163.  
164. Procedure ShowGuessedLetters;
165. Var
166.   I : Integer;
167. Begin
168.   For I := 1 to 26 do
169.     If(LettersGuessedArray[I] = '1') then
170.       Write(Chr(64 + I) , ' ');
171.   WriteLn;
172. End;
173.  
174. { Main program block starts here }
175. Begin
176.   Randomize;
177.   PhraseHasBeenSet := False;
178.   SetUpTextFile('N:\phrases.txt', DataFile);
179.   Repeat
180.     DisplayMenu;
181.     Write('Choice? ');
182.     Readln(Choice);
183.  
184.     If Choice = 1
185.       Then
186.         Begin
187.           NewPhrase := GetNewPhrase;
188.           SetUpGuessStatusArray(NewPhrase, GuessStatusArray);
189.           SetUpGuessedLettersArray;
190.           Guesses := 0;
191.           PhraseHasBeenSet := True;  
192.         End;      
193.  
194.     If Choice = 2
195.       Then        
196.         Begin
197.           If PhraseGuessed = True then
198.           Write('Phrase has already been guessed.')
199.           Else
200.           If PhraseHasBeenSet = True
201.             Then
202.               Begin
203.                 DisplayCurrentStatus(Length(NewPhrase), GuessStatusArray);
204.                 Write('Guesses so far: ', Guesses, ' --- Guessed letters: ');
205.                 ShowGuessedLetters;
206.                 NextGuessedLetter := UpCase(GetNextLetterGuess);
207.  
208.                 For Index := 1 To Length(NewPhrase)
209.                   Do
210.                     If NextGuessedLetter = NewPhrase[Index]
211.                       Then GuessStatusArray[Index] := NextGuessedLetter;
212.                 Inc(Guesses);
213.                 DisplayCurrentStatus(Length(NewPhrase), GuessStatusArray);
214.                 PhraseGuessed := AllLettersGuessedCorrectly(GuessStatusArray,NewPhrase);
215.                 If PhraseGuessed = True
216.                   Then Writeln('You have guessed correctly. Guesses used: ', Guesses);
217.               End
218.             Else Writeln('The setter has not specified the word/phrase ..');
219.         End;
220.  
221.     If Choice = 3                    
222.       Then
223.         Begin
224.           If PhraseGuessed = True then
225.           Write('Phrase has already been guessed.')
226.           Else
227.           If PhraseHasBeenSet = True
228.             Then
229.               Begin
230.                  Write('Enter your complete guess: ');
231.                  ReadLn(CompleteGuess);
232.                  For Index := 1 to Length(CompleteGuess) do
233.                    CompleteGuess[Index] := UpCase(CompleteGuess[Index]);
234.                  If(CompleteGuess = NewPhrase)
235.                    Then Begin
236.                      For Index := 1 to Length(NewPhrase) Do
237.                          GuessStatusArray[Index] := NewPhrase[Index];
238.                      PhraseGuessed := True;
239.                      WriteLn('You have guessed correctly. Guesses used: ', Guesses);
240.                      WriteLn;
241.                    End
242.                  else
243.                      WriteLn('Incorrect guess. Returning to menu...');
244.                      WriteLn;
245.               End
246.             Else Writeln('The setter has not specified the word/phrase ..');
247.         End;
248.  
249.     If Choice = 4 Then
250.     Begin
251.       NewPhrase := RandomPhrases[Random(NumberOfPhrases - 1) + 1];
252.         SetUpGuessStatusArray(NewPhrase, GuessStatusArray);
253.         SetUpGuessedLettersArray;
254.         Guesses := 0;
255.         PhraseHasBeenSet := True;
256.     End;  
257.        
258.     If (Choice = 5) And (PhraseGuessed = False)
259.       Then
260.         Begin
261.           Writeln('You have not completed this word/phrase...Press return to exit');
262.           Readln;
263.         End;
264.   Until Choice = 5;
265.  
266. DoneWinCRT;
267.  
268. End.