1
2(********************************************************************)
3(*                                                                  *)
4(*  wumpus.sd7    Hunt the Wumpus game                              *)
5(*  Copyright (C) 2004, 2005  Thomas Mertes                         *)
6(*                                                                  *)
7(*  This program is free software; you can redistribute it and/or   *)
8(*  modify it under the terms of the GNU General Public License as  *)
9(*  published by the Free Software Foundation; either version 2 of  *)
10(*  the License, or (at your option) any later version.             *)
11(*                                                                  *)
12(*  This program is distributed in the hope that it will be useful, *)
13(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
14(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
15(*  GNU General Public License for more details.                    *)
16(*                                                                  *)
17(*  You should have received a copy of the GNU General Public       *)
18(*  License along with this program; if not, write to the           *)
19(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
20(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
21(*                                                                  *)
22(********************************************************************)
23
24
25$ include "seed7_05.s7i";
26  include "stdio.s7i";
27
28const integer: PLAYER is 1;
29const integer: WUMPUS is 2;
30const integer: PIT1   is 3;
31const integer: PIT2   is 4;
32const integer: BATS1  is 5;
33const integer: BATS2  is 6;
34const integer: LOCS   is 6;
35
36var integer: arrows is 0;
37
38var array integer: loc is LOCS times 0;
39var array integer: save is LOCS times 0; (* locations *)
40
41const type: status_type is new enum
42    PLAYING, WIN, LOSE
43  end enum;
44
45var status_type: game_status is PLAYING;
46
47const array array integer: cave is [](
48    []( 2,  5,  8),
49    []( 1,  3, 10),
50    []( 2,  4, 12),
51    []( 3,  5, 14),
52    []( 1,  4,  6),
53    []( 5,  7, 15),
54    []( 6,  8, 17),
55    []( 1,  7,  9),
56    []( 8, 10, 18),
57    []( 2,  9, 11),
58    [](10, 12, 19),
59    []( 3, 11, 13),
60    [](12, 14, 20),
61    []( 4, 13, 15),
62    []( 6, 14, 16),
63    [](15, 17, 20),
64    []( 7, 16, 18),
65    []( 9, 17, 19),
66    [](11, 18, 20),
67    [](13, 16, 19));
68
69
70const proc: print_instructions is func
71  begin
72    writeln("Welcome to 'Hunt the Wumpus'");
73    writeln("  The Wumpus lives in a cave of 20 rooms. Each room");
74    writeln("has 3 tunnels leading to other rooms. (look at a");
75    writeln("dodecahedron to see how this works-if you don't know");
76    writeln("what a dodecahedron is, ask someone)");
77    writeln;
78    writeln("     Hazards:");
79    writeln(" Bottomless pits - Two rooms have bottomless pits in them");
80    writeln("     If you go there, you fall into the pit (& lose!)");
81    writeln(" Super bats - Two other rooms have super bats. If you");
82    writeln("     go there, a bat graps you and takes you to some other");
83    writeln("     room at random. (which may be troublesome)");
84    write("Type return to continue ");
85    readln;
86    writeln("     Wumpus:");
87    writeln(" The Wumpus is not bothered by hazards (he has sucker");
88    writeln(" feet and is too big for a bat to lift).  Usually");
89    writeln(" he is asleep.  Two things wake him up: You shooting an");
90    writeln(" arrow or you entering his room.");
91    writeln("     If the Wumpus wakes he moves (P=.75) one room");
92    writeln(" or stays still (P=.25).  after that, if he is where you");
93    writeln(" are, he eats you up and you lose!");
94    writeln;
95    writeln("     You:");
96    writeln(" Each turn you may move or shoot a crooked arrow");
97    writeln("   Moving:  You can move one room (thru one tunnel)");
98    writeln("   Arrows:  You have 5 arrows.  You lose when you run out");
99    writeln("   Each arrow can go from 1 to 5 rooms. You aim by telling");
100    writeln("   the computer the room #s you want the arrow to go to.");
101    writeln("   If the arrow can't go that way (if no tunnel) It moves");
102    writeln("   at random to the next room.");
103    writeln("     If the arrow hits the wumpus, you win.");
104    writeln("     If the arrow hits you, you lose.");
105    write("Type return to continue ");
106    readln;
107    writeln("    Warnings:");
108    writeln("     When you are one room away from a Wumpus or hazard,");
109    writeln("     The computer says:");
110    writeln(" Wumpus:  'I smell a Wumpus'");
111    writeln(" Bat   :  'Bats nearby'");
112    writeln(" Pit   :  'I feel a draft'");
113    writeln;
114  end func;
115
116
117const proc: check_hazards is func
118  local
119    var integer: number is 0;
120    var integer: room is 0;
121  begin
122    writeln;
123
124    for number range 1 to 3 do
125      room := cave[loc[PLAYER]][number];
126      if room = loc[WUMPUS] then
127        writeln("I smell a Wumpus!");
128      elsif room = loc[PIT1] or room = loc[PIT2] then
129        writeln("I feel a draft");
130      elsif room = loc[BATS1] or room = loc[BATS2] then
131        writeln("Bats nearby!");
132      end if;
133    end for;
134
135    writeln("You are in room " <& loc[PLAYER]);
136
137    write("Tunnels lead to");
138    for number range 1 to 3 do
139      write(" " <& cave[loc[PLAYER]][number]);
140    end for;
141    writeln;
142    writeln;
143  end func;
144
145
146const func boolean: shoot_or_move is func
147  result
148    var boolean: do_shoot is FALSE;
149  local
150    var char: ch is ' ';
151  begin
152    repeat
153      write("Shoot or move (S-M) ");
154      readln(ch);
155      ch := upper(ch);
156    until ch = 'S' or ch = 'M';
157
158    if ch = 'S' then
159      do_shoot := TRUE;
160    elsif ch = 'M' then
161      do_shoot := FALSE;
162    end if;
163  end func;
164
165
166const proc: check_shot (in integer: arrow_location) is func
167  begin
168    if arrow_location = loc[WUMPUS] then
169      writeln("AHA! YOU GOT THE WUMPUS!");
170      game_status := WIN;
171    elsif arrow_location = loc[PLAYER] then
172      writeln("OUCH! ARROW GOT YOU!");
173      game_status := LOSE;
174    end if;
175  end func;
176
177
178const proc: move_wumpus is func
179  local
180    var integer: k is 0;
181  begin
182    k := rand(1, 4);
183    if k < 3 then
184      loc[WUMPUS] := cave[loc[WUMPUS]][k];
185    end if;
186    if loc[WUMPUS] = loc[PLAYER] then
187      writeln("TSK TSK TSK - WUMPUS GOT YOU!");
188      game_status := LOSE;
189    end if;
190  end func;
191
192
193const proc: shoot_arrow is func
194  local
195    var integer: number_of_rooms is 0;
196    var integer: number is 0;
197    var integer: number2 is 0;
198    var integer: arrow_location is 0;
199    var array integer: path is 5 times 0;
200  begin
201    repeat
202      write("No. of rooms (1-5) ");
203      readln(number_of_rooms);
204    until number_of_rooms >= 1 and number_of_rooms <= 5;
205
206    for number range 1 to number_of_rooms do
207      repeat
208        write("Room # ");
209        readln(path[number]);
210        if number >= 3 and path[number] = path[number - 2] then
211          writeln("ARROWS AREN'T THAT CROOKED - TRY ANOTHER ROOM");
212        end if;
213      until number < 3 or path[number] <> path[number - 2];
214    end for;
215
216    arrow_location := loc[PLAYER];
217    number := 1;
218    game_status := PLAYING;
219
220    while number <= number_of_rooms and game_status = PLAYING do
221      number2 := 1;
222      while number2 <= 3 and
223          cave[arrow_location][number2] <> path[number] do
224        incr(number2);
225      end while;
226      if number <= 3 then
227        arrow_location := path[number];
228      else
229        arrow_location := cave[arrow_location][rand(1, 3)];
230      end if;
231      check_shot(arrow_location);
232      incr(number);
233    end while;
234
235    if game_status = PLAYING then
236      writeln("MISSED");
237      move_wumpus();
238      decr(arrows);
239      if arrows <= 0 then
240        game_status := LOSE;
241      end if;
242    end if;
243  end func;
244
245
246const func integer: readmove is func
247  result
248    var integer: new_loc is 0;
249  local
250    var boolean: goodmove is FALSE;
251    var integer: number is 0;
252  begin
253    goodmove := FALSE;
254    repeat
255      repeat
256        write("Where to ");
257        readln(new_loc);
258      until new_loc >= 1 and new_loc <= 20;
259
260      for number range 1 to 3 do
261        if cave[loc[PLAYER]][number] = new_loc then
262          goodmove := TRUE;
263        end if;
264      end for;
265
266      if not goodmove then
267        if new_loc = loc[PLAYER] then
268          goodmove := TRUE;
269        else
270          writeln("Not possible -");
271        end if;
272      end if;
273    until goodmove;
274  end func;
275
276
277const proc: move_player is func
278  local
279    var integer: player_location is 0;
280    var boolean: super_bat_snatch is FALSE;
281  begin
282    game_status := PLAYING;
283    player_location := readmove;
284    repeat
285      super_bat_snatch := FALSE;
286      loc[PLAYER] := player_location;
287      if player_location = loc[WUMPUS] then
288        writeln("... OOPS! BUMPED A WUMPUS!");
289        move_wumpus();
290      elsif player_location = loc[PIT1] or player_location = loc[PIT2] then
291        writeln("YYYYIIIIEEEE . . . FELL IN PIT");
292        game_status := LOSE;
293      elsif player_location = loc[BATS1] or player_location = loc[BATS2] then
294        writeln("ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!");
295        player_location := rand(1, 20);
296        super_bat_snatch := TRUE;
297      end if;
298    until not super_bat_snatch;
299  end func;
300
301
302const proc: init_setup is func
303  local
304    var integer: j is 0;
305    var integer: k is 0;
306    var boolean: already_used is FALSE;
307  begin
308    for j range 1 to LOCS do
309      repeat
310        already_used := FALSE;
311        loc[j] := rand(1, 20);
312        for k range 1 to pred(j) do
313          if loc[j] = loc[k] then
314            already_used := TRUE;
315          end if;
316        end for;
317      until not already_used;
318      save[j] := loc[j];
319    end for;
320  end func;
321
322
323const proc: main is func
324  local
325    var char: command is ' ';
326    var integer: j is 0;
327  begin
328    writeln;
329    writeln("WUMPUS - Hunt the wumpus in a cave of 20 rooms.");
330    writeln;
331    write("Instructions (Y/N)? ");
332    readln(command);
333    command := upper(command);
334    if command = 'Y' then
335      print_instructions();
336    end if;
337
338    repeat
339      init_setup;
340
341      repeat
342        arrows := 5;
343
344        writeln("HUNT THE WUMPUS");
345        repeat
346          check_hazards();
347          if shoot_or_move then
348            shoot_arrow();
349          else
350            move_player();
351          end if;
352        until game_status <> PLAYING;
353
354        if game_status = LOSE then
355          writeln("Ha Ha Ha - You lose!");
356        else
357          writeln("Hee Hee Hee - The wumpus'll get you next time!!");
358        end if;
359
360        for j range 1 to LOCS do
361          loc[j] := save[j];
362        end for;
363
364        repeat
365          write("Same setup (Y/N) ");
366          readln(command);
367          command := upper(command);
368        until command in {'Y', 'N', 'Q'};
369      until command <> 'Y';
370    until command = 'Q'
371  end func;
372