$ include "seed7_05.s7i";
include "keybd.s7i";
include "console.s7i";
include "editline.s7i";
include "wrinum.s7i";
const integer: SIZE_LABY is 8;
const integer: NUM_LEVELS is 8;
const integer: RESTRICTED_CONNECTION_COUNT is 5;
const integer: STAIRS_PER_LEVEL is 3;
const integer: THINGS_PER_LEVEL is 1;
const integer: VENDORS_PER_LEVEL is 1;
const integer: OCCURRENCES_PER_LEVEL is 1;
const integer: TRANSFERS_PER_LEVEL is 1;
const integer: ARMOR_STRENGTH_FACTOR is 7;
const type: speciesType is new enum
HOBBIT, ELF, HUMAN, DWARF
end enum;
const func string: str (in speciesType: species) is
return lower(literal(species));
enable_output(speciesType);
const type: directType is new enum
NORTH, SOUTH, EAST, WEST, UP, DOWN
end enum;
const func string: str (in directType: direct) is
return lower(literal(direct));
enable_output(directType);
const type: directSet is set of directType;
const type: objectType is new enum
NOOBJECT, LAMP, RUBY, NORNSTONE, PEARL, OPAL, GREENGEM, BLUEFLAME,
PALANTIR, SILMARIL, RUNESTAFF, ORBOFZOT
end enum;
const func string: str (in objectType: anObject) is
return [] ("nothing", "lamp", "ruby red", "norn Stone", "pale pearl",
"opal Eye", "green Gem", "blue Flame", "Palantir", "Silmaril",
"Runestaff", "*ORB OF ZOT*")[succ(ord(anObject))];
enable_output(objectType);
const type: objectSet is set of objectType;
const objectSet: treasureSet is {RUBY, NORNSTONE, PEARL, OPAL, GREENGEM,
BLUEFLAME, PALANTIR, SILMARIL};
const type: animateType is new enum
NOBODY, KOBOLD, ORC, WOLF, GOBLIN, OGRE, TROLL, BEAR,
MINOTAUR, GARGOYLE, CHIMERA, BALROG, DRAGON, VENDOR
end enum;
const func string: str (in animateType: anAnimate) is
return lower(literal(anAnimate));
enable_output(animateType);
const type: armorType is new enum
NOARMOR, LEATHER, CHAINMAIL, PLATE
end enum;
const func string: str (in armorType: anArmor) is
return anArmor = NOARMOR ? "no" : lower(literal(anArmor));
enable_output(armorType);
const type: weaponType is new enum
NOWEAPON, DAGGER, MACE, SWORD
end enum;
const func string: str (in weaponType: aWeapon) is
return aWeapon = NOWEAPON ? "no" : lower(literal(aWeapon));
enable_output(weaponType);
const type: commandType is new enum
ILLEGAL, GO_NORTH, GO_SOUTH, GO_EAST, GO_WEST, GO_UP, GO_DOWN, WAIT,
INVENTORY, HELP, LOOK, MAP, FLARE, USE_LAMP, ATTACK, CAST, BRIBE,
STATUS, OPEN, READ, GAZE, TELEPORT, DRINK, SELL, BUY, QUITCOMMAND
end enum;
const type: contentType is new enum
EMPTYROOM, ENTRANCE, EMPTYCHEST, CHESTWITHSKELETON, CLOSEDCHEST, ORB,
POOL, BOOK
end enum;
const type: transferType is new enum
NOTRANSFER, SINKHOLE, WARP
end enum;
const type: occurType is new enum
NOOCCURRENCE, LEECH, LETHARGY, FORGET, STEALARMOR, STEALWEAPON,
STEALLAMP, STEALFLARES, STEALTREASURE, FINDGOLD, FINDFLARES
end enum;
const type: playerType is new struct
var speciesType: species is HUMAN;
var boolean: isMale is TRUE;
var integer: strength is 2;
var integer: intelligence is 8;
var integer: dexterity is 14;
var integer: goldPieces is 10;
var armorType: armor is NOARMOR;
var integer: armorStrength is 0;
var weaponType: weapon is NOWEAPON;
var boolean: weaponBlocked is FALSE;
var integer: flares is 0;
var objectSet: possession is objectSet.value;
var integer: turns is 1;
var integer: mealHour is 0;
var boolean: living is TRUE;
var boolean: blind is FALSE;
var boolean: haveLeech is FALSE;
var boolean: lethargic is FALSE;
var boolean: forgetting is FALSE;
var boolean: leaveCastle is FALSE;
var boolean: quitDialog is FALSE;
var boolean: quitProgram is FALSE;
end struct;
const type: fightStateType is new struct
var integer: monsterCount is NUM_LEVELS * 12;
var boolean: angryVendors is FALSE;
var integer: webCount is 0;
var integer: aggressionOfMonster is 0;
var integer: monsterStrength is 0;
var boolean: monsterPresent is FALSE;
var boolean: monsterWillAttack is FALSE;
var boolean: bribed is FALSE;
end struct;
const type: roomType is new struct
var directSet: connections is {NORTH, SOUTH, EAST, WEST};
var transferType: transfer is NOTRANSFER;
var occurType: occurrence is NOOCCURRENCE;
var animateType: roomer is NOBODY;
var contentType: contents is EMPTYROOM;
var objectSet: objects is objectSet.value;
var boolean: visited is FALSE;
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
end struct;
const type: roomRef is sub object interface;
type_implements_interface(roomType, roomRef);
const proc: writePos (in roomRef: aRoom) is DYNAMIC;
const proc: enterRoom (inout roomRef: currentRoom, inout playerType: player,
inout fightStateType: fightState) is DYNAMIC;
const proc: incident (inout roomRef: currentRoom,
inout playerType: player) is DYNAMIC;
const proc: teleportTo (inout roomRef: currentRoom, inout playerType: player,
inout fightStateType: fightState) is DYNAMIC;
const proc: writeFightState (in roomRef: currentRoom, inout playerType: player,
inout fightStateType: fightState) is DYNAMIC;
const proc: executeCommand (inout roomRef: currentRoom, inout playerType: player,
inout fightStateType: fightState) is DYNAMIC;
const proc: removeFromRoom (inout roomRef: currentRoom,
in objectType: treasure) is DYNAMIC;
var integer: labyrinthNumber is 0;
var roomRef: currentRoomRef is roomType.value;
const type: objPlaceType is array [objectType] roomRef;
var objPlaceType: objPlace is objectType times roomType.value;
const type: labyrinthType is array array array roomType;
var labyrinthType: labyrinth is SIZE_LABY times SIZE_LABY times NUM_LEVELS times roomType.value;
const func integer: rangeLaby (in integer: number) is
return succ(pred(number) mod SIZE_LABY);
const func integer: rangeLevel (in integer: number) is
return succ(pred(number) mod NUM_LEVELS);
const func integer: range18 (in integer: number) is
return number <= 18 ? number: 18;
const func speciesType: rand (attr speciesType) is
return rand(speciesType.first, speciesType.last);
const func animateType: rand (attr animateType) is
return rand(KOBOLD, DRAGON);
const proc: startText is func
begin
writeln;
writeln;
writeln;
writeln("*" mult 78);
writeln;
writeln(" * * * THE WIZARD'S CASTLE * * *");
writeln(" Version 2.0");
writeln;
writeln(" Copyright");
writeln(" 1990 - 1994, 2004, 2007, 2008, 2011, 2013, 2021");
writeln(" Thomas Mertes");
writeln;
writeln("*" mult 78);
writeln;
writeln(" A long time ago, in the age of the old universal empire the mighty wizard");
writeln(" ZOT lived in a large subterranean castle, collecting a lot of fabulous");
writeln(" treasures during his long life. Feeling the sources of his vital power");
writeln(" draining away, he created a great orb of power the *ORB OF ZOT*. To hide it");
writeln(" from the cretins of the surface beyond, he hired a group of esurient");
writeln(" monsters to guard the *ORB OF ZOT*. From that time onward, many a bold youth");
writeln(" has ventured into the castle, losing his life in cruel and unimaginable");
writeln(" ways.");
writeln;
writeln("All right, bold one.");
end func;
const proc: writeHelp is func
begin
writeln;
writeln("*** WIZARD'S CASTLE COMMAND AND INFORMATION SUMMARY ***");
writeln;
writeln("The following commands are available:");
writeln;
writeln("H/ELP N/ORTH S/OUTH E/AST W/EST U/P D/OWN");
writeln("L/OOK I/NVENTORY M/AP ST/ATUS A/TTACK C/AST BR/IBE");
writeln("O/PEN R/EAD G/AZE T/ELEPORT DR/INK SE/LL B/UY");
writeln("F/LARE LA/AMP Q/UIT");
writeln;
writeln("The contents of rooms are as follows:");
writeln;
writeln(". = EMPTY ROOM D = WAY DOWN G = GOLD PIECES P = MAGIC POOL U = WAY UP");
writeln("B = BOOK E = EXIT M = MONSTER S = SINKHOLE V = VENDOR");
writeln("C = CHEST F = FLARES O = CRYSTAL ORB T = TREASURE W = WARP");
writeln;
writeln("The benefits of having treasures are:");
writeln;
writeln("ruby red - AVOID LETHARGY pale pearl - AVOID LEECH");
writeln("green gem - AVOID FORGETTING opal eye - CURES BLINDNESS");
writeln("blue flame - DISSOLVES BOOKS norn stone - NO BENEFIT");
writeln("palantir - NO BENEFIT silmaril - NO BENEFIT");
end func;
const proc: randomRoom (inout integer: xPos, inout integer: yPos,
inout integer: zPos) is func
begin
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
zPos := rand(1, NUM_LEVELS);
end func;
const proc: findUninhabitedRoom (inout integer: xPos, inout integer: yPos,
in integer: zPos) is func
begin
repeat
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
until labyrinth[xPos][yPos][zPos].roomer = NOBODY and
labyrinth[xPos][yPos][zPos].contents <> ENTRANCE;
end func;
const proc: findEmptyRoom (inout integer: xPos, inout integer: yPos,
in integer: zPos) is func
begin
repeat
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
until labyrinth[xPos][yPos][zPos].transfer = NOTRANSFER and
labyrinth[xPos][yPos][zPos].roomer = NOBODY and
labyrinth[xPos][yPos][zPos].contents = EMPTYROOM and
labyrinth[xPos][yPos][zPos].occurrence = NOOCCURRENCE and
labyrinth[xPos][yPos][zPos].objects = objectSet.value;
end func;
const proc: initRoom (inout roomType: aRoom, in integer: xPos, in integer: yPos,
in integer: zPos) is func
begin
aRoom := roomType.value;
aRoom.xPos := xPos;
aRoom.yPos := yPos;
aRoom.zPos := zPos;
end func;
const proc: initEntrance (inout roomType: aRoom) is func
begin
aRoom.connections := {NORTH, SOUTH, EAST, WEST};
aRoom.contents := ENTRANCE;
aRoom.visited := TRUE;
end func;
const proc: initRoomConnections is func
local
const array directSet: restrictedConnections is [] (
{ SOUTH, EAST, WEST},
{NORTH, EAST, WEST},
{NORTH, SOUTH, WEST},
{NORTH, SOUTH, EAST },
{NORTH, SOUTH },
{NORTH, EAST },
{NORTH, WEST},
{ SOUTH, EAST },
{ SOUTH, WEST},
{ EAST, WEST});
var directSet: connections is directSet.value;
var integer: count is 0;
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
begin
for xPos range 1 to SIZE_LABY do
for yPos range 1 to SIZE_LABY do
for zPos range 1 to NUM_LEVELS do
initRoom(labyrinth[xPos][yPos][zPos], xPos, yPos, zPos);
end for;
write(".");
flush(OUT);
end for;
end for;
writeln;
for count range 1 to RESTRICTED_CONNECTION_COUNT do
for connections range restrictedConnections do
randomRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].connections := connections;
end for;
end for;
for zPos range 1 to NUM_LEVELS do
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
labyrinth[xPos][yPos][zPos].connections := {rand(NORTH, WEST)};
end for;
initEntrance(labyrinth[rangeLaby(4)][1][1]);
for zPos range 1 to pred(NUM_LEVELS) do
for count range 1 to STAIRS_PER_LEVEL do
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
incl(labyrinth[xPos][yPos][zPos].connections, DOWN);
incl(labyrinth[xPos][yPos][succ(zPos)].connections, UP);
end for;
end for;
end func;
const proc: initRoomProperties is func
local
var integer: count is 0;
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
var contentType: content is EMPTYROOM;
var animateType: animate is NOBODY;
var objectType: treasure is NOOBJECT;
var occurType: occurrence is NOOCCURRENCE;
begin
for zPos range 1 to NUM_LEVELS do
for count range 1 to THINGS_PER_LEVEL do
for content range [](CLOSEDCHEST, ORB, POOL, BOOK) do
findEmptyRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].contents := content;
end for;
end for;
end for;
for zPos range 1 to NUM_LEVELS do
for animate range KOBOLD to DRAGON do
findUninhabitedRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].roomer := animate;
end for;
for count range 1 to VENDORS_PER_LEVEL do
findUninhabitedRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].roomer := VENDOR;
end for;
end for;
for treasure range treasureSet do
randomRoom(xPos, yPos, zPos);
incl(labyrinth[xPos][yPos][zPos].objects, treasure);
objPlace[treasure] := labyrinth[xPos][yPos][zPos];
end for;
for zPos range 1 to NUM_LEVELS do
for count range 1 to OCCURRENCES_PER_LEVEL do
for occurrence range FINDGOLD to FINDFLARES do
xPos := rand(1, SIZE_LABY);
yPos := rand(1, SIZE_LABY);
labyrinth[xPos][yPos][zPos].occurrence := occurrence;
end for;
end for;
end for;
for occurrence range LEECH to STEALTREASURE do
randomRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].occurrence := occurrence;
end for;
end func;
const proc: initRoomTransfers is func
local
var integer: count is 0;
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
begin
zPos := rand(1, NUM_LEVELS);
findUninhabitedRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].roomer := rand(animateType);
incl(labyrinth[xPos][yPos][zPos].objects, RUNESTAFF);
objPlace[RUNESTAFF] := labyrinth[xPos][yPos][zPos];
zPos := rand(1, NUM_LEVELS);
findEmptyRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].transfer := WARP;
labyrinth[xPos][yPos][zPos].objects := {ORBOFZOT};
objPlace[ORBOFZOT] := labyrinth[xPos][yPos][zPos];
for zPos range 1 to NUM_LEVELS do
for count range 1 to TRANSFERS_PER_LEVEL do
findEmptyRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].transfer := SINKHOLE;
findEmptyRoom(xPos, yPos, zPos);
labyrinth[xPos][yPos][zPos].transfer := WARP;
end for;
end for;
end func;
const func string: aOrAn (in string: word) is func
result
var string: wordWithIndefiniteArticle is "";
begin
if word <> "" then
if upper(word[1]) in {'A', 'E', 'I', 'O', 'U'} then
wordWithIndefiniteArticle := "an " & word;
else
wordWithIndefiniteArticle := "a " & word;
end if;
end if;
end func;
const proc: DECLARE_A_OR_AN (in type: aType) is func
begin
const func string: aOrAn (in aType: aValue) is
return aOrAn(str(aValue));
end func;
DECLARE_A_OR_AN(speciesType);
DECLARE_A_OR_AN(weaponType);
DECLARE_A_OR_AN(animateType);
const func string: anyFood is
return rand([]("sandwiches", "stew", "soup", "burgers", "roast",
"filet", "tace", "pie"));
const func string: anyAdjective is
return rand([]("a large", "a strange", "an ugly", "an enormous",
"a forbidding", "a horrible", "an exotic",
"an ordinary"));
const func string: numberName (in integer: number) is
return number <= 20 ? str(ENGLISH, number) : str(number);
const func string: sexName (in boolean: isMale) is
return isMale ? "male" : "female";
const func string: titleName (in boolean: isMale) is
return isMale ? "sir" : "madam";
const func integer: countOwnedObjects (in playerType: player) is
return card(player.possession);
const func integer: countOwnedTreasures (in playerType: player) is
return card(player.possession & treasureSet);
const func objectType: ownedTreasure (in playerType: player) is
return rand(player.possession & treasureSet);
const func integer: treasureNumber (in objectType: treasure) is
return succ(ord(treasure) - ord(RUBY));
const proc: removeFromRoom (inout roomType: currentRoom,
in objectType: treasure) is func
begin
excl(currentRoom.objects, treasure);
end func;
const proc: writePos (in roomType: aRoom) is func
begin
writeln("(" <& aRoom.xPos <& ", " <& aRoom.yPos <& ") Level: " <& aRoom.zPos);
end func;
const proc: findGoldPieces (inout playerType: player, in integer: limit) is func
local
var integer: goldPieces is 0;
begin
goldPieces := rand(2, limit);
player.goldPieces +:= goldPieces;
writeln(numberName(goldPieces) <& " gold pieces!");
writeln("You now have " <& numberName(player.goldPieces) <& " GP'S.");
end func;
const proc: findFlares (inout playerType: player, in integer: limit) is func
local
var integer: flares is 0;
begin
flares := rand(2, limit);
player.flares +:= flares;
writeln(numberName(flares) <& " flares. You now have " <&
numberName(player.flares) <& " flares.");
end func;
const func string: roomAdjective (in integer: roomId) is
return [0]("", "luxurious ", "expensive ", "wonderful ", "good ",
"worn out ", "fine ", "moss-grown ", "old ", "figured ",
"patterned ")[roomId rem 11];
const func integer: roomIdInLevel (in roomType: aRoom) is
return 64 * pred(labyrinthNumber) + 8 * pred(aRoom.xPos) + pred(aRoom.yPos);
const func integer: roomId (in roomType: aRoom) is
return 8 * roomIdInLevel(aRoom) + pred(aRoom.zPos);
const proc: writeRoomDescription (in roomType: aRoom) is func
local
var integer: roomId is 0;
begin
if aRoom.contents = ENTRANCE then
writeln("the entrance hall. To the North the castle can be left.");
else
roomId := roomId(aRoom);
case roomId rem 23 of
when { 0}: write("a ");
when { 1}: write("a gigantic ");
when { 2}: write("a large ");
when { 3}: write("a long ");
when { 4}: write("a small ");
when { 5}: write("a narrow ");
when { 6}: write("a tiny ");
when { 7}: write("a round ");
when { 8}: write("an octagonal ");
when { 9}: write("a hexagonal ");
when {10}: write("a whitewashed ");
when {11}: write("a blue painted ");
when {12}: write("a black painted ");
when {13}: write("a red painted ");
when {14}: write("a green painted ");
when {15}: write("a brown painted ");
when {16}: write("a cold ");
when {17}: write("a windy ");
when {18}: write("a draughty ");
when {19}: write("an antique ");
when {20}: write("an old ");
when {21}: write("a dusty ");
when {22}: write("a dilapidated ");
end case;
case roomId rem 7 of
when {0}: write("dome ");
when {1}: write("hall ");
when {2}: write("room ");
when {3}: write("chamber ");
when {4}: write("corridor ");
when {5}: write("cavern ");
when {6}: write("tunnel ");
end case;
case roomId rem 17 of
when { 0}: write("with wooden planking.");
when { 1}: write("blasted out of the rock.");
when { 2}: write("that must have been a cellar.");
when { 3}: write("with all walls made out of bricks.");
when { 4}: write("that has a massive pillar in the centre.");
when { 5}: write("with an enormous chandelier hanging down.");
when { 6}: write("which has a lot of paintings on the walls.");
when { 7}: write("which is totally made from rustless steel.");
when { 8}: write("with lots of statues high above your head.");
when { 9}: write("with " <& aOrAn(roomAdjective(roomId)) <& "parquet.");
when {10}: write("with " <& aOrAn(roomAdjective(roomId)) <&
"stone-floor.");
when {11}: write("with " <& aOrAn(roomAdjective(roomId)) <&
"rug lying on the floor.");
when {12}: write("with " <& aOrAn(roomAdjective(roomId)) <&
"fresco at the wall.");
when {13}: write("with " <& roomAdjective(roomId) <&
"walls made from granite.");
when {14}: write("with " <& roomAdjective(roomId) <&
"panelling at the walls.");
when {15}: write("with " <& roomAdjective(roomId) <&
"paintings at the ceiling.");
when {16}: write("with a floor made out of " <&
roomAdjective(roomId) <& "marble.");
end case;
writeln;
end if;
end func;
const proc: writeConnections (in roomType: aRoom) is func
local
var integer: roomIdInLevel is 0;
var integer: numConnections is 0;
var directType: direction is NORTH;
begin
if UP in aRoom.connections or
DOWN in aRoom.connections then
roomIdInLevel := roomIdInLevel(aRoom);
case roomIdInLevel rem 9 of
when {0}: write("At one wall are steps ");
when {1}: write("Here is a shaky rope ladder ");
when {2}: write("Here is a forbidding staircase ");
when {3}: write("Here you find a steel-ladder ");
when {4}: write("Here you find a very old staircase ");
when {5}: write("There is a narrow spiral staircase ");
when {6}: write("There is a rotten ladder ");
when {7}: write("There you find a wooden staircase ");
when {8}: write("There you find stone steps ");
end case;
case roomIdInLevel rem 2 of
when {0}: write("going ");
when {1}: write("leading ");
end case;
if UP in aRoom.connections then
if DOWN in aRoom.connections then
write("up and down");
else
write("up");
end if;
else
write("down");
end if;
case roomId(aRoom) rem 5 of
when {0}: writeln(" into deep darkness.");
when {1}: writeln(" into darkness.");
when {2}: writeln("ward into darkness.");
when {3}: writeln("ward.");
when {4}: writeln(".");
end case;
end if;
numConnections := card(aRoom.connections - {UP, DOWN});
if numConnections = 1 or numConnections = 2 then
write("The room can " <&
card(aRoom.connections) = 1 ? "only " : "" <&
"be left to the ");
for direction range NORTH to WEST do
if direction in aRoom.connections then
write(direction);
decr(numConnections);
if numConnections = 1 then
write(" and ");
end if;
end if;
end for;
writeln(".");
elsif numConnections = 3 then
write("There is no way to the ");
for direction range NORTH to WEST do
if direction not in aRoom.connections then
write(direction);
end if;
end for;
writeln(".");
end if;
end func;
const proc: writeThings (in roomType: aRoom) is func
begin
case aRoom.contents of
when {EMPTYCHEST}: writeln("Here is an empty chest.");
when {CHESTWITHSKELETON}: writeln("Here is an open chest with a skeleton in it.");
when {CLOSEDCHEST}: writeln("Here is a chest.");
when {ORB}: writeln("Here is a crystal orb.");
when {POOL}: writeln("Here is a pool.");
when {BOOK}: writeln("Here is a book.");
end case;
end func;
const proc: writeAnimates (in roomType: aRoom) is func
begin
if aRoom.roomer <> NOBODY then
writeln("In this room is " <& aOrAn(aRoom.roomer) <& ".");
end if;
end func;
const proc: writeObjects (in roomType: aRoom) is func
local
var integer: count is 0;
var integer: number is 0;
var objectType: obj is NOOBJECT;
begin
if aRoom.roomer = NOBODY then
count := card(aRoom.objects);
if count > 0 then
write("This room contains ");
for obj range aRoom.objects do
incr(number);
if number = 1 then
write("the ");
elsif number = count then
write(" and the ");
else
write(", the ");
end if;
write(obj);
end for;
writeln(".");
end if;
end if;
end func;
const proc: writeRoomDetails (in roomType: currentRoom) is func
begin
writeConnections(currentRoom);
writeThings(currentRoom);
writeAnimates(currentRoom);
writeObjects(currentRoom);
end func;
const proc: look (inout roomType: currentRoom, in playerType: player) is func
begin
writeln;
write("You are in ");
if player.blind then
writeln("a room.");
else
writeRoomDescription(currentRoom);
end if;
writeRoomDetails(currentRoom);
end func;
const func char: readChar is func
result
var char: ch is '\0;';
local
var string: stri is "";
begin
stri := upper(getln(IN));
if stri <> "" then
ch := stri[1];
end if;
end func;
const func char: readChoice is func
result
var char: ch is ' ';
begin
writeln;
write("Your choice? ");
ch := readChar();
end func;
const proc: readNumber (inout integer: number, inout boolean: okay,
inout boolean: quit) is func
local
var string: stri is "";
begin
number := 0;
okay := TRUE;
stri := upper(getln(IN));
if stri <> "" then
if stri = "Q" then
okay := FALSE;
quit := TRUE;
else
block
number := integer(stri);
exception
catch RANGE_ERROR:
okay := FALSE;
end block;
end if;
end if;
end func;
const proc: readSpecies (inout playerType: player) is func
local
var boolean: okay is TRUE;
begin
if not player.quitDialog then
repeat
okay := TRUE;
writeln;
writeln("You may be an elf, dwarf, man, or hobbit.");
case readChoice() of
when {'H'}: player.species := HOBBIT;
when {'E'}: player.species := ELF;
when {'M'}: player.species := HUMAN;
when {'D'}: player.species := DWARF;
when {'Q'}: player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** That was incorrect. Please type E, D, M, H or Q.");
end case;
until okay;
end if;
end func;
const proc: readSex (inout playerType: player) is func
local
var boolean: okay is TRUE;
begin
if not player.quitDialog then
repeat
okay := TRUE;
writeln;
write("Which sex do you prefer? ");
case readChar() of
when {'M'}: player.isMale := TRUE;
when {'F'}: player.isMale := FALSE;
when {'Q'}: player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** Cute " <& player.species <& ", real cute. Try M, F or Q.");
end case;
until okay;
end if;
end func;
const proc: riseAttribute (inout playerType: player, in string: attrName,
inout integer: attribute, inout integer: otherPoints) is func
local
var integer: points is 0;
var boolean: okay is TRUE;
begin
repeat
writeln;
write("How many points do you wish to add to your " <& attrName <& "? ");
readNumber(points, okay, player.quitDialog);
if not player.quitDialog then
if okay then
if points > otherPoints then
writeln;
writeln("** Dear " <& player.species <& ", you have only " <&
numberName(otherPoints) <& " point" <&
otherPoints <> 1 ? "s." : ".");
okay := FALSE;
end if;
else
writeln;
writeln("** Would you please be so kind to type a number or q, " <&
player.species <& ".");
end if;
end if;
until okay or player.quitDialog;
if okay then
attribute +:= points;
otherPoints -:= points;
end if;
end func;
const proc: readAttributes (inout playerType: player) is func
local
var integer: otherPoints is 0;
begin
if not player.quitDialog then
player.strength := 4 + 2 * ord(player.species);
player.intelligence := 8;
player.dexterity := 12 - 2 * ord(player.species);
if player.species = HOBBIT then
otherPoints := 4;
else
otherPoints := 8;
end if;
writeln;
writeln("Ok, " <& player.species <& ", you have the following attributes:");
writeln("STRENGTH = " <& player.strength <&
" INTELLIGENCE = " <& player.intelligence <&
" DEXTERITY = " <& player.dexterity);
writeln("and " <& otherPoints <& " other points to allocate as you wish.");
riseAttribute(player, "strength", player.strength, otherPoints);
if not player.quitDialog and otherPoints > 0 then
riseAttribute(player, "intelligence", player.intelligence, otherPoints);
if not player.quitDialog and otherPoints > 0 then
riseAttribute(player, "dexterity", player.dexterity, otherPoints);
end if;
end if;
if not player.quitDialog and otherPoints > 0 then
writeln;
write("I am sure that you can never use the saved ");
if otherPoints = 1 then
writeln("point.");
else
writeln(numberName(otherPoints) <& " points.");
end if;
end if;
end if;
end func;
const proc: buyAttribute (inout playerType: player, in string: attrName,
inout integer: attribute, in integer: price) is func
local
var char: ch is ' ';
var boolean: okay is TRUE;
begin
if not player.quitDialog and player.goldPieces >= price then
repeat
repeat
okay := TRUE;
writeln;
writeln("Your " <& attrName <& " is now " <& attribute <&
" and you have " <& player.goldPieces <& " GP'S.");
write("Do you want to buy a potion of " <& attrName <&
" for " <& price <& " GP'S? ");
ch := readChar();
case ch of
when {'Y'}:
player.goldPieces -:= price;
attribute := range18(attribute + rand(1, 6));
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** Please answer Y, N or Q.");
end case;
until okay;
until ch <> 'Y' or player.goldPieces < price;
if ch <> 'Q' and player.goldPieces < price then
writeln;
writeln("Your " <& attrName <& " is now " <& attribute <& ".");
end if;
end if;
end func;
const proc: buyArmor (inout playerType: player, in integer: priceOfPlate,
in integer: priceOfChainmail, in integer: priceOfLeather) is func
local
var char: ch is ' ';
var boolean: okay is TRUE;
begin
if not player.quitDialog and player.goldPieces >= priceOfLeather then
writeln;
writeln("Ok, " <& player.species <& ", you have " <& player.goldPieces <&
" gold pieces (GP'S) and " <& player.armor <& " armor.");
repeat
okay := TRUE;
writeln("These are the types of armor you can buy:");
writeln;
if player.goldPieces >= priceOfPlate then
writeln(" P/LATE " <& priceOfPlate lpad 4 <& " GP'S");
end if;
if player.goldPieces >= priceOfChainmail then
writeln(" C/HAINMAIL " <& priceOfChainmail lpad 4 <& " GP'S");
end if;
writeln(" L/EATHER " <& priceOfLeather lpad 4 <& " GP'S");
writeln(" N/OTHING 0 GP'S");
ch := readChoice();
if (ch <> 'P' or player.goldPieces < priceOfPlate) and
(ch <> 'C' or player.goldPieces < priceOfChainmail) and
ch not in {'L', 'N', 'Q'} then
okay := FALSE;
writeln;
writeln("** Are you " <& aOrAn(player.species) <& " or " <&
aOrAn(rand(animateType)) <& "?");
writeln;
end if;
until okay;
case ch of
when {'P'}:
player.armor := PLATE;
player.armorStrength := ord(player.armor) * ARMOR_STRENGTH_FACTOR;
player.goldPieces -:= priceOfPlate;
when {'C'}:
player.armor := CHAINMAIL;
player.armorStrength := ord(player.armor) * ARMOR_STRENGTH_FACTOR;
player.goldPieces -:= priceOfChainmail;
when {'L'}:
player.armor := LEATHER;
player.armorStrength := ord(player.armor) * ARMOR_STRENGTH_FACTOR;
player.goldPieces -:= priceOfLeather;
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
end case;
end if;
end func;
const proc: buyWeapon (inout playerType: player, in integer: priceOfSword,
in integer: priceOfMace, in integer: priceOfDagger) is func
local
var char: ch is ' ';
var boolean: okay is TRUE;
begin
if not player.quitDialog and player.goldPieces >= priceOfDagger then
writeln;
write("Ok, ");
if player.armor <> NOARMOR then
write("bold ");
end if;
write(player.species <& ", you have " <& player.goldPieces <&
" GP'S left and ");
if player.weapon = NOWEAPON then
writeln("no weapon.");
else
writeln(aOrAn(player.weapon) <& ".");
end if;
repeat
okay := TRUE;
writeln("These are the types of weapons you can buy:");
writeln;
if player.goldPieces >= priceOfSword then
writeln(" S/WORD " <& priceOfSword lpad 4 <& " GP'S");
end if;
if player.goldPieces >= priceOfMace then
writeln(" M/ACE " <& priceOfMace lpad 4 <& " GP'S");
end if;
writeln(" D/AGGER " <& priceOfDagger lpad 4 <& " GP'S");
writeln(" N/OTHING 0 GP'S");
ch := readChoice();
if (ch <> 'S' or player.goldPieces < priceOfSword) and
(ch <> 'M' or player.goldPieces < priceOfMace) and
ch not in {'D', 'N', 'Q'} then
okay := FALSE;
writeln;
writeln("** Is your intelligence really " <&
numberName(player.intelligence) <& "?");
writeln;
end if;
until okay;
case ch of
when {'S'}:
player.weapon := SWORD;
player.goldPieces -:= priceOfSword;
when {'M'}:
player.weapon := MACE;
player.goldPieces -:= priceOfMace;
when {'D'}:
player.weapon := DAGGER;
player.goldPieces -:= priceOfDagger;
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
end case;
end if;
end func;
const proc: buyLamp (inout playerType: player, in integer: price) is func
local
var boolean: okay is TRUE;
begin
if not player.quitDialog and LAMP not in player.possession and
player.goldPieces >= price then
repeat
okay := TRUE;
writeln;
write("Do you want to buy a lamp for " <& price <& " GP'S? ");
case readChar() of
when {'Y'}:
if price > 10 then
writeln;
writeln("It's guaranteed to outlive you.");
end if;
incl(player.possession, LAMP);
player.goldPieces -:= price;
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** Please answer Y, N or Q.");
end case;
until okay;
end if;
end func;
const proc: buyFlares (inout playerType: player) is func
local
var integer: flares is 0;
var boolean: okay is TRUE;
begin
if not player.quitDialog and player.goldPieces >= 1 then
writeln;
writeln("Ok, " <& player.species <& ", you have " <& player.goldPieces <&
" GP'S left.");
repeat
writeln;
write("Five flares cost 1 GP. How many do you want? ");
readNumber(flares, okay, player.quitDialog);
if not player.quitDialog then
if okay then
if flares > 5 * player.goldPieces then
writeln;
writeln("** You can afford only " <& 5 * player.goldPieces <& ".");
okay := FALSE;
end if;
else
writeln;
writeln("** If you don't want any, just type 0 (zero).");
end if;
end if;
until okay or player.quitDialog;
if okay then
player.flares +:= flares;
player.goldPieces -:= (flares + 4) div 5;
end if;
end if;
end func;
const proc: buyTreasures (inout playerType: player) is func
local
var objectType: treasure is NOOBJECT;
var integer: treasureNumber is 0;
var integer: price is 0;
var boolean: okay is TRUE;
begin
for treasure range treasureSet do
if not player.quitDialog and treasure not in player.possession then
treasureNumber := treasureNumber(treasure);
price := 125 * treasureNumber + rand(1, 250) +
250 * pred(rand(1, treasureNumber));
if price <= player.goldPieces then
repeat
okay := TRUE;
writeln;
write("Do you want to buy the " <& treasure <&
" for " <& price <& " GP'S? ");
case readChar() of
when {'Y'}:
removeFromRoom(objPlace[treasure], treasure);
incl(player.possession, treasure);
player.goldPieces -:= price;
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** Please answer Y, N or Q.");
end case;
until okay;
end if;
end if;
end for;
end func;
const proc: buy (in roomType: currentRoom, inout playerType: player) is func
begin
if currentRoom.roomer <> VENDOR then
writeln;
writeln("** You can only buy from a vendor!");
elsif player.goldPieces < 100 then
writeln;
case rand(1, 14) of
when { 1}: writeln("I do not play with funny money.");
when { 2}: writeln("You need more gold pieces to trade.");
when { 3}: writeln("You haven't got enough cash on hand.");
when { 4}: writeln("Earn money and then come and try again.");
when { 5}: writeln("You need hard currency to trade with me.");
when { 6}: writeln("In capitalism real money is needed for trading.");
when { 7}: writeln("Your dungeon express card - You left home without it.");
when { 8}: writeln("I don't give alms, " <& player.species <& ".");
when { 9}: writeln("You're too poor to trade, " <& player.species <& ".");
when {10}: writeln("I don't trade with a beggar, " <& player.species <& ".");
when {11}: writeln("Even " <& aOrAn(rand(animateType)) <&
" knows that money is needed for trading.");
when {12}: writeln("With " <& numberName(player.goldPieces) <&
" GP'S no trade can be done.");
when {13}: writeln("It's typical for " <& sexName(player.isMale) <&
" " <& player.species <&
"s, that they want to trade without enough money.");
when {14}: writeln("Sorry " <& titleName(player.isMale) <&
", I'm afraid I don't give credit.");
end case;
else
player.quitDialog := FALSE;
buyArmor(player, 200, 150, 125);
buyWeapon(player, 200, 150, 125);
buyAttribute(player, "strength", player.strength, 100);
buyAttribute(player, "intelligence", player.intelligence, 100);
buyAttribute(player, "dexterity", player.dexterity, 100);
buyLamp(player, 100);
buyTreasures(player);
end if;
end func;
const proc: sellTreasures (inout roomType: currentRoom,
inout playerType: player) is func
local
var objectType: treasure is NOOBJECT;
var integer: treasureNumber is 0;
var integer: price is 0;
var boolean: okay is TRUE;
begin
for treasure range treasureSet | {RUNESTAFF, ORBOFZOT} do
if not player.quitDialog and treasure in player.possession then
treasureNumber := treasureNumber(treasure);
price := rand(1, 150) + 150 * pred(rand(1, treasureNumber));
repeat
okay := TRUE;
writeln;
write("Do you want to sell the " <& treasure <&
" for " <& price <& " GP'S? ");
case readChar() of
when {'Y'}:
excl(player.possession, treasure);
incl(currentRoom.objects, treasure);
objPlace[treasure] := currentRoom;
player.goldPieces +:= price;
when {'N'}: noop;
when {'Q'}:
player.quitDialog := TRUE;
otherwise:
okay := FALSE;
writeln;
writeln("** Please answer Y, N or Q.");
end case;
until okay;
end if;
end for;
end func;
const proc: sell (inout roomType: currentRoom, inout playerType: player) is func
begin
if currentRoom.roomer <> VENDOR then
writeln;
writeln("** You can only sell to a vendor!");
elsif countOwnedTreasures(player) = 0 then
writeln;
writeln("** You have nothing to offer!");
else
player.quitDialog := FALSE;
sellTreasures(currentRoom, player);
end if;
end func;
const proc: checkArmor (inout playerType: player, in integer: strike) is func
local
var integer: damage is 0;
begin
if player.armor = NOARMOR then
damage := strike;
else
if strike < ord(player.armor) then
damage := 0;
player.armorStrength -:= strike;
else
damage := strike - ord(player.armor);
player.armorStrength -:= ord(player.armor);
end if;
if player.armorStrength < 0 then
player.armorStrength := 0;
player.armor := NOARMOR;
writeln;
writeln("YOUR ARMOR HAS BEEN DESTROYED . . . GOOD LUCK!");
end if;
end if;
player.strength -:= damage;
end func;
const proc: vendorDies (in roomType: currentRoom,
inout playerType: player) is func
local
var objectType: treasure is NOOBJECT;
begin
writeln;
writeln("You get all his wares:");
writeln(" plate armor");
player.armor := PLATE;
player.armorStrength := ord(player.armor) * ARMOR_STRENGTH_FACTOR;
writeln(" a sword");
player.weapon := SWORD;
writeln(" a strength potion");
player.strength := range18(player.strength + rand(1, 6));
writeln(" an intelligence potion");
player.intelligence := range18(player.intelligence + rand(1, 6));
writeln(" a dexterity potion");
player.dexterity := range18(player.dexterity + rand(1, 6));
if LAMP not in player.possession then
writeln(" a lamp");
incl(player.possession, LAMP);
end if;
for treasure range currentRoom.objects do
writeln(" the " <& treasure);
end for;
end func;
const proc: monsterDies (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var animateType: monster is NOBODY;
var objectType: treasure is NOOBJECT;
begin
monster := currentRoom.roomer;
fightState.monsterPresent := FALSE;
writeln;
writeln("The " <& monster <& " lies dead at your feet!");
if monster in {WOLF, BEAR, CHIMERA, BALROG, DRAGON} and
player.mealHour + 60 <= player.turns then
writeln;
writeln("You spend an hour eating " <& monster <& " " <& anyFood() <& ".");
player.mealHour := player.turns;
end if;
if monster = VENDOR then
vendorDies(currentRoom, player);
else
for treasure range currentRoom.objects do
writeln("\a");
writeln("Great Zot! You've found the " <& treasure <& "!");
end for;
decr(fightState.monsterCount);
end if;
player.possession |:= currentRoom.objects;
currentRoom.objects := objectSet.value;
writeln;
write("You get his hoard of ");
findGoldPieces(player, 99);
currentRoom.roomer := NOBODY;
end func;
const proc: monsterAttacks (in animateType: monster, inout playerType: player,
inout fightStateType: fightState) is func
begin
if fightState.webCount > 0 then
decr(fightState.webCount);
if fightState.webCount = 0 then
writeln;
writeln("The web just broke!");
end if;
end if;
writeln;
write("The " <& monster);
if fightState.webCount > 0 then
writeln(" is stuck and can't attack now!");
elsif player.dexterity >= rand(3, 21) + 3 * ord(player.blind) then
writeln(" attacks! What luck, he missed you!");
else
writeln(" attacks! Ouch! He hit you!");
checkArmor(player, fightState.aggressionOfMonster);
player.living := player.strength >= 1;
end if;
end func;
const proc: attackMonster (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var animateType: monster is NOBODY;
begin
monster := currentRoom.roomer;
if player.weapon = NOWEAPON then
writeln;
writeln("** Pounding on " <& aOrAn(monster) <& " won't hurt it!");
elsif player.weaponBlocked then
writeln;
writeln("** You can't beat it to death with a book!");
elsif player.dexterity < rand(1, 20) + (3 * ord(player.blind)) then
writeln;
writeln("You missed, too bad!");
else
writeln;
writeln("You hit the evil " <& monster <& ".");
fightState.monsterStrength -:= ord(player.weapon);
if monster in {GARGOYLE, DRAGON} then
if rand(1, 8) = 1 then
writeln;
writeln("OH NO! Your " <& player.weapon <& " broke!");
player.weapon := NOWEAPON;
end if;
end if;
if fightState.monsterStrength <= 0 then
monsterDies(currentRoom, player, fightState);
end if;
end if;
end func;
const proc: castSpell (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var integer: damage is 0;
var char: ch is ' ';
begin
writeln;
write("Which spell (web, fireball, deathspell)? ");
ch := readChar();
writeln;
if ch = 'W' then
decr(player.strength);
fightState.webCount := rand(2, 9);
player.living := player.strength >= 1;
elsif ch = 'F' then
decr(player.strength);
decr(player.intelligence);
if player.intelligence < 1 or player.strength < 1 then
player.living := FALSE;
else
damage := rand(2, 14);
writeln;
writeln("It does " <& damage <& " points worth of damage.");
fightState.monsterStrength -:= damage;
if fightState.monsterStrength <= 0 then
monsterDies(currentRoom, player, fightState);
end if;
end if;
elsif ch = 'D' then
write("DEATH . . . ");
if player.intelligence < rand(16, 19) then
writeln("YOURS!");
player.intelligence := 0;
player.living := FALSE;
else
writeln("HIS!");
fightState.monsterStrength := 0;
monsterDies(currentRoom, player, fightState);
end if;
else
writeln("** Try one of the options given.");
end if;
end func;
const proc: bribeMonster (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var objectType: treasure is NOOBJECT;
var char: ch is ' ';
var boolean: okay is TRUE;
begin
fightState.bribed := FALSE;
if countOwnedTreasures(player) = 0 then
writeln;
writeln("All I want is your life!");
else
treasure := ownedTreasure(player);
repeat
okay := TRUE;
writeln;
write("I want the " <& treasure <& ". Will you give it to me? ");
ch := readChar();
if not ch in {'Y', 'N', 'Q'} then
okay := FALSE;
writeln;
writeln("** Please answer yes or no.");
end if;
until okay;
if ch = 'Y' then
excl(player.possession, treasure);
incl(currentRoom.objects, treasure);
objPlace[treasure] := currentRoom;
writeln;
writeln("Ok, just don't tell anyone else.");
if currentRoom.roomer = VENDOR then
fightState.monsterPresent := FALSE;
fightState.angryVendors := FALSE;
end if;
fightState.bribed := TRUE;
end if;
end if;
end func;
const proc: meetMonster (in roomType: currentRoom, in playerType: player,
inout fightStateType: fightState) is func
local
var animateType: monster is NOBODY;
begin
monster := currentRoom.roomer;
fightState.monsterPresent := TRUE;
fightState.bribed := FALSE;
fightState.webCount := 0;
fightState.aggressionOfMonster := 1 + ord(monster) div 2;
fightState.monsterStrength := ord(monster) + 2;
if monster = VENDOR and not fightState.angryVendors then
writeln;
writeln("You'll be sorry that you did that!");
fightState.angryVendors := TRUE;
else
writeln("You may attack or retreat.");
if countOwnedTreasures(player) <> 0 then
writeln("You can also attempt a bribe.");
end if;
if player.intelligence >= 15 then
writeln("You can also cast a spell.");
end if;
end if;
if (player.lethargic and RUBY not in player.possession) or
player.blind or player.dexterity < rand(1, 18) then
fightState.monsterWillAttack := TRUE;
else
fightState.monsterWillAttack := FALSE;
end if;
end func;
const proc: retreatFromMonster (in roomType: currentRoom,
inout playerType: player, inout fightStateType: fightState) is func
local
var animateType: monster is NOBODY;
begin
if fightState.monsterPresent then
if not fightState.bribed then
monster := currentRoom.roomer;
monsterAttacks(monster, player, fightState);
if player.living then
writeln;
case rand(1, 7) of
when {1}: writeln("You fake a blow and escape.");
when {2}: writeln("You have escaped by turning and running.");
when {3}: writeln("You jump to the left and escape to the right.");
when {4}: writeln("What a furious trick. You escaped by doing nothing.");
when {5}: writeln("The " <& monster <& " stumbled and you escaped.");
when {6}: writeln("You escaped by jumping over the " <& monster <& "!");
when {7}: writeln("You are lucky, you have escaped because the " <&
monster <& " was diverted by a cry.");
end case;
end if;
end if;
fightState.monsterPresent := FALSE;
end if;
end func;
const proc: attack (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
if currentRoom.roomer = NOBODY then
writeln;
writeln("** There is nothing that can be attacked!");
else
fightState.bribed := FALSE;
if not fightState.monsterPresent then
meetMonster(currentRoom, player, fightState);
end if;
attackMonster(currentRoom, player, fightState);
fightState.monsterWillAttack := TRUE;
end if;
end func;
const proc: cast (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
if currentRoom.roomer = NOBODY then
writeln;
writeln("** There is nothing that can be casted!");
elsif player.intelligence < 15 then
writeln;
writeln("** Your intelligence must be 15 or more to cast a spell!");
else
fightState.bribed := FALSE;
if not fightState.monsterPresent then
meetMonster(currentRoom, player, fightState);
end if;
castSpell(currentRoom, player, fightState);
fightState.monsterWillAttack := TRUE;
end if;
end func;
const proc: bribe (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
if currentRoom.roomer = NOBODY then
writeln;
writeln("** There is nobody that can be bribed!");
elsif fightState.monsterPresent then
if fightState.bribed then
writeln;
writeln("I will not give you more than your life.");
else
bribeMonster(currentRoom, player, fightState);
end if;
else
writeln;
writeln("** That does not work.");
end if;
end func;
const proc: meetVendor (inout roomType: currentRoom, in playerType: player,
inout fightStateType: fightState) is func
begin
if fightState.angryVendors then
meetMonster(currentRoom, player, fightState);
else
writeln("You may buy from, sell to, attack, or ignore the vendor.");
end if;
end func;
const proc: enterRoom (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
currentRoom.visited := TRUE;
writeln;
write("You are in ");
if player.blind then
writeln("a new room.");
else
writeRoomDescription(currentRoom);
end if;
case currentRoom.transfer of
when {NOTRANSFER}:
writeRoomDetails(currentRoom);
if currentRoom.roomer = VENDOR then
meetVendor(currentRoom, player, fightState);
elsif currentRoom.roomer <> NOBODY then
meetMonster(currentRoom, player, fightState);
else
if currentRoom.objects <> objectSet.value then
writeln;
if card(currentRoom.objects) = 1 then
writeln("It's now yours!");
else
writeln("They're yours now!");
end if;
player.possession |:= currentRoom.objects;
currentRoom.objects := objectSet.value;
end if;
end if;
when {SINKHOLE}:
case roomId(currentRoom) rem 5 of
when {0}: writeln("Here you fall into a sinkhole.");
when {1}: writeln("Here a trap-door opens under your feet and \
\you fall down.");
when {2}: writeln("You have stepped into a pitfall.");
when {3}: writeln("You step on an open trap-door and fall down.");
when {4}: writeln("You fall into a hole hidden on the ground.");
end case;
currentRoomRef := labyrinth[currentRoom.xPos]
[currentRoom.yPos]
[rangeLevel(succ(currentRoom.zPos))];
enterRoom(currentRoomRef, player, fightState);
when {WARP}:
write("This room contains a warp. You have been transferred to ");
currentRoomRef := labyrinth[rand(1, SIZE_LABY)]
[rand(1, SIZE_LABY)]
[rand(1, NUM_LEVELS)];
writePos(currentRoomRef);
enterRoom(currentRoomRef, player, fightState);
end case;
end func;
const proc: readCoordinate (inout playerType: player, in char: coordname,
inout integer: coordinate, in integer: coordinateMax) is func
local
var boolean: okay is TRUE;
begin
if not player.quitDialog then
repeat
writeln;
write("Please enter the " <& coordname <& "-coordinate? ");
readNumber(coordinate, okay, player.quitDialog);
if okay then
if coordinate < 1 or coordinate > coordinateMax then
writeln;
writeln("** Try a number from 1 to " <& coordinateMax <& ".");
okay := FALSE;
end if;
elsif not player.quitDialog then
writeln;
writeln("** Would you please be so kind to type a digit, " <&
player.species <& ".");
end if;
until okay or player.quitDialog;
end if;
end func;
const proc: teleportTo (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
if ORBOFZOT in currentRoom.objects then
excl(player.possession, RUNESTAFF);
player.possession |:= currentRoom.objects;
currentRoom.objects := objectSet.value;
currentRoom.visited := TRUE;
currentRoom.transfer := NOTRANSFER;
enterRoom(currentRoom, player, fightState);
writeln;
writeln("Great unmitigated Zot!");
writeln;
writeln("You just found the *ORB OF ZOT*!");
writeln;
writeln("The Runestaff has disappeared!");
else
enterRoom(currentRoom, player, fightState);
end if;
end func;
const proc: teleport (in roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
begin
if RUNESTAFF not in player.possession then
writeln;
writeln("** You can't teleport without the Runestaff!");
else
player.quitDialog := FALSE;
readCoordinate(player, 'x', xPos, SIZE_LABY);
readCoordinate(player, 'y', yPos, SIZE_LABY);
readCoordinate(player, 'z', zPos, NUM_LEVELS);
if player.quitDialog then
writeln;
writeln("** The Runesaff needs three coordinates, " <&
player.species <& ".");
else
fightState.monsterPresent := FALSE;
currentRoomRef := labyrinth[xPos][yPos][zPos];
teleportTo(currentRoomRef, player, fightState);
end if;
end if;
end func;
const proc: go (in roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState, in directType: direction) is func
local
const array [directType] integer: delta_x is [directType]( 0, 0, 1, -1, 0, 0);
const array [directType] integer: delta_y is [directType](-1, 1, 0, 0, 0, 0);
const array [directType] integer: delta_z is [directType]( 0, 0, 0, 0, -1, 1);
begin
if direction = NORTH and currentRoom.contents = ENTRANCE then
writeln;
write("Do you really want to leave the castle? ");
if readChar() <> 'Y' then
writeln;
writeln("** Then don't say that you do!");
else
retreatFromMonster(currentRoom, player, fightState);
player.leaveCastle := TRUE;
end if;
elsif direction in currentRoom.connections then
retreatFromMonster(currentRoom, player, fightState);
if player.living then
currentRoomRef := labyrinth
[ rangeLaby(currentRoom.xPos + delta_x[direction])]
[ rangeLaby(currentRoom.yPos + delta_y[direction])]
[rangeLevel(currentRoom.zPos + delta_z[direction])];
enterRoom(currentRoomRef, player, fightState);
end if;
else
writeln;
writeln("** There is no way in this direction!");
end if;
end func;
const proc: status (in roomType: currentRoom, in playerType: player) is func
begin
writeln;
if not player.blind then
write("You are at ");
writePos(currentRoom);
writeln;
end if;
writeln("STRENGTH = " <& player.strength <&
" INTELLIGENCE = " <& player.intelligence <&
" DEXTERITY = " <& player.dexterity);
writeln("OBJECTS = " <& countOwnedObjects(player) <&
" FLARES = " <& player.flares <&
" GOLD PIECES = " <& player.goldPieces);
writeln("weapon = " <& player.weapon <& " armor = " <& player.armor);
end func;
const proc: listInventory (in playerType: player) is func
local
var boolean: anythinglisted is FALSE;
var objectType: obj is NOOBJECT;
begin
if player.weapon <> NOWEAPON then
anythinglisted := TRUE;
writeln(" a " <& player.weapon);
end if;
if player.armor <> NOARMOR then
anythinglisted := TRUE;
writeln(" " <& player.armor <& " armor");
end if;
if player.flares > 0 then
anythinglisted := TRUE;
writeln(" " <& numberName(player.flares) <& " flare" <&
player.flares <> 1 ? "s" : "");
end if;
if player.goldPieces > 0 then
anythinglisted := TRUE;
writeln(" " <& numberName(player.goldPieces) <& " gold piece" <&
player.goldPieces <> 1 ? "s" : "");
end if;
for obj range player.possession do
anythinglisted := TRUE;
writeln(" the " <& obj);
end for;
if not anythinglisted then
writeln(" nothing");
end if;
end func;
const proc: inventory (in playerType: player) is func
begin
writeln;
writeln("You have:");
listInventory(player);
end func;
const proc: contentInfo (in roomType: currentRoom, in roomType: aRoom) is func
begin
write(aRoom.xPos = currentRoom.xPos and
aRoom.yPos = currentRoom.yPos ? "<" : " ");
if aRoom.visited then
case aRoom.transfer of
when {NOTRANSFER}:
if aRoom.roomer = NOBODY then
if aRoom.contents <> EMPTYROOM then
case aRoom.contents of
when {ENTRANCE}: write("E");
when {EMPTYCHEST}: write(".");
when {CHESTWITHSKELETON}: write(".");
when {CLOSEDCHEST}: write("C");
when {ORB}: write("O");
when {POOL}: write("P");
when {BOOK}: write("B");
end case;
elsif aRoom.objects <> objectSet.value then
write("T");
elsif UP in aRoom.connections then
write("U");
elsif DOWN in aRoom.connections then
write("D");
elsif aRoom.occurrence = FINDFLARES then
write("F");
elsif aRoom.occurrence = FINDGOLD then
write("G");
else
write(".");
end if;
elsif aRoom.roomer = VENDOR then
write("V");
else
write("M");
end if;
when {SINKHOLE}: write("S");
when {WARP}: write("W");
end case;
else
write(" ");
end if;
write(aRoom.xPos = currentRoom.xPos and
aRoom.yPos = currentRoom.yPos ? "> " : " ");
end func;
const proc: map (in roomType: currentRoom, in playerType: player) is func
local
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
begin
writeln;
if player.blind then
writeln("** You are blind, you dumb " <& player.species <& "!");
else
zPos := currentRoom.zPos;
for yPos range 1 to SIZE_LABY do
for xPos range 1 to SIZE_LABY do
contentInfo(currentRoom, labyrinth[xPos][yPos][zPos]);
end for;
writeln;
writeln;
end for;
write("You are at ");
writePos(currentRoom);
end if;
end func;
const proc: flare (inout roomType: currentRoom, inout playerType: player) is func
local
var integer: x is 0;
var integer: y is 0;
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
begin
writeln;
if player.flares = 0 then
writeln("** Hey, bright one, you're out of flares!");
elsif player.blind then
writeln("** You can't see anything, you dumb " <& player.species <& "!");
else
decr(player.flares);
zPos := currentRoom.zPos;
for y range pred(currentRoom.yPos) to succ(currentRoom.yPos) do
yPos := rangeLaby(y);
for x range pred(currentRoom.xPos) to succ(currentRoom.xPos) do
xPos := rangeLaby(x);
labyrinth[xPos][yPos][zPos].visited := TRUE;
contentInfo(currentRoom, labyrinth[xPos][yPos][zPos]);
end for;
writeln;
writeln;
end for;
write("You are at ");
writePos(currentRoom);
end if;
end func;
const proc: shineIntoRoom (inout roomType: aRoom) is func
begin
aRoom.visited := TRUE;
writeln;
write("The lamp shines into a room at ");
writePos(aRoom);
write("You see ");
writeRoomDescription(aRoom);
writeRoomDetails(aRoom);
end func;
const proc: lamp (in roomType: currentRoom, in playerType: player) is func
local
var integer: xPos is 0;
var integer: yPos is 0;
var integer: zPos is 0;
var char: ch is ' ';
begin
writeln;
if LAMP not in player.possession then
writeln("** You don't have a lamp, " <& player.species <& "!");
elsif player.blind then
writeln("** You are blind, you dumb " <& player.species <& "!");
else
write("Where do you want to shine the lamp (N, S, E, W)? ");
ch := readChar();
if not ch in {'N', 'S', 'E', 'W'} then
writeln;
writeln("** That's not a direction, " <& player.species <& "!");
else
xPos := currentRoom.xPos;
yPos := currentRoom.yPos;
zPos := currentRoom.zPos;
case ch of
when {'N'}: yPos := rangeLaby(pred(yPos));
when {'S'}: yPos := rangeLaby(succ(yPos));
when {'W'}: xPos := rangeLaby(pred(xPos));
when {'E'}: xPos := rangeLaby(succ(xPos));
end case;
shineIntoRoom(labyrinth[xPos][yPos][zPos]);
end if;
end if;
end func;
const proc: drink (in roomType: currentRoom, inout playerType: player) is func
local
var speciesType: newSpecies is HUMAN;
begin
writeln;
if currentRoom.contents <> POOL then
writeln("** If you want a drink, find a pool!");
else
write("You take a drink and ");
case rand(1, 8) of
when {1}:
player.strength := range18(player.strength + rand(1, 3));
writeln("feel stronger.");
when {2}:
player.strength -:= rand(1, 3);
writeln("feel weaker.");
player.living := player.strength >= 1 ;
when {3}:
player.intelligence := range18(player.intelligence + rand(1, 3));
writeln("feel smarter.");
when {4}:
player.intelligence -:= rand(1, 3);
writeln("feel dumber.");
player.living := player.intelligence >= 1;
when {5}:
player.dexterity := range18(player.dexterity + rand(1, 3));
writeln("feel nimbler.");
when {6}:
player.dexterity -:= rand(1, 3);
writeln("feel clumsier.");
player.living := player.dexterity >= 1;
when {7}:
newSpecies := rand(speciesType.first, pred(speciesType.last));
if newSpecies >= player.species then
incr(newSpecies);
end if;
player.species := newSpecies;
writeln("become " <& aOrAn(player.species) <& ".");
when {8}:
player.isMale := not player.isMale;
writeln("turn into a " <& sexName(player.isMale) <&
" " <& player.species <& ".");
end case;
end if;
end func;
const proc: read (inout roomType: currentRoom, inout playerType: player) is func
begin
writeln;
if currentRoom.contents <> BOOK then
writeln("** There is nothing that can be read!");
elsif player.blind then
writeln("** You are blind, you dumb " <& player.species <& "!");
else
writeln("You open the book and");
case rand(1, 6) of
when {1}:
writeln("Flash! Oh no! You are now a blind " <& player.species <& "!");
player.blind := TRUE;
when {2}:
case rand(1, 4) of
when {1}: writeln("It's another volume of Zot's poetry. - YECH!!");
when {2}: writeln("It's a manual of this game.");
when {3}: writeln("It's a story about a dumb " <& player.species <&
" who finds a book and then dies.");
when {4}: writeln("It's volume number " <&
numberName(rand(1, 20)) <& " of a novel.");
end case;
when {3}:
writeln("It's an old copy of play " <& rand(speciesType) <& ".");
when {4}:
writeln("It's a manual of dexterity!");
player.dexterity := 18;
when {5}:
writeln("It's a manual of strength!");
player.strength := 18;
when {6}:
writeln("The book sticks to your hands -");
writeln("Now you are unable to draw your weapon!");
player.weaponBlocked := TRUE;
end case;
currentRoom.contents := EMPTYROOM;
end if;
end func;
const proc: viewRoomWithOrb (inout roomType: aRoom) is func
begin
aRoom.visited := TRUE;
writeRoomDescription(aRoom);
writeConnections(aRoom);
write("You can also see that this room is at ");
writePos(aRoom);
writeAnimates(aRoom);
writeObjects(aRoom);
end func;
const proc: gazeIntoOrb (inout playerType: player) is func
begin
write("You see ");
case rand(1, 6) of
when {1}:
case rand(1, 10) of
when { 1}: writeln("your own burial!");
when { 2}: writeln("your mouldering dead body!");
when { 3}: writeln("yourself in a bloody heap!");
when { 4}: writeln("yourself with your skull bashed in!");
when { 5}: writeln("your broken skeleton lying on the ground!");
when { 6}: writeln("a graveyard and a tombstone with your name!");
when { 7}: writeln(aOrAn(rand(animateType)) <& " killing you!");
when { 8}: writeln(aOrAn(rand(speciesType)) <&
" finding your faded bones!");
when { 9}: writeln(aOrAn(rand(speciesType)) <& " which tells " <&
aOrAn(rand(speciesType)) <& " that you are dead!");
when {10}: writeln("a " <& sexName(not player.isMale) <&
" " <& player.species <&
" giving flowers on your grave!");
end case;
decr(player.strength);
write("This message makes you weaker. Your strength is now ");
if player.strength < 1 then
player.living := FALSE;
writeln("zero!");
else
writeln(numberName(player.strength) <& ".");
end if;
when {2}:
case rand(1, 4) of
when {1}: writeln("yourself drinking from a pool and becoming " <&
aOrAn(rand(animateType)) <& "!");
when {2}: writeln(aOrAn(rand(animateType)) <&
" drinking from a pool and becoming " <&
aOrAn(rand(speciesType)) <& ".");
when {3}: writeln(aOrAn(rand(speciesType)) <&
" drinking from a pool and becoming " <&
anyAdjective() <& " spider.");
when {4}: writeln("a young " <& rand(FALSE, TRUE) ? "man" : "woman" <&
" drinking from a pool and becoming as old \
\as the hills.");
end case;
when {3}:
case rand(1, 2) of
when {1}: writeln(aOrAn(rand(animateType)) <&
" gazing back at you.");
when {2}: writeln("that you are watched from " <&
aOrAn(rand(speciesType)) <& ".");
end case;
when {4}:
viewRoomWithOrb(labyrinth[rand(1, SIZE_LABY)]
[rand(1, SIZE_LABY)]
[rand(1, NUM_LEVELS)]);
when {5}:
write("the *ORB OF ZOT* at ");
if rand(FALSE, TRUE) then
writePos(objPlace[ORBOFZOT]);
else
writePos(labyrinth[rand(1, SIZE_LABY)]
[rand(1, SIZE_LABY)]
[rand(1, NUM_LEVELS)]);
end if;
when {6}:
case rand(1, 10) of
when { 1}: writeln("a soap opera rerun.");
when { 2}: writeln("a washing powder commercial.");
when { 3}: writeln("an image to test the reception of the orb.");
when { 4}: writeln("somebody sitting at a computer playing this game.");
when { 5}: writeln("nothing because in the moment there are atmospherics.");
when { 6}: writeln("a scientist demonstrating that an orb could never work.");
when { 7}: writeln("the presentation of the new generation of orb's with sound.");
when { 8}: writeln("that there is a 50% chance that what you see in an orb is correct.");
when { 9}: writeln("yourself looking into an orb where you see yourself looking into ...");
when {10}: writeln(aOrAn(rand(speciesType)) <&
" announcing todays program of the orb.");
end case;
end case;
end func;
const proc: gaze (in roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
writeln;
if player.blind then
writeln("** You can't see anything, you dumb " <& player.species <& "!");
elsif currentRoom.roomer = NOBODY then
case currentRoom.contents of
when {EMPTYROOM}: writeln("You are gazing at an empty wall.");
when {ENTRANCE}: writeln("You are gazing at the exit.");
when {EMPTYCHEST}: writeln("The chest does not fill with gazing at.");
when {CHESTWITHSKELETON}: writeln("The skeleton looks horrible.");
when {CLOSEDCHEST}: writeln("The chest does not open with gazing at.");
when {POOL}: writeln("You see your ugly face mirror in the water.");
when {BOOK}: writeln("You are gazing at the book.");
when {ORB}: gazeIntoOrb(player);
end case;
elsif currentRoom.roomer = VENDOR then
write("You are gazing at the Vendor. ");
if player.isMale then
writeln("But the Vendor does not like male " <& player.species <& ".");
else
writeln("The Vendor smiles and shows his wedding-ring.");
end if;
else
write("The " <& currentRoom.roomer);
if player.isMale then
writeln(" is shocked by the scowl of a strong male " <&
player.species <& ".");
fightState.monsterWillAttack := FALSE;
else
writeln(" cannot be shocked by the scowl of a female " <&
player.species <& ".");
end if;
end if;
end func;
const proc: openChest (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var directType: direct is NORTH;
begin
if currentRoom.roomer <> NOBODY then
writeln("The " <& currentRoom.roomer <&
" does not allow to open the chest.");
else
write("You open the chest and ");
case rand(1, 2) of
when {1}:
write("find ");
findGoldPieces(player, 99);
currentRoom.contents := EMPTYCHEST;
when {2}:
case rand(1, 7) of
when {1}:
writeln("it is totally empty.");
currentRoom.contents := EMPTYCHEST;
when {2}:
writeln("it disappears in the moment you open it.");
currentRoom.contents := EMPTYROOM;
when {3}:
writeln("... KABOOOM! It explodes!!");
checkArmor(player, rand(1, 6));
player.living := player.strength >= 1;
currentRoom.contents := EMPTYROOM;
when {4}:
player.turns +:= 20;
direct := rand(currentRoom.connections - {UP, DOWN});
writeln("... GAS!! You stagger from the room to the " <&
direct <& "!");
currentRoom.contents := EMPTYCHEST;
go(currentRoom, player, fightState, direct);
when {5}:
writeln("find " <& anyAdjective() <& " skeleton.");
writeln("It seems that this " <& rand(speciesType) <&
" was also an adventurer.");
currentRoom.contents := CHESTWITHSKELETON;
when {6}:
write("find ");
findFlares(player, 4);
currentRoom.contents := EMPTYCHEST;
when {7}:
if player.armor = NOARMOR then
player.armor := LEATHER;
end if;
writeln("find a brand new " <& player.armor <& " armor.");
player.armorStrength := ord(player.armor) * ARMOR_STRENGTH_FACTOR;
currentRoom.contents := EMPTYCHEST;
end case;
end case;
end if;
end func;
const proc: open (inout roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
begin
writeln;
if currentRoom.contents <> CLOSEDCHEST then
writeln("** The only thing opened, was your big mouth!");
else
openChest(currentRoom, player, fightState);
end if;
end func;
const proc: quit (inout playerType: player) is func
begin
writeln;
write("Do you really want to quit now? ");
if readChar() <> 'Y' then
writeln;
writeln("** Then don't say that you do!");
else
player.quitProgram := TRUE;
end if;
end func;
const proc: wait is func
begin
writeln;
writeln("Waiting ...");
end func;
const proc: illegal (in playerType: player) is func
begin
writeln;
writeln("** Silly " <& player.species <& ", that wasn't a valid command!");
end func;
const func commandType: readCommand is func
result
var commandType: currentCommand is ILLEGAL;
local
var string: stri is "";
var char: ch1 is ' ';
var char: ch2 is ' ';
begin
writeln;
write(" -> ");
stri := upper(getln(IN));
if stri = "" then
currentCommand := WAIT;
else
ch1 := stri[1];
if length(stri) >= 2 then
ch2 := stri[2];
end if;
case ch1 of
when {'A'}: currentCommand := ATTACK;
when {'B'}: if ch2 = ' ' or ch2 = 'U' then
currentCommand := BUY;
elsif ch2 = 'R' then
currentCommand := BRIBE;
else
currentCommand := ILLEGAL;
end if;
when {'C'}: currentCommand := CAST;
when {'D'}: if ch2 = ' ' or ch2 = 'O' then
currentCommand := GO_DOWN;
elsif ch2 = 'R' then
currentCommand := DRINK;
else
currentCommand := ILLEGAL;
end if;
when {'E'}: currentCommand := GO_EAST;
when {'F'}: currentCommand := FLARE;
when {'G'}: currentCommand := GAZE;
when {'H'}: currentCommand := HELP;
when {'I'}: currentCommand := INVENTORY;
when {'L'}: if ch2 = ' ' or ch2 = 'O' then
currentCommand := LOOK;
elsif ch2 = 'A' then
currentCommand := USE_LAMP;
else
currentCommand := ILLEGAL;
end if;
when {'M'}: currentCommand := MAP;
when {'N'}: currentCommand := GO_NORTH;
when {'O'}: currentCommand := OPEN;
when {'Q'}: currentCommand := QUITCOMMAND;
when {'R'}: currentCommand := READ;
when {'S'}: if ch2 = ' ' or ch2 = 'O' then
currentCommand := GO_SOUTH;
elsif ch2 = 'T' then
currentCommand := STATUS;
elsif ch2 = 'E' then
currentCommand := SELL;
else
currentCommand := ILLEGAL;
end if;
when {'T'}: currentCommand := TELEPORT;
when {'U'}: currentCommand := GO_UP;
when {'W'}: currentCommand := GO_WEST;
otherwise: currentCommand := ILLEGAL;
end case;
end if;
end func;
const proc: executeCommand (inout roomType: currentRoom,
inout playerType: player, inout fightStateType: fightState) is func
begin
case readCommand() of
when {GO_NORTH}: go(currentRoom, player, fightState, NORTH);
when {GO_SOUTH}: go(currentRoom, player, fightState, SOUTH);
when {GO_EAST}: go(currentRoom, player, fightState, EAST);
when {GO_WEST}: go(currentRoom, player, fightState, WEST);
when {GO_UP}: go(currentRoom, player, fightState, UP);
when {GO_DOWN}: go(currentRoom, player, fightState, DOWN);
when {WAIT}: wait;
when {INVENTORY}: inventory(player);
when {HELP}: writeHelp;
when {LOOK}: look(currentRoom, player);
when {MAP}: map(currentRoom, player);
when {FLARE}: flare(currentRoom, player);
when {USE_LAMP}: lamp(currentRoom, player);
when {ATTACK}: attack(currentRoom, player, fightState);
when {CAST}: cast(currentRoom, player, fightState);
when {BRIBE}: bribe(currentRoom, player, fightState);
when {STATUS}: status(currentRoom, player);
when {OPEN}: open(currentRoom, player, fightState);
when {READ}: read(currentRoom, player);
when {GAZE}: gaze(currentRoom, player, fightState);
when {TELEPORT}: teleport(currentRoom, player, fightState);
when {DRINK}: drink(currentRoom, player);
when {SELL}: sell(currentRoom, player);
when {BUY}: buy(currentRoom, player);
when {QUITCOMMAND}: quit(player);
otherwise: illegal(player);
end case;
end func;
const proc: writeFightState (in roomType: currentRoom, inout playerType: player,
inout fightStateType: fightState) is func
local
var animateType: monster is NOBODY;
begin
if fightState.monsterPresent and not fightState.bribed and
player.living and not player.quitProgram then
monster := currentRoom.roomer;
if fightState.monsterWillAttack then
monsterAttacks(monster, player, fightState);
end if;
fightState.monsterWillAttack := TRUE;
if player.living then
writeln;
writeln("You're facing " <& aOrAn(monster) <& "!");
writeln("Your strength is " <& player.strength <&
" and your dexterity is " <& player.dexterity <& ".");
end if;
end if;
end func;
const proc: incident (inout roomType: currentRoom,
inout playerType: player) is func
local
var objectType: treasure is NOOBJECT;
begin
if PEARL not in player.possession then
if currentRoom.occurrence = LEECH then
writeln("You pocket has a leetch. Now you will lose gold pieces.");
currentRoom.occurrence := NOOCCURRENCE;
player.haveLeech := TRUE;
end if;
if player.haveLeech then
player.goldPieces -:= rand(1, 3);
if player.goldPieces < 0 then
player.goldPieces := 0;
end if;
end if;
end if;
if RUBY not in player.possession then
if currentRoom.occurrence = LETHARGY then
writeln("You feel that you are lethargic now.");
currentRoom.occurrence := NOOCCURRENCE;
player.lethargic := TRUE;
end if;
if player.lethargic then
incr(player.turns);
end if;
end if;
if GREENGEM not in player.possession then
if currentRoom.occurrence = FORGET then
writeln("You see a lot of strange signs on the ground, possibly runes.");
writeln("You try to read them, but you found no sense.");
writeln("You feel that the runes force you to forget the map of the castle.");
currentRoom.occurrence := NOOCCURRENCE;
player.forgetting := TRUE;
end if;
if player.forgetting then
labyrinth[rand(1, SIZE_LABY)]
[rand(1, SIZE_LABY)]
[rand(1, NUM_LEVELS)].visited := FALSE;
end if;
end if;
if player.armor <> NOARMOR and currentRoom.occurrence = STEALARMOR then
writeln("You are knocked down from behind and somebody steals your " <&
player.armor <& " armor.");
currentRoom.occurrence := NOOCCURRENCE;
player.armor := NOARMOR;
end if;
if player.weapon <> NOWEAPON and currentRoom.occurrence = STEALWEAPON then
writeln("You realize that somebody has stolen your " <& player.weapon <& ".");
currentRoom.occurrence := NOOCCURRENCE;
player.weapon := NOWEAPON;
end if;
if LAMP in player.possession and currentRoom.occurrence = STEALLAMP then
writeln("You realize that somebody has stolen your lamp.");
currentRoom.occurrence := NOOCCURRENCE;
excl(player.possession, LAMP);
end if;
if player.flares <> 0 and currentRoom.occurrence = STEALFLARES then
writeln("You realize that somebody has stolen all your flares.");
currentRoom.occurrence := NOOCCURRENCE;
player.flares := 0;
end if;
if currentRoom.occurrence = STEALTREASURE then
if countOwnedTreasures(player) <> 0 then
treasure := ownedTreasure(player);
writeln("You realize that somebody has stolen the " <& treasure <& ".");
currentRoom.occurrence := NOOCCURRENCE;
excl(player.possession, treasure);
end if;
end if;
if currentRoom.occurrence = FINDGOLD then
if currentRoom.roomer = NOBODY then
write("Here you find ");
findGoldPieces(player, 10);
else
writeln("Here are " <& numberName(rand(2, 11)) <&
" GP'S. But the " <& currentRoom.roomer <&
" is faster and takes them.");
end if;
currentRoom.occurrence := NOOCCURRENCE;
end if;
if currentRoom.occurrence = FINDFLARES then
if currentRoom.roomer = NOBODY then
write("Here you find ");
findFlares(player, 4);
else
writeln("Here are " <& numberName(rand(2, 5)) <&
" flares. But the " <& currentRoom.roomer <&
" is faster and takes them.");
end if;
currentRoom.occurrence := NOOCCURRENCE;
end if;
end func;
const proc: curesAndDissolves (inout playerType: player) is func
begin
if player.blind and OPAL in player.possession then
writeln;
writeln("The opal Eye cures your blindness!");
player.blind := FALSE;
end if;
if player.weaponBlocked and BLUEFLAME in player.possession then
writeln;
writeln("The blue Flame dissolves the book!");
player.weaponBlocked := FALSE;
end if;
if player.haveLeech and PEARL in player.possession then
writeln;
writeln("The pale pearl fixes the leech in your pocket.");
player.haveLeech := FALSE;
end if;
if player.lethargic and RUBY in player.possession then
writeln;
writeln("The ruby red stops your lethargy.");
player.lethargic := FALSE;
end if;
if player.forgetting and GREENGEM in player.possession then
writeln;
writeln("The green Gem stops the forgetting of the map.");
player.forgetting := FALSE;
end if;
end func;
const proc: writeRemark (in playerType: player) is func
local
var integer: number is 0;
begin
if rand(1, 5) = 1 then
if player.blind then
number := rand(1, 4);
else
number := rand(1, 5);
end if;
case number of
when {1}:
case rand(1, 8) of
when {1}: writeln("You sneezed.");
when {2}: writeln("You stepped on a frog.");
when {3}: writeln("You have a fit of dizziness.");
when {4}: writeln("You moved your hand through a spiders net.");
when {5}: writeln("There are indications that somebody must have \
\been here recently.");
when {6}: writeln("A blast of wind blows a cloud of dust across \
\the room.");
when {7}: writeln("You touch " <& anyAdjective() <&
" insect that immediately flies away.");
when {8}:
writeln("The smell of " <& anyFood() <& " is in the air.");
end case;
when {2}:
write("You smell ");
case rand(1, 9) of
when {1}: writeln("musty air.");
when {2}: writeln("rotten flesh.");
when {3}: writeln("a whiff of good french perfume.");
when {4}: writeln("the bad odour of a mouldering body.");
when {5}: writeln("the pleasant scent of a green meadow.");
when {6}: writeln("the unpleasant stench of an acid.");
when {7}: writeln("mouldering bones which must lie nearby.");
when {8}: writeln(aOrAn(rand(animateType)) <& " frying.");
when {9}: writeln("the presence of a " <&
sexName(not player.isMale) <& " " <&
player.species <& ".");
end case;
when {3}:
write("You feel ");
case rand(1, 10) of
when { 1}: writeln("like you're being watched.");
when { 2}: writeln("terribly frightened.");
when { 3}: writeln("drops falling on your neck.");
when { 4}: writeln("something touching your shoulder.");
when { 5}: writeln("that you will be killed.");
when { 6}: writeln("a cold wind blowing across the room.");
when { 7}: writeln("that you get hungry.");
when { 8}: writeln("vibrations at the ground.");
when { 9}: writeln("danger in the vicinity.");
when {10}: writeln("that a " <& sexName(not player.isMale) <&
" " <& rand(speciesType) <&
" must have been here recently.");
end case;
when {4}:
write("You hear ");
case rand(1, 11) of
when { 1}: writeln("thunder.");
when { 2}: writeln("moaning.");
when { 3}: writeln("a scream.");
when { 4}: writeln("a wumpus.");
when { 5}: writeln("footsteps.");
when { 6}: writeln("a door open.");
when { 7}: writeln("a door slam.");
when { 8}: writeln("rattling sounds.");
when { 9}: writeln("somebody snigger.");
when {10}: writeln("faint rustling noises.");
when {11}: writeln("somebody whisper your name.");
end case;
when {5}:
write("You see ");
case rand(1, 8) of
when {1}: writeln("a bat fly by.");
when {2}: writeln("some flies.");
when {3}: writeln("a shadow passing by.");
when {4}: writeln("a rat crossing the room.");
when {5}: writeln("two eyes glowing in the dark. \
\A moment later they disappear.");
when {6}: writeln(anyAdjective() <& " footprint.");
when {7}: writeln(anyAdjective() <& " spider running away.");
when {8}: writeln("the mirage of the " <&
rand(LAMP, ORBOFZOT) <& ".");
end case;
end case;
end if;
end func;
const proc: die (in playerType: player) is func
begin
writeln("\a");
writeln("*" mult 78);
writeln("A noble effort, oh formerly living " <& player.species <& "!");
writeln;
write("You died due to lack of ");
if player.strength < 1 then
writeln("strength.");
elsif player.intelligence < 1 then
writeln("intelligence.");
elsif player.dexterity < 1 then
writeln("dexterity.");
end if;
writeln;
writeln("At the time you died, you had:");
listInventory(player);
writeln;
writeln("And it took you " <& player.turns <& " turns!");
end func;
const proc: exitCastle (inout playerType: player) is func
begin
writeln("\a");
write("You left the castle with");
if ORBOFZOT not in player.possession then
write("out");
end if;
writeln(" the *ORB OF ZOT*.");
writeln;
if ORBOFZOT in player.possession then
writeln("An incredibly glorious victory!!");
writeln;
writeln("In addition, you got out with the following:");
writeln(" your life");
excl(player.possession, ORBOFZOT);
else
writeln("A less than awe-inspiring defeat.");
writeln;
writeln("When you left the castle, you had:");
writeln(" your miserable life");
end if;
listInventory(player);
writeln;
writeln("And it took you " <& player.turns <& " turns!");
end func;
const proc: main is func
local
var playerType: player is playerType.value;
var fightStateType: fightState is fightStateType.value;
var char: ch is ' ';
begin
OUT := STD_CONSOLE;
IN := openEditLine(KEYBOARD, OUT);
startText();
repeat
initRoomConnections();
initRoomProperties();
initRoomTransfers();
labyrinthNumber := rand(1, 50);
player := playerType.value;
fightState := fightStateType.value;
readSpecies(player);
readSex(player);
readAttributes(player);
buyArmor(player, 7, 5, 3);
buyWeapon(player, 7, 5, 3);
buyLamp(player, 2);
buyFlares(player);
if not player.quitDialog then
writeln;
writeln("Ok, " <& player.species <& ", you are now entering the castle.");
writeln("Type H for help.");
currentRoomRef := labyrinth[rangeLaby(4)][1][1];
enterRoom(currentRoomRef, player, fightState);
repeat
incr(player.turns);
incident(currentRoomRef, player);
curesAndDissolves(player);
writeRemark(player);
executeCommand(currentRoomRef, player, fightState);
writeFightState(currentRoomRef, player, fightState);
until not player.living or player.leaveCastle or player.quitProgram;
if not player.living then
die(player);
elsif player.leaveCastle then
exitCastle(player);
end if;
end if;
repeat
writeln;
write("Are you foolish enough to want to play again? ");
ch := readChar();
if not ch in {'Y', 'N'} then
writeln;
writeln("** Please answer yes or no.");
end if;
until ch in {'Y', 'N'};
writeln;
if ch = 'Y' then
writeln("Some " <& player.species <& "s never learn!");
else
writeln("Maybe dumb " <& player.species <& " is not so dumb after all!");
end if;
until ch = 'N';
end func;