{*
* Program Title: Wumpus
* Written by: Gregory Yob
* More BASIC Computer Games
* Edited by David H. Ahl
*
* Translated into Pascal by Paul H. Gilliam from the
* BASIC programs 'WUMPUS 1' and 'WUMPUS 2'
*
* This game will teach you how to play it.
* Happy wumpus hunting!
*
* 29 June 1980 -corrected minor logic bugs.
* 29 June 1980 -Modified for Pascal/Z v3.0
* Pascal/Z does not allow jumps out
* of Procedures/Functions [A practice
* I fully agree with!]
* Donated July, 1980
*}
Program Wumpus;
LABEL 99; { Fatal error }
CONST
default = 80;
{--- define your screen parameters ---}
s_beglin = 1; { first line } (* ADM-3A Screen parameters *)
s_endlin = 23; { last line }
s_begcol = 1; { first column }
s_endcol = 80; { last column }
TYPE
alfa = STRING 10; { just the right size }
Dstring = STRING default;
str0 = STRING 0;
str255 = STRING 255;
room = 1 .. 20;
tunnel = 1 .. 3;
VAR
arrowcount : integer;
bell : char;
cave : array[room, tunnel] of room;
cursorhome, { cursor controls }
cursorup,
cursordown,
cursorleft,
cursorright,
clearscreen,
escape : char;
fatal_error : boolean;
i, j : integer; { global indexers }
initlocate : array[1..6] of room;
Procedure KEYIN(VAR cix: char); external;
(*---Direct Keyboard input of a single char---*)
Function RANDOM(limit: integer): real; external;
(*---returns a real number from 0.0 to limit---*)
Function randroom : room; { 1..20 }
begin
randroom := trunc(random(20)) + 1
end { randroom };
Function randtunnel : tunnel; { 1..3 }
begin
randtunnel := trunc(random(3)) + 1
end { randtunnel };
Function wumpmove : integer;
var i : integer;
begin
i := trunc(random(4)) + 1;
If i > 3 then
wumpmove := -1
Else
wumpmove := i;
end { wumpmove };
Function QUIRY(sign: Dstring): boolean;
var ch: char;
begin
writeln;
Repeat
write(sign);
KEYIN(ch);writeln(ch);
writeln;
Until ch IN ['Y', 'y', 'N', 'n'];
QUIRY := ch in ['n', 'N'];
end;
Procedure Instruct;
{*
* Attempts to read in an external file to instruct the player
* as to how to play the game.
* Instruct will pause for console input whenever it finds the
* string "$pause" in the first position of a line in the line.
*}
var line : Dstring;
Ifile : text;
ch : char;
Procedure ShowInstructions;
begin
CLEAR;
Readln(Ifile,line);
while not eof(Ifile) do
begin
If (line = '$pause') or (line = '$PAUSE') then
begin
Clearline(s_endlin);
write('Press <sp> to continue.');KEYIN(ch);
CLEAR;
end
Else
writeln(line);
readln(Ifile,line);
end;{ While }
End{ShowInstructions};
begin { instruct }
CLEAR;
write('Do you want instructions on how to play? ');
KEYIN(ch);Writeln(ch);
writeln;
If (ch='y') or (ch='Y') then
begin
RESET('WUMPUS.DOC',Ifile);
If not EOF(Ifile) then
ShowInstructions
Else
begin
writeln;
writeln('Sorry, instructions not availiable yet.');
end;
end
End{of instruct};
Procedure getacave;
LABEL 9;{ABORT}
var
i : room; { 1..20 }
j : tunnel; { 1..3 }
k : integer;
CAVENAME : STRING 5;
LINE : Dstring;
cavein : text;
ch : char;
begin
cavename := 'CAVE ';
Repeat
Writeln;
write(bell, 'Enter cave #(0-5) ');
KEYIN(ch);Writeln(ch);
Until ch in ['0'..'5'];
cavename[5] := ch;
(* OPEN file "cavename" for Read assign cavein *)
RESET(cavename,cavein);
fatal_error := EOF(cavein);
If fatal_error then {ABORT}
begin
writeln;
writeln('Fatal error - file not found');
{ABORT}goto 9;
end;
writeln('reading ',cavename);
readln(cavein, line);
for i := 1 to 20 do
for j := 1 to 3 do read(cavein,cave[i,j]);
writeln;
writeln('You are in ',line);
writeln;
9:{ABORT}
End{ of getacave }{ CLOSE(cavein) };
Procedure initsetup;
var locatesunique : boolean;
i, j : integer;
begin
Repeat
for i := 1 to 6 do initlocate[i] := randroom;
locatesunique := true;
i := 1;
while locatesunique and (i <= 6) do
begin
j := 1;
while locatesunique and (j <= 6) do
begin
If (initlocate[i] = initlocate[j]) and (j <> i) then
locatesunique := false
Else
j := j + 1;
end;
i := i + 1
end
Until locatesunique
End { initsetup };
Procedure HuntTheWumpus;
CONST Title = 'Hunt the Wumpus';
TYPE long = real;
VAR i : integer;
game : (inprogress, youlost, youwon);
locate : array[1..6] of room;
Procedure warnings;
var location, i, j: integer;
begin
writeln;
location := locate[1];
for i := 2 to 6 do
begin
for j := 1 to 3 do
begin
If cave[location,j] = locate[i] then
case i of
2: writeln('I smell a Wumpus!');
3, 4: writeln('I feel a draft!');
5, 6: writeln('Bats nearby!');
End{case};
end{ for j };
end{ for i };
writeln('You are in Room ',location:2);
write('Tunnels lead to ');
for i := 1 to 3 do write(cave[location,i]:3);
writeln;
End { warnings };
Function WantToShoot : boolean;
LABEL 4;{EXIT}
var ch : char;
begin
Repeat
writeln;
write('Shoot or move (s-m) <esc>');
KEYIN(ch);writeln;
If ch = escape then
begin
game := youlost;
{ EXIT(HuntTheWumpus) } goto 4;
end;
If ch = 'l' then
begin
write('you = ',locate[1]:3, ' ':8);
write(' wumpus = ',locate[2]:3);
writeln(' pits = ',locate[3]:3,',',locate[4]:3);
writeln(' bats = ',locate[5]:3,',',locate[6]:3);
writeln
end;
Until ch in ['m', 'M', 's', 'S'];
WantToShoot := ch in ['S', 's'];
4:{EXIT}
End { WantToShoot };
Procedure movewumpus;
var i : integer;
begin
i := wumpmove;
If i > 0 then locate[2] := cave[locate[2],i];
If locate[1] = locate[2] then
begin
writeln('Tsk Tsk Tsk - Wumpus got you!');
game := youlost
end;
End { movewumpus };
Function lint( s : alfa;
var l : long) : integer;
LABEL 3;{EXIT}
var
i, j : integer;
negitive : boolean;
ch : char;
begin
j := 0;
l := 0;
lint := -1;
negitive := false;
for i := 1 to length(s) do
begin
ch := s[i];
If ch in ['0'..'9'] then
begin
j := j + 1;
If j > 36 then
begin lint := -2; {EXIT(lint)}goto 3 end;
l := l * 10 + (ord(ch) - ord('0'))
end
Else
If ch = '-' then
begin If negitive then {EXIT(lint)}goto 3 end
Else {EXIT(lint)}goto 3;
end;{ FOR }
If l > maxint then
lint := j
Else
lint := 0;
If negitive then l := -l;
3:{EXIT}
end{lint};
Procedure doshot;
var
path : array[1..5] of integer;
rooms, i, j, arrow : integer;
roomok, targethit : boolean;
l : long;
ans : alfa;
begin
{ program the arrow }
Repeat
write('No. of rooms (1-5) ');
readln(ans);
i := lint(ans, l);
rooms := trunc(l);
Until (i = 0) and (rooms >= 1) and (rooms <= 5);
for i := 1 to rooms do
begin
Repeat
roomok := true;
write('Room # ');
readln(ans);
j := lint(ans, l);
roomok := (j = 0) and (l > 0) and (l < 21);
path[i] := trunc(l);
If i > 2 then
If path[i] = path[i-2] then
begin
writeln('Arrows aren''t that crooked - try another room');
roomok := false;
end;
If not roomok then write(bell);
Until roomok;
end;
{ shoot the arrow }
arrowcount := arrowcount - 1;
I := 1;
arrow := locate[1];
Repeat
roomok := false;
for j := 1 to 3 do
If cave[arrow,j] = path[i] then roomok := true;
If roomok then
arrow := path[i]
Else
arrow := randroom;
If arrow = locate[1] then
begin
writeln('OUCH! Arrow got YOU!');
game := youlost
end
Else
If arrow = locate[2] then
begin
writeln('Aha! You got the Wumpus!');
game := youwon
end;
i := i + 1;
Until (i > rooms) or (game <> inprogress);
Case game of
inprogress: begin
If arrowcount=0 then
begin
writeln('Out of arrows!!');
game := youlost;
end
Else
writeln('missed');
MoveWumpus;
end;
youwon: {dummy};
youlost: MoveWumpus
end{of Case};
end { doshot };
Procedure domove;
var
room, i, location : integer;
roomok, movefinished : boolean;
l : long;
ans : alfa;
begin
location := locate[1];
Repeat
write('Where to? ');
readln(ans);
roomok := false;
i := lint(ans, l);
room := trunc(l);
If i = 0 then
begin
for i := 1 to 3 do
If room = cave[location,i] then roomok := true;
If room = location then roomok := true;
end;{ If i=0 }
If not roomok then writeln('Not possible');
Until roomok;
location := room;
Repeat
locate[1] := location;
movefinished := true;
If location = locate[2] then
begin
writeln('... OOPS! Bumped a Wumpus');
movewumpus
end;
If game = inprogress then
If (location = locate[3]) or (location = locate[4]) then
begin
writeln('YYYIIEEEE . . . Fell in a pit!');
game := youlost
end
Else
If (location = locate[5]) or (location = locate[6]) then
begin
writeln('ZAP -- Super bat snatch! Elsewhereville for you!');
movefinished := false;
location := randroom
end;
Until movefinished;
end { do move };
begin { HuntTheWumpus }
arrowcount := 5;
for i := 1 to 6 do locate[i] := initlocate[i];
game := inprogress;
writeln;
writeln(Title);
writeln;
{} REPEAT
warnings;
Case WantToShoot of
TRUE: If game<>youlost then Doshot;
FALSE: If game<>youlost then DoMove
End{of case};
{} Until game<>inprogress;
If game = youwon then
writeln('Hee Hee Hee - The Wumpus''ll getcha next time.')
Else
writeln('Ha Ha Ha - You lose!');
end{ huntthewumpus };
Function newsetup: boolean;
begin
newsetup := QUIRY('Same setup (y-n) ');
end;
Function newcave: boolean;
begin
newcave := QUIRY('Same cave (y-n) ');
end;
Function alldone : boolean;
begin
alldone := Quiry('Play again (y-n) ');
end;
begin{ Main Program Wumpus }
terminit;
Instruct;
Repeat
getacave;
If fatal_error then{ABORT}goto 99;
Repeat
initsetup;
Repeat
HuntTheWumpus;
Until newsetup;
Until newcave
Until alldone;
99:{ABORT}
End{of Wumpus}.
