xref: /dports/lang/seed7/seed7/prg/wiz.sd7

(********************************************************************)
(*                                                                  *)
(*  wiz.sd7       Find treasures and fight monsters labyrinth game  *)
(*  Copyright (C) 1990 - 1994, 2004, 2007, 2008  Thomas Mertes      *)
(*                2011, 2013, 2021  Thomas Mertes                   *)
(*                                                                  *)
(*  This program is free software; you can redistribute it and/or   *)
(*  modify it under the terms of the GNU General Public License as  *)
(*  published by the Free Software Foundation; either version 2 of  *)
(*  the License, or (at your option) any later version.             *)
(*                                                                  *)
(*  This program is distributed in the hope that it will be useful, *)
(*  but WITHOUT ANY WARRANTY; without even the implied warranty of  *)
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the   *)
(*  GNU General Public License for more details.                    *)
(*                                                                  *)
(*  You should have received a copy of the GNU General Public       *)
(*  License along with this program; if not, write to the           *)
(*  Free Software Foundation, Inc., 51 Franklin Street,             *)
(*  Fifth Floor, Boston, MA  02110-1301, USA.                       *)
(*                                                                  *)
(********************************************************************)


$ 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 [] ("hobbit", "elf", "human", "dwarf")[succ(ord(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 [] ("north", "south", "east", "west", "up", "down")[succ(ord(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 [] ("nobody", "kobold", "orc", "wolf", "goblin", "ogre", "troll",
             "bear", "minotaur", "gargoyle", "chimera", "balrog", "dragon",
             "vendor")[succ(ord(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 [] ("no", "leather", "chainmail", "plate") [succ(ord(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 [] ("no", "dagger", "mace", "sword") [succ(ord(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; # startText


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; # writeHelp


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; # randomRoom


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; # findUninhabitedRoom


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; # findEmptyRoom


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; # initRoom


const proc: initEntrance (inout roomType: aRoom) is func
  begin
    aRoom.connections := {NORTH, SOUTH, EAST, WEST};
    aRoom.contents := ENTRANCE;
    aRoom.visited := TRUE;
  end func; # initEntrance


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; # initRoomConnections


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; # initRoomProperties


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; # initRoomTransfers


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; # aOrAn


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; # removeFromRoom


const proc: writePos (in roomType: aRoom) is func
  begin
    writeln("(" <& aRoom.xPos <& ", " <& aRoom.yPos <& ") Level: " <& aRoom.zPos);
  end func; # writePos


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; # findGoldPieces


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; # findFlares


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; # writeRoomDescription


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; # writeConnections


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; # writeThings


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; # writeAnimates


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; # writeObjects


const proc: writeRoomDetails (in roomType: currentRoom) is func
  begin
    writeConnections(currentRoom);
    writeThings(currentRoom);
    writeAnimates(currentRoom);
    writeObjects(currentRoom);
  end func; # writeRoomDetails


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; # look


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; # readChar


const func char: readChoice is func
  result
    var char: ch is ' ';
  begin
    writeln;
    write("Your choice? ");
    ch := readChar();
  end func; # readChoice


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; # readNumber


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; # readSpecies


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; # readSex


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; # riseAttribute


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; # readAttributes


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; # buyAttribute


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; # buyArmor


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; # buyWeapon


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; # buyLamp


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; # buyFlares


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; # buyTreasures


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; # buy


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; # sellTreasures


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; # sell


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; # checkArmor


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; # vendorDies


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; # monsterDies


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; # monsterAttacks


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; # attackMonster


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; # castSpell


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; # bribeMonster


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; # meetMonster


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; # retreatFromMonster


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  # attack VENDOR
        meetMonster(currentRoom, player, fightState);
      end if;
      attackMonster(currentRoom, player, fightState);
      fightState.monsterWillAttack := TRUE;
    end if;
  end func; # attack


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  # cast VENDOR
        meetMonster(currentRoom, player, fightState);
      end if;
      castSpell(currentRoom, player, fightState);
      fightState.monsterWillAttack := TRUE;
    end if;
  end func; # cast


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; # bribe


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; # meetVendor


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; # enterRoom


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; # readCoordinate


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; # teleportTo


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; # teleport


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; # go


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; # status


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; # listInventory


const proc: inventory (in playerType: player) is func
  begin
    writeln;
    writeln("You have:");
    listInventory(player);
  end func; # inventory


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; # contentInfo


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; # map


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; # flare


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; # shineIntoRoom


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; # lamp


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; # drink


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; # read


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; # viewRoomWithOrb


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; # gazeIntoOrb


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; # gaze


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; # openChest


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; # open


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; # quit


const proc: wait is func
  begin
    writeln;
    writeln("Waiting ...");
  end func; # wait


const proc: illegal (in playerType: player) is func
  begin
    writeln;
    writeln("** Silly " <& player.species <& ", that wasn't a valid command!");
  end func; # illegal


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; # readCommand


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; # executeCommand


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; # writeFightState


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; # incident


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; # curesAndDissolves


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; # writeRemark


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; # die


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; # exitCastle


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; # main