
(********************************************************************)
(*                                                                  *)
(*  wiz.sd7       Find treasures and fight monsters labyrinth game  *)
(*  Copyright (C) 1991, 1992, 1993, 1994, 2004  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";

const integer: SIZE_LABY is 8;
const integer: NUM_LEVELS is 8;
const integer: THINGS_PER_LEVEL is 1;
const integer: VENDORS_PER_LEVEL is 1;
const integer: OCCURANCES_PER_LEVEL is 1;
const integer: TRANSFERS_PER_LEVEL is 1;


const type: speciestype is new enum
    HOBBIT, ELF, HUMAN, DWARF
  end enum;

const array speciestype: list_of_species is [](HOBBIT, ELF, HUMAN, DWARF);

const func string: str (in speciestype: aSpecies) is
  return [] ("hobbit", "elf", "human", "dwarf")[succ(ord(aSpecies))];

enable_output(speciestype);


const type: commandtype is subtype integer;
const commandtype: ILLEGAL     is  0;
const commandtype: GO_NORTH    is  1;
const commandtype: GO_SOUTH    is  2;
const commandtype: GO_EAST     is  3;
const commandtype: GO_WEST     is  4;
const commandtype: GO_UP       is  5;
const commandtype: GO_DOWN     is  6;
const commandtype: WAIT        is  7;
const commandtype: INVENTORY   is  8;
const commandtype: HELP        is  9;
const commandtype: LOOK        is 10;
const commandtype: MAP         is 11;
const commandtype: FLARE       is 12;
const commandtype: LIGHT       is 13;
const commandtype: ATTACK      is 14;
const commandtype: CAST        is 15;
const commandtype: BRIBE       is 16;
const commandtype: STATUS      is 17;
const commandtype: OPEN        is 18;
const commandtype: READ        is 19;
const commandtype: GAZE        is 20;
const commandtype: TELEPORT    is 21;
const commandtype: DRINK       is 22;
const commandtype: SELL        is 23;
const commandtype: BUY         is 24;
const commandtype: QUITCOMMAND is 25;

const type: directtype is subtype integer;
const directtype: NORTH is 1;
const directtype: SOUTH is 2;
const directtype: EAST is 3;
const directtype: WEST is 4;
const directtype: UP is 5;
const directtype: DOWN is 6;

const func string: str (in directtype: direct) is
  return [] ("north", "south", "east", "west", "up", "down")[direct];

enable_output(directtype);

const array integer: delta_x is [](-1,  1,  0,  0,  0,  0);
const array integer: delta_y is []( 0,  0,  1, -1,  0,  0);
const array integer: delta_z is []( 0,  0,  0,  0, -1,  1);

const type: contenttype is integer;
const contenttype: EMPTYROOM is 1;
const contenttype: ENTRANCE is 2;
const contenttype: EMPTYCHEST is 3;
const contenttype: CHESTWITHSKELETON is 4;
const contenttype: CLOSEDCHEST is 5;
const contenttype: ORB is 6;
const contenttype: POOL is 7;
const contenttype: BOOK is 8;
const array contenttype: list_of_contents is [](EMPTYROOM, ENTRANCE, EMPTYCHEST,
      CHESTWITHSKELETON, CLOSEDCHEST, ORB, POOL, BOOK);

const type: placetype is new enum
    NOWHERE, ANYROOM, PLAYER
  end enum;

const type: object_record is new struct
    var string: name is "";
    var integer: number is 0;
    var placetype: place is NOWHERE;
    var integer: xPos is 0;
    var integer: yPos is 0;
    var integer: zPos is 0;
  end struct;

const type: objecttype is varptr object_record;

const objecttype: NOOBJECT is  varalloc(object_record.value);
const objecttype: LAMP is      varalloc(object_record.value);
const objecttype: RUBY is      varalloc(object_record.value);
const objecttype: NORNSTONE is varalloc(object_record.value);
const objecttype: PEARL is     varalloc(object_record.value);
const objecttype: OPAL is      varalloc(object_record.value);
const objecttype: GREENGEM is  varalloc(object_record.value);
const objecttype: BLUEFLAME is varalloc(object_record.value);
const objecttype: PALANTIR is  varalloc(object_record.value);
const objecttype: SILMARIL is  varalloc(object_record.value);
const objecttype: RUNESTAFF is varalloc(object_record.value);
const objecttype: ORBOFZOT is  varalloc(object_record.value);

const array objecttype: list_of_objects is [](LAMP, RUBY, NORNSTONE, PEARL,
      OPAL, GREENGEM, BLUEFLAME, PALANTIR, SILMARIL, RUNESTAFF,
      ORBOFZOT);
const array objecttype: list_of_treasures is [](RUBY, NORNSTONE, PEARL,
      OPAL, GREENGEM, BLUEFLAME, PALANTIR, SILMARIL);
(*
const integer: ord (NOOBJECT)  is 0;
const integer: ord (LAMP)      is 1;
const integer: ord (RUBY)      is 2;
const integer: ord (NORNSTONE) is 3;
const integer: ord (PEARL)     is 4;
const integer: ord (OPAL)      is 5;
const integer: ord (GREENGEM)  is 6;
const integer: ord (BLUEFLAME) is 7;
const integer: ord (PALANTIR)  is 8;
const integer: ord (SILMARIL)  is 9;
const integer: ord (RUNESTAFF) is 10;
const integer: ord (ORBOFZOT)  is 11;
const func integer: ord (in objecttype param) is DYNAMIC;
const string: str (NOOBJECT)  is "nothing";
const string: str (LAMP)      is "lamp";
const string: str (RUBY)      is "ruby red";
const string: str (NORNSTONE) is "norn Stone";
const string: str (PEARL)     is "pale pearl";
const string: str (OPAL)      is "opal Eye";
const string: str (GREENGEM)  is "green Gem";
const string: str (BLUEFLAME) is "blue Flame";
const string: str (PALANTIR)  is "Palantir";
const string: str (SILMARIL)  is "Silmaril";
const string: str (RUNESTAFF) is "Runestaff";
const string: str (ORBOFZOT)  is "*ORB OF ZOT*";
const func string: str (in objecttype param) is DYNAMIC;
*)

NOOBJECT->number  :=  0;
LAMP->number      :=  1;
RUBY->number      :=  2;
NORNSTONE->number :=  3;
PEARL->number     :=  4;
OPAL->number      :=  5;
GREENGEM->number  :=  6;
BLUEFLAME->number :=  7;
PALANTIR->number  :=  8;
SILMARIL->number  :=  9;
RUNESTAFF->number := 10;
ORBOFZOT->number  := 11;

const func integer: ord (in objecttype: obj) is func
  result
    var integer: num is 0;
  begin
    num := obj->number;
  end func;

NOOBJECT->name   := "nothing";
LAMP->name       := "lamp";
RUBY->name       := "ruby red";
NORNSTONE->name  := "norn Stone";
PEARL->name      := "pale pearl";
OPAL->name       := "opal Eye";
GREENGEM->name   := "green Gem";
BLUEFLAME->name  := "blue Flame";
PALANTIR->name   := "Palantir";
SILMARIL->name   := "Silmaril";
RUNESTAFF->name  := "Runestaff";
ORBOFZOT->name   := "*ORB OF ZOT*";

const func string: str (in objecttype: obj) is func
  result
    var string: stri is "";
  begin
    stri := obj->name;
  end func;


const type: animatetype is new enum
    NOBODY, KOBOLD, ORC, WOLF, GOBLIN, OGRE, TROLL, BEAR,
    MINOTAUR, GARGOYLE, CHIMERA, BALROG, DRAGON, VENDOR
  end enum;

const array animatetype: list_of_animates is [](NOBODY, KOBOLD, ORC, WOLF, GOBLIN, OGRE,
      TROLL, BEAR, MINOTAUR, GARGOYLE, CHIMERA, BALROG, DRAGON, VENDOR);

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: transtype is integer;
const transtype: NOTRANSFER is 1;
const transtype: SINKHOLE is 2;
const transtype: WARP is 3;

const type: occurtype is new enum
    NOOCCURANCE, LEECH, LETHARGY, FORGET,
    STEALARMOR, STEALWEAPON, STEALLAMP, STEALFLARES,
    STEALTREASURE, FINDGOLD, FINDFLARES
  end enum;

const type: directset is set of integer;

const array string: food_list is []("sandwiches", "stew", "soup", "burgers",
    "roast", "filet", "tace", "pie");

const array string: adjective_list is []("large", "strange", "ugly", "enormous",
    "forbidding", "horrible", "exotic", "ordinary");

const type: roomtype is new struct
    var directset: connections is EMPTY_SET;
    var transtype: transfer is NOTRANSFER;
    var occurtype: occurance is NOOCCURANCE;
    var animatetype: roomer is NOBODY;
    var contenttype: contents is EMPTYROOM;
    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 varptr roomtype;


var integer: dungeonNumber is 0;
var integer: strength is 0;
var integer: intelligence is 0;
var integer: dexterity is 0;
var integer: goldPieces is 10;
var integer: flares is 0;
var integer: armorStrength is 0;
var integer: monsterCount is 0;
var integer: turns is 0;
var integer: mealHour is 0;
var boolean: leaveCastle is FALSE;
var boolean: quitProgram is FALSE;
var boolean: living is TRUE;
var boolean: maleSex is TRUE;
var boolean: blind is FALSE;
var boolean: weaponBlocked is FALSE;
var boolean: haveLeech is FALSE;
var boolean: lethargic is FALSE;
var boolean: forgetting is FALSE;
var boolean: angryVendors is FALSE;
var speciestype: species is HUMAN;
var armortype: armor is NOARMOR;
var weapontype: weapon is NOWEAPON;
var integer: webCount is 0;
var integer: aggressionOfMonster is 0;
var integer: monsterStrength is 0;
var boolean: livingMonster is FALSE;
var boolean: activeMonster is FALSE;
var boolean: bribed is FALSE;
var roomref: currentRoom is roomref.NIL;

const type: room_arr1 is array roomtype;
const type: room_arr2 is array room_arr1;
const type: room_arr3 is array room_arr2;
var room_arr1: LABY1 is NUM_LEVELS times roomtype.value;
var room_arr2: LABY2 is SIZE_LABY times LABY1;
var room_arr3: LABYRINTH is SIZE_LABY times LABY2;
(* var array array array roomtype: LABYRINTH is SIZE_LABY times SIZE_LABY times NUM_LEVELS times roomtype.value; *)


const func integer: range_laby (in integer: number) is func
  result
    var integer: result is 0;
  begin (* range_laby *)
    result := succ(pred(number) mod SIZE_LABY);
  end func; (* range_laby *)


const func integer: range_level (in integer: number) is func
  result
    var integer: result is 0;
  begin (* range_level *)
    result := succ(pred(number) mod NUM_LEVELS);
  end func; (* range_level *)


const func integer: range18 (in integer: number) is func
  result
    var integer: result is 18;
  begin (* range18 *)
    if number <= 18 then
      result := number;
    end if;
  end func; (* range18 *)


const proc: startText is func
  begin (* startText *)
    writeln;
    writeln;
    writeln;
    writeln("*" mult 78);
    writeln;
    writeln("                       * * * THE WIZARD'S CASTLE * * *");
    writeln("                                 Version 1.0");
    writeln;
    writeln("                                Copyright 1990");
    writeln("                                      by");
    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, loosing his life  in  cruel  and  unimaginable");
    writeln(" ways.");
    writeln;
    writeln("All right, bold one.");
  end func; (* startText *)


const proc: execute (HELP) is func
  begin (* execute (HELP) *)
    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     F/LARE      LA/AMP");
    writeln("O/PEN       R/EAD       G/AZE       T/ELEPORT   DR/INK      SE/LL       B/UY");
    writeln("BR/IBE      Q/UIT");
    writeln;
    writeln("The contents of rooms are as follows:");
    writeln;
    writeln(". = EMPTY ROOM   D = STAIRS DOWN  O = CRYSTAL ORB  T = TREASURE     V = VENDOR");
    writeln("B = BOOK         E = EXIT         P = MAGIC POOL   U = STAIRS UP    W = WARP");
    writeln("C = CHEST        M = MONSTER      S = SINKHOLE");
    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; (* execute (HELP) *)


const func string: str (in object param) is DYNAMIC;


const proc: write_a (in object: obj) is func
  local
    var string: stri is "";
    var char: ch1 is ' ';
  begin (* write_a *)
    stri := str(obj);
    if stri <> "" then
      ch1 := upper(stri[1]);
      if ch1 = 'A' or ch1 = 'E' or ch1 = 'I' or ch1 = 'O' or ch1 = 'U' then
        write("an ");
      else
        write("a ");
      end if;
      write(stri);
    end if;
  end func; (* write_a *)


const proc: writeAnyFood is func
  begin (* writeAnyFood *)
    write(food_list[rand(1, length(food_list))]);
  end func;(* writeAnyFood *)


const proc: writeAnyAdjective is func
  begin (* writeAnyAdjective *)
    write_a(adjective_list[rand(1, length(adjective_list))]);
  end func; (* writeAnyAdjective *)


const proc: numberName (in integer: number) is func
  begin (* numberName *)
    if number <= 20 then
      case number of
        when { 0}: write("no");
        when { 1}: write("one");
        when { 2}: write("two");
        when { 3}: write("three");
        when { 4}: write("four");
        when { 5}: write("five");
        when { 6}: write("six");
        when { 7}: write("seven");
        when { 8}: write("eight");
        when { 9}: write("nine");
        when {10}: write("ten");
        when {11}: write("eleven");
        when {12}: write("twelve");
        when {13}: write("thirteen");
        when {14}: write("fourteen");
        when {15}: write("fivteen");
        when {16}: write("sixteen");
        when {17}: write("seventeen");
        when {18}: write("eightteen");
        when {19}: write("nineteen");
        when {20}: write("twenty");
      end case;
    else
      write(number);
    end if;
  end func; (* numberName *)


const proc: sexName (in boolean: is_male) is func
  begin (* sexName *)
    if is_male then
      write("male");
    else
      write("female");
    end if;
  end func; (* sexName *)


const proc: titleName (in boolean: is_male) is func

  begin (* titleName *)
    if is_male then
      write("sir");
    else
      write("madam");
    end if;
  end func; (* titleName *)


const func objecttype: rand (attr objecttype) is func
  result
    var objecttype: result is NOOBJECT;
  begin (* rand (objecttype) *)
    result := list_of_objects[rand(1, length(list_of_objects))];
  end func; (* rand (objecttype) *)


const func speciestype: rand (attr speciestype) is func
  result
    var speciestype: result is HUMAN;
  begin (* rand (speciestype) *)
    result := list_of_species[rand(1, length(list_of_species))];
  end func; (* rand (speciestype) *)


const func animatetype: rand (attr animatetype) is func
  result
    var animatetype: result is NOBODY;
  begin (* rand  (animatetype) *)
    result := list_of_animates[rand(2, pred(length(list_of_animates)))];
  end func; (* rand  (animatetype) *)


const func directtype: rand (DIRECTION) is func
  result
    var directtype: dir is NORTH;
  local
    var integer: quantity is 0;
    var integer: number is 0;
  begin (* rand (DIRECTION) *)
    quantity := card(currentRoom->connections);
    if quantity <> 0 then
      dir := NORTH;
      while dir not in currentRoom->connections do
        dir := succ(dir);
      end while;
      for number range 2 to rand(1, quantity) do
        repeat
          dir := succ(dir);
        until dir in currentRoom->connections;
      end for;
    end if;
  end func; (* rand (DIRECTION) *)


const func integer: count (OBJECTS) is func
  result
    var integer: count is 0;
  local
    var objecttype: obj is NOOBJECT;
  begin (* count (OBJECTS) *)
    for obj range list_of_objects do
      if obj->place = PLAYER then
        incr(count);
      end if;
    end for;
  end func; (* count (OBJECTS) *)


const func integer: count (TREASURES) is func
  result
    var integer: count is 0;
  local
    var objecttype: obj is NOOBJECT;
  begin (* count (TREASURES) *)
    for obj range list_of_treasures do
      if obj->place = PLAYER then
        incr(count);
      end if;
    end for;
  end func; (* count (TREASURES) *)


const func objecttype: one_of_owned (TREASURES) is func
  result
    var objecttype: obj is NOOBJECT;
  local
    var integer: number is 0;
    var integer: RANDOM_NUMBER is 0;
    var objecttype: OBJT is NOOBJECT;
  begin (* one_of_owned (TREASURES) *)
    if count(TREASURES) <> 0 then
      RANDOM_NUMBER := rand(1, count(TREASURES));
      for OBJT range list_of_treasures do
        if OBJT->place = PLAYER then
          incr(number);
          if number = RANDOM_NUMBER then
            obj := OBJT;
          end if;
        end if;
      end for;
    end if;
  end func; (* one_of_owned (TREASURES) *)


const proc: findGoldPieces (in integer: limit) is func
  local
    var integer: number is 0;
  begin (* findGoldPieces *)
    number := rand(2, limit);
    goldPieces +:= number;
    numberName(number);
    writeln(" gold pieces!");
    write("You now have ");
    numberName(goldPieces);
    writeln(" GP'S.");
  end func; (* findGoldPieces *)


const proc: findFlares (in integer: limit) is func
  local
    var integer: number is 0;
  begin (* findFlares *)
    number := rand(2, limit);
    flares +:= number;
    numberName(number);
    write(" flares. You now have ");
    numberName(flares);
    writeln(" flares.");
  end func; (* findFlares *)


const proc: RoomAdjective (in integer: number) is func
  begin (* RoomAdjective *)
    case number rem 11 of
      when { 0}: noop;
      when { 1}: write("luxurious ");
      when { 2}: write("expensive ");
      when { 3}: write("wonderful ");
      when { 4}: write("good ");
      when { 5}: write("worn out ");
      when { 6}: write("fine ");
      when { 7}: write("moss-grown ");
      when { 8}: write("old ");
      when { 9}: write("figured ");
      when {10}: write("patterned ");
    end case;
  end func; (* RoomAdjective *)


const proc: ARoomAdjective (in integer: number) is func
  begin (* ARoomAdjective *)
    case number rem 11 of
      when { 0}: write("a ");
      when { 1}: write_a("luxurious ");
      when { 2}: write_a("expensive ");
      when { 3}: write_a("wonderful ");
      when { 4}: write_a("good ");
      when { 5}: write_a("worn out ");
      when { 6}: write_a("fine ");
      when { 7}: write_a("moss-grown ");
      when { 8}: write_a("old ");
      when { 9}: write_a("figured ");
      when {10}: write_a("patterned ");
    end case;
  end func; (* ARoomAdjective *)


const proc: writeRoom (in roomref: a_room) is func
  local
    var integer: number is 0;
  begin (* writeRoom *)
    if a_room->contents = ENTRANCE then
      write("the entrance hall. ");
      writeln("To the North the castle can be left.");
    else
      number := 512 * pred(dungeonNumber) + 64 * pred(a_room->xPos) +
          8 * pred(a_room->yPos) + pred(a_room->zPos);
      case number 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_a("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_a("antique ");
        when {20}: write_a("old ");
        when {21}: write_a("dusty ");
        when {22}: write_a("dilapidated ");
      end case;
      case number 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 number 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 ");
          ARoomAdjective(number);
          write("parquet.");
        when {10}:
          write("with ");
          ARoomAdjective(number);
          write("stone-floor.");
        when {11}:
          write("with ");
          ARoomAdjective(number);
          write("rug lying on the floor.");
        when {12}:
          write("with ");
          ARoomAdjective(number);
          write("fresco at the wall.");
        when {13}:
          write("with ");
          RoomAdjective(number);
          write("walls made from granite.");
        when {14}:
          write("with ");
          RoomAdjective(number);
          write("panelling at the walls.");
        when {15}:
          write("with ");
          RoomAdjective(number);
          write("paintings at the ceiling.");
        when {16}:
          write("with a floor made out of ");
          RoomAdjective(number);
          write("marble.");
      end case;
      writeln;
    end if;
  end func; (* writeRoom *)


const proc: writeConnections (in roomref: a_room) is func
  local
    var integer: number is 0;
    var directtype: direction is NORTH;
  begin (* writeConnections *)
    if UP in a_room->connections or
        DOWN in a_room->connections then
      number := 64 * pred(dungeonNumber) + 8 * pred(a_room->xPos) +
          pred(a_room->yPos);
      case number 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 number rem 2 of
        when {0}: write("going ");
        when {1}: write("leading ");
      end case;
      if UP in a_room->connections and
          DOWN in a_room->connections then
        write("up and down");
      elsif UP in a_room->connections then
        write("up");
      else
        write("down");
      end if;
      number := 512 * pred(dungeonNumber) + (*!! 64 * pred(z1) + !!*)
          8 * pred(a_room->yPos) + pred(a_room->xPos);
      case number rem 4 of
        when {0}: writeln(" into deep darkness.");
        when {1}: writeln("ward into darkness.");
        when {2}: writeln("ward.");
        when {3}: writeln(".");
      end case;
    end if;
    number := card(a_room->connections);
    if number = 1 or number = 2 then
      write("The room can be left to the ");
      for direction range [](NORTH, SOUTH, EAST, WEST) do
        if direction in a_room->connections then
          write(direction);
          number := pred(number);
          if number = 1 then
            write(" and ");
          end if;
        end if;
      end for;
      writeln(".");
    elsif number = 3 then
      write("There is no way to the ");
      for direction range [](NORTH, SOUTH, EAST, WEST) do
        if direction not in a_room->connections then
          write(direction);
        end if;
      end for;
      writeln(".");
    end if;
  end func; (* writeConnections *)


const proc: writeThings (in roomref: a_room) is func
  local
    var contenttype: content is EMPTYROOM;
  begin (* writeThings *)
    content := a_room->contents;
    case content of
      when {EMPTYROOM}: noop;
      when {ENTRANCE}: noop;
      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 roomref: a_room) is func
  begin (* writeAnimates *)
    if a_room->roomer <> NOBODY then
      write("In this room is ");
      write_a(a_room->roomer);
      writeln(".");
    end if;
  end func; (* writeAnimates *)


const proc: writeObjects (in roomref: a_room) is func
  local
    var integer: count is 0;
    var integer: number is 0;
    var objecttype: obj is NOOBJECT;
  begin (* writeObjects *)
    if a_room->roomer = NOBODY then
      for obj range list_of_objects do
        if (a_room->xPos = obj->xPos) and
            (a_room->yPos = obj->yPos) and
            (a_room->zPos = obj->zPos) and
            (obj->place = ANYROOM) then
          incr(count);
        end if;
      end for;
      if count > 0 then
        write("This room contains ");
        for obj range list_of_objects do
          if (a_room->xPos = obj->xPos) and
              (a_room->yPos = obj->yPos) and
              (a_room->zPos = obj->zPos) and
              (obj->place = ANYROOM) then
            incr(number);
            if number = 1 then
              write("the ");
            elsif number = count then
              write(" and the ");
            else
              write(", the ");
            end if;
            write(obj->name);
          end if;
        end for;
        writeln(".");
      end if;
    end if;
  end func; (* writeObjects *)


const proc: writeRemark is func
  local
    var integer: number is 0;
  begin (* writeRemark *)
    if rand(1, 5) = 1 then
      if 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}:
              write("You touch ");
              writeAnyAdjective();
              writeln(" insect that immediately flies away.");
            when {8}:
              write("The smell of ");
              writeAnyFood();
              writeln(" 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}:
              write_a(rand(animatetype));
              writeln(" frying.");
            when {9}:
              write("the presence of a ");
              sexName(not maleSex);
              write(" ");
              write(species);
              writeln(".");
          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}:
              write("that a ");
              sexName(not maleSex);
              write(" ");
              write(rand(speciestype));
              writeln(" 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}:
              writeAnyAdjective();
              writeln(" footprint.");
            when {7}:
              writeAnyAdjective();
              writeln(" spider running away.");
            when {8}:
              write("the mirage of the ");
              write(rand(objecttype)->name);
              writeln(".");
          end case;
      end case;
    end if;
  end func; (* writeRemark *)


const proc: writePos (in roomref: a_room) is func
  begin (* writePos *)
    writeln("(" <& a_room->xPos <& ", " <& a_room->yPos <& ") Level: " <& a_room->zPos);
  end func; (* writePos *)


const proc: execute (LOOK) is func
  local
    var integer: number is 0;
    var objecttype: obj is NOOBJECT;
    var transtype: trans is NOTRANSFER;
  begin (* execute (LOOK) *)
    repeat
      currentRoom->visited := TRUE;
      writeln;
      write("You are in ");
      if blind then
        writeln("a new room.");
      else
        writeRoom(currentRoom);
      end if;
      trans := currentRoom->transfer;
      case trans of
        when {NOTRANSFER}: noop;
        when {SINKHOLE}:
          currentRoom := &LABYRINTH[currentRoom->xPos]
              [currentRoom->yPos][range_level(succ(currentRoom->zPos))];
          number := 512 * pred(dungeonNumber) +
              64 * pred(currentRoom->xPos) +
              8 * pred(currentRoom->yPos) +
              pred(currentRoom->zPos);
          case number 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 trapped 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;
        when {WARP}:
          currentRoom := &LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)];
          write("This room contains a warp. You have been transferred to ");
          writePos(currentRoom);
      end case;
    until trans = NOTRANSFER;
    writeConnections(currentRoom);
    writeThings(currentRoom);
    writeAnimates(currentRoom);
    writeObjects(currentRoom);
    if currentRoom->roomer = NOBODY then
      for obj range list_of_objects do
        if (currentRoom->xPos = obj->xPos) and
            (currentRoom->yPos = obj->yPos) and
            (currentRoom->zPos = obj->zPos) and
            (obj->place = ANYROOM) then
          obj->place := PLAYER;
        end if;
      end for;
    end if;
  end func; (* execute (LOOK) *)


const proc: execute (STATUS) is func
  begin (* execute (STATUS) *)
    writeln;
    if not blind then
      write("You are at ");
      writePos(currentRoom);
      writeln;
    end if;
    writeln("STRENGTH = " <& strength <&
            "  INTELLIGENCE = " <& intelligence <&
            "  DEXTERITY = " <& dexterity);
    writeln("OBJECTS = " <& count(OBJECTS) <&
            "  FLARES = " <& flares <&
            "  GOLD PIECES = " <& goldPieces);
    writeln("weapon = " <& weapon <& "  armor = " <& armor);
  end func; (* execute (STATUS) *)


const proc: listInventory is func
  local
    var boolean: anythinglisted is FALSE;
    var objecttype: obj is NOOBJECT;
  begin (* listInventory *)
    if weapon <> NOWEAPON then
      anythinglisted := TRUE;
      writeln("  a " <& weapon);
    end if;
    if armor <> NOARMOR then
      anythinglisted := TRUE;
      writeln("  " <& armor <& " armor");
    end if;
    if flares > 0 then
      anythinglisted := TRUE;
      write("  ");
      numberName(flares);
      write(" flare");
      if flares <> 1 then
        write("s");
      end if;
      writeln;
    end if;
    if goldPieces > 0 then
      anythinglisted := TRUE;
      write("  ");
      numberName(goldPieces);
      write(" gold piece");
      if goldPieces <> 1 then
        write("s");
      end if;
      writeln;
    end if;
    for obj range list_of_objects do
      if obj->place = PLAYER then
        anythinglisted := TRUE;
        writeln("  the " <& obj->name);
      end if;
    end for;
    if not anythinglisted then
      writeln("  nothing");
    end if;
  end func; (* listInventory *)


const proc: readChar (inout char: ch) is func
  local
    var string: stri is "";
  begin (* readChar *)
    readln(stri);
    if stri <> "" then
      ch := upper(stri[1]);
    else
      ch := '\0\';
    end if;
  end func; (* readChar *)


const proc: readChoice (inout char: ch) is func
  begin (* readChoice *)
    writeln;
    write("Your choice? ");
    readChar(ch);
  end func; (* readChoice *)


const proc: readNumber (inout integer: number, inout boolean: okay, inout boolean: quit) is func
  local
    var string: stri is "";
  begin (* readNumber *)
    number := 0;
    okay := TRUE;
    readln(stri);
    if stri <> "" then
      if upper(stri) = "Q" then
        okay := FALSE;
        quit := TRUE;
      else
        block
          number := integer parse stri;
        exception
          catch RANGE_ERROR:
            okay := FALSE;
        end block;
      end if;
    end if;
  end func; (* readNumber *)


const func boolean: availTreasure (in roomref: a_room) is func
  result
    var boolean: found is FALSE;
  local
    var objecttype: obj is NOOBJECT;
  begin (* availTreasure *)
    for obj range list_of_objects do
      if (a_room->xPos = obj->xPos) and
          (a_room->yPos = obj->yPos) and
          (a_room->zPos = obj->zPos) and
          (obj->place = ANYROOM) then
        found := TRUE;
      end if;
    end for;
  end func; (* availTreasure *)


const proc: findNormalRoom (inout integer: x1, inout integer: y1, in integer: z1) is func
  begin (* findNormalRoom *)
    repeat
      x1 := rand(1, SIZE_LABY);
      y1 := rand(1, SIZE_LABY);
(*!!
write(x1 <& " " <& y1 <& " ");
TRACE(LABYRINTH[x1][y1][z1].contents);
writeln;
*)
    until LABYRINTH[x1][y1][z1].contents = EMPTYROOM;
  end func; (* findNormalRoom *)


const proc: findUninhabitedRoom (inout integer: x1, inout integer: y1, in integer: z1) is func
  begin (* findUninhabitedRoom *)
    repeat
      x1 := rand(1, SIZE_LABY);
      y1 := rand(1, SIZE_LABY);
    until LABYRINTH[x1][y1][z1].roomer = NOBODY and
        LABYRINTH[x1][y1][z1].contents <> ENTRANCE;
  end func; (* findUninhabitedRoom *)


const proc: findEmptyRoom (inout integer: x1, inout integer: y1, in integer: z1) is func
  begin (* findEmptyRoom *)
    repeat
      x1 := rand(1, SIZE_LABY);
      y1 := rand(1, SIZE_LABY);
    until LABYRINTH[x1][y1][z1].transfer = NOTRANSFER and
        LABYRINTH[x1][y1][z1].roomer = NOBODY and
        LABYRINTH[x1][y1][z1].contents = EMPTYROOM and
        LABYRINTH[x1][y1][z1].occurance = NOOCCURANCE and
        not availTreasure(&LABYRINTH[x1][y1][z1]);
  end func; (* findEmptyRoom *)


const proc: initScalars is func
  begin (* initScalars *)
    dungeonNumber := rand(1, 50);
    turns := 1;
    living := TRUE;
    blind := FALSE;
    species := HUMAN;
    maleSex := TRUE;
    strength := 2;
    intelligence := 8;
    dexterity := 14;
    goldPieces := 10;
    armor := NOARMOR;
    armorStrength := 0;
    weapon := NOWEAPON;
    weaponBlocked := FALSE;
    flares := 0;
    mealHour := 0;
    angryVendors := FALSE;
    livingMonster := FALSE;
    haveLeech := FALSE;
    lethargic := FALSE;
    forgetting := FALSE;
    leaveCastle := FALSE;
    quitProgram := FALSE;
  end func; (* initScalars *)


const proc: initVars is func
  local
    var integer: number is 0;
    var integer: count is 0;
    var integer: x1 is 0;
    var integer: y1 is 0;
    var integer: z1 is 0;
    var contenttype: content is EMPTYROOM;
    var objecttype: obj is NOOBJECT;
    var animatetype: animate is NOBODY;
    const directset: way_nsew is {NORTH, SOUTH, EAST, WEST};
    const directset: way_sew is  {       SOUTH, EAST, WEST};
    const directset: way_new is  {NORTH,        EAST, WEST};
    const directset: way_nsw is  {NORTH, SOUTH,       WEST};
    const directset: way_nse is  {NORTH, SOUTH, EAST      };
    const directset: way_ns is   {NORTH, SOUTH            };
    const directset: way_ne is   {NORTH,        EAST      };
    const directset: way_nw is   {NORTH,              WEST};
    const directset: way_se is   {       SOUTH, EAST      };
    const directset: way_sw is   {       SOUTH,       WEST};
    const directset: way_ew is   {              EAST, WEST};
    const directset: way_n is    {NORTH                   };
    const directset: way_s is    {       SOUTH            };
    const directset: way_e is    {              EAST      };
    const directset: way_w is    {                    WEST};
    var roomref: a_room is roomref.NIL;
  begin (* initVars *)
    for x1 range 1 to SIZE_LABY do
      for y1 range 1 to SIZE_LABY do
        for z1 range 1 to NUM_LEVELS do
          a_room := &LABYRINTH[x1][y1][z1];
          a_room->contents := EMPTYROOM;
          a_room->visited := FALSE;
          a_room->roomer := NOBODY;
          a_room->connections := way_nsew;
          a_room->transfer := NOTRANSFER;
          a_room->occurance := NOOCCURANCE;
          a_room->xPos := x1;
          a_room->yPos := y1;
          a_room->zPos := z1;
        end for;
        write(".");
        flush(OUT);
      end for;
    end for;
    writeln;
    for number range 1 to 5 do
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_sew;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_new;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_nsw;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_nse;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_ns;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_ne;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_nw;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_se;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_sw;
      LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].connections := way_ew;
    end for;
    for z1 range 1 to NUM_LEVELS do
      x1 := rand(1, SIZE_LABY);
      y1 := rand(1, SIZE_LABY);
      case rand(1, 4) of
        when {1}:
          LABYRINTH[x1][y1][z1].connections := way_n;
        when {2}:
          LABYRINTH[x1][y1][z1].connections := way_s;
        when {3}:
          LABYRINTH[x1][y1][z1].connections := way_e;
        when {4}:
          LABYRINTH[x1][y1][z1].connections := way_w;
      end case;
    end for;
    (*
    for x1 range 1 to SIZE_LABY do
      for y1 range 1 to SIZE_LABY do
        for z1 range 1 to NUM_LEVELS do
          a_room := &LABYRINTH[x1][y1][z1];
          write(x1 <& y1 <& z1 <& " " <& LABYRINTH[x1][y1][z1].contents);
          writeln(" " <& a_room->connections);
        end for;
      end for;
    end for;
    *)
    a_room := &LABYRINTH[1][range_laby(4)][1];
    a_room->connections := way_nsew;
    a_room->contents := ENTRANCE;
    a_room->visited := TRUE;
    for z1 range 1 to pred(NUM_LEVELS) do
      for number range 1 to 3 do
        x1 := rand(1, SIZE_LABY);
        y1 := rand(1, SIZE_LABY);
        incl(LABYRINTH[x1][y1][z1].connections, DOWN);
        incl(LABYRINTH[x1][y1][succ(z1)].connections, UP);
      end for;
    end for;
    for z1 range 1 to NUM_LEVELS do
      for count range 1 to THINGS_PER_LEVEL do
        for content range [](CLOSEDCHEST, ORB, POOL, BOOK) do
          findNormalRoom(x1, y1, z1);
          LABYRINTH[x1][y1][z1].contents := content;
        end for;
      end for;
    end for;
    for z1 range 1 to NUM_LEVELS do
      for animate range list_of_animates do
        findUninhabitedRoom(x1, y1, z1);
        LABYRINTH[x1][y1][z1].roomer := animate;
      end for;
      for count range 1 to VENDORS_PER_LEVEL do
        findUninhabitedRoom(x1, y1, z1);
        LABYRINTH[x1][y1][z1].roomer := VENDOR;
      end for;
    end for;
    monsterCount := 96;
    LAMP->place := NOWHERE;
    for obj range list_of_treasures do
      obj->place := ANYROOM;
      obj->xPos := rand(1, SIZE_LABY);
      obj->yPos := rand(1, SIZE_LABY);
      obj->zPos := rand(1, NUM_LEVELS);
    end for;
    z1 := rand(1, NUM_LEVELS);
    animate := rand(animatetype);
    findUninhabitedRoom(x1, y1, z1);
    LABYRINTH[x1][y1][z1].roomer := animate;
    RUNESTAFF->place := ANYROOM;
    RUNESTAFF->xPos := x1;
    RUNESTAFF->yPos := y1;
    RUNESTAFF->zPos := z1;
    z1 := rand(1, NUM_LEVELS);
    findEmptyRoom(x1, y1, z1);
    LABYRINTH[x1][y1][z1].transfer := WARP;
    ORBOFZOT->place := NOWHERE;
    ORBOFZOT->xPos := x1;
    ORBOFZOT->yPos := y1;
    ORBOFZOT->zPos := z1;
    for z1 range 1 to NUM_LEVELS do
      for count range 1 to OCCURANCES_PER_LEVEL do
        LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][z1].occurance := FINDGOLD;
        LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][z1].occurance := FINDFLARES;
      end for;
    end for;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := LEECH;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := LETHARGY;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := FORGET;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := STEALARMOR;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := STEALWEAPON;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := STEALLAMP;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := STEALFLARES;
    LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].occurance := STEALTREASURE;
    for z1 range 1 to NUM_LEVELS do
      for count range 1 to TRANSFERS_PER_LEVEL do
        findEmptyRoom(x1, y1, z1);
        LABYRINTH[x1][y1][z1].transfer := SINKHOLE;
        findEmptyRoom(x1, y1, z1);
        LABYRINTH[x1][y1][z1].transfer := WARP;
      end for;
    end for;
  end func; (* initVars *)


const proc: readSpecies is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* readSpecies *)
    if not quitProgram then
      repeat
        okay := TRUE;
        writeln;
        writeln("You may be an elf, dwarf, man, or hobbit.");
        readChoice(ch);
        case ch of
          when {'H'}:   species := HOBBIT;
          when {'E'}:   species := ELF;
          when {'M'}:   species := HUMAN;
          when {'D'}:   species := DWARF;
          when {'Q'}:   quitProgram := 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 is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* readSex *)
    if not quitProgram then
      repeat
        okay := TRUE;
        writeln;
        write("Which sex do you prefer? ");
        readChar(ch);
        case ch of
          when {'M'}:   maleSex := TRUE;
          when {'F'}:   maleSex := FALSE;
          when {'Q'}:   quitProgram := TRUE;
          otherwise:
            okay := FALSE;
            writeln;
            writeln("** Cute " <& species <& ", real cute. Try M, F or Q.");
        end case;
      until okay;
    end if;
  end func; (* readSex *)


const proc: riseAttribute (in string: attr_name, inout integer: attribute,
    inout integer: otherpoints) is func
  local
    var integer: number is 0;
    var boolean: okay is TRUE;
  begin (* riseAttribute *)
    repeat
      writeln;
      write("How many points do you wish to add to your " <& attr_name <& "? ");
      readNumber(number, okay, quitProgram);
      if not quitProgram then
        if okay then
          if number > otherpoints then
            writeln;
            write("** Dear " <& species <& ", you have only ");
            numberName(otherpoints);
            if otherpoints = 1 then
              writeln(" point.");
            else
              writeln(" points.");
            end if;
            okay := FALSE;
          end if;
        else
          writeln;
          writeln("** Would you please be so kind to type a number or q, " <&
                  species <& ".");
        end if;
      end if;
    until okay or quitProgram;
    if okay then
      attribute +:= number;
      otherpoints -:= number;
    end if;
  end func; (* riseAttribute *)


const proc: readAttributes is func
  local
    var integer: otherpoints is 0;
  begin (* readAttributes *)
    if not quitProgram then
      strength := 4 + 2 * ord(species);
      intelligence := 8;
      dexterity := 12 - 2 * ord(species);
      if species = HOBBIT then
        otherpoints := 4;
      else
        otherpoints := 8;
      end if;
      writeln;
      writeln("Ok, " <& species <& ", you have the following attributes:");
      writeln("STRENGTH = " <& strength <&
              "  INTELLIGENCE = " <& intelligence <&
              "  DEXTERITY = " <& dexterity);
      writeln("and " <& otherpoints <& " other points to allocate as you wish.");
      riseAttribute("strength", strength, otherpoints);
      if not quitProgram and (otherpoints > 0) then
        riseAttribute("intelligence", intelligence, otherpoints);
        if not quitProgram and (otherpoints > 0) then
          riseAttribute("dexterity", dexterity, otherpoints);
        end if;
      end if;
      if not quitProgram and (otherpoints > 0) then
        writeln;
        write("I am sure that you can never use the saved ");
        if otherpoints = 1 then
          writeln("point.");
        else
          numberName(otherpoints);
          writeln(" points.");
        end if;
      end if;
    end if;
  end func; (* readAttributes *)


const proc: buyAttribute (in string: attr_name, inout integer: attribute,
    in integer: price, inout boolean: quit) is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* buyAttribute *)
    if not quit and (goldPieces >= price) then
      repeat
        repeat
          okay := TRUE;
          writeln;
          writeln("Your " <& attr_name <& " is now " <& attribute <&
                  " and you have " <& goldPieces <& " GP'S.");
          write("Do you want to buy a potion of " <& attr_name <&
                " for " <& price <& " GP'S? ");
          readChar(ch);
          case ch of
            when {'Y'}:
              goldPieces -:= price;
              attribute := range18(attribute + rand(1, 6));
            when {'N'}: noop;
            when {'Q'}:
              quit := TRUE;
            otherwise:
              okay := FALSE;
              writeln;
              writeln("** Please answer Y, N or Q.");
          end case;
        until okay;
      until ch <> 'Y' or goldPieces < price;
      if ch <> 'Q' and goldPieces < price then
        writeln;
        writeln("Your " <& attr_name <& " is now " <& attribute <& ".");
      end if;
    end if;
  end func; (* buyAttribute *)


const proc: buyArmor (
    in integer: price_of_plate,
    in integer: price_of_chainmail,
    in integer: price_of_leather,
    inout boolean: quit) is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* buyArmor *)
    if not quit and (goldPieces >= price_of_leather) then
      writeln;
      writeln("Ok, " <& species <& ", you have " <& goldPieces <&
              " gold pieces (GP'S) and " <& armor <& " armor.");
      repeat
        okay := TRUE;
        writeln("These are the types of armor you can buy:");
        writeln;
        if goldPieces >= price_of_plate then
          writeln("  P/LATE     " <& price_of_plate lpad 4 <& " GP'S");
        end if;
        if goldPieces >= price_of_chainmail then
          writeln("  C/HAINMAIL " <& price_of_chainmail lpad 4 <& " GP'S");
        end if;
        writeln("  L/EATHER   " <& price_of_leather lpad 4 <& " GP'S");
        writeln("  N/OTHING      0 GP'S");
        readChoice(ch);
        if (ch <> 'P' or goldPieces < price_of_plate) and
            (ch <> 'C' or goldPieces < price_of_chainmail) and
            ch <> 'L' and ch <> 'N' and ch <> 'Q' then
          okay := FALSE;
          writeln;
          write("** Are you ");
          write_a(species);
          write(" or ");
          write_a(rand(animatetype));
          writeln("?");
          writeln;
        end if;
      until okay;
      case ch of
        when {'P'}:
          armor := PLATE;
          armorStrength := ord(armor) * 7;
          goldPieces -:= price_of_plate;
        when {'C'}:
          armor := CHAINMAIL;
          armorStrength := ord(armor) * 7;
          goldPieces -:= price_of_chainmail;
        when {'L'}:
          armor := LEATHER;
          armorStrength := ord(armor) * 7;
          goldPieces -:= price_of_leather;
        when {'N'}: noop;
        when {'Q'}:
          quit := TRUE;
      end case;
    end if;
  end func; (* buyArmor *)


const proc: buyWeapon (
    in integer: price_of_sword,
    in integer: price_of_mace,
    in integer: price_of_dagger,
    inout boolean: quit) is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* buyWeapon *)
    if not quit and (goldPieces >= price_of_dagger) then
      writeln;
      write("Ok, ");
      if armor <> NOARMOR then
        write("bold ");
      end if;
      write(species <& ", you have " <& goldPieces <& " GP'S left and ");
      if weapon = NOWEAPON then
        writeln("no weapon.");
      else
        write_a(weapon);
        writeln(".");
      end if;
      repeat
        okay := TRUE;
        writeln("These are the types of weapons you can buy:");
        writeln;
        if goldPieces >= price_of_sword then
          writeln("  S/WORD     " <& price_of_sword lpad 4 <& " GP'S");
        end if;
        if goldPieces >= price_of_mace then
          writeln("  M/ACE      " <& price_of_mace lpad 4 <& " GP'S");
        end if;
        writeln("  D/AGGER    " <& price_of_dagger lpad 4 <& " GP'S");
        writeln("  N/OTHING      0 GP'S");
        readChoice(ch);
        if (ch <> 'S' or goldPieces < price_of_sword) and
            (ch <> 'M' or goldPieces < price_of_mace) and
            ch <> 'D' and ch <> 'N' and ch <> 'Q' then
          okay := FALSE;
          writeln;
          write("** Is your intelligence really ");
          numberName(intelligence);
          writeln("?");
          writeln;
        end if;
      until okay;
      case ch of
        when {'S'}:
          weapon := SWORD;
          goldPieces -:= price_of_sword;
        when {'M'}:
          weapon := MACE;
          goldPieces -:= price_of_mace;
        when {'D'}:
          weapon := DAGGER;
          goldPieces -:= price_of_dagger;
        when {'N'}: noop;
        when {'Q'}:
          quit := TRUE;
      end case;
    end if;
  end func; (* buyWeapon *)


const proc: buyLamp (in integer: price, inout boolean: quit) is func
  local
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* buyLamp *)
    if not quit and LAMP->place <> PLAYER and
        goldPieces >= price then
      repeat
        okay := TRUE;
        writeln;
        write("Do you want to buy a lamp for " <& price <& " GP'S? ");
        readChar(ch);
        case ch of
          when {'Y'}:
            if price > 10 then
              writeln;
              writeln("It's guaranteed to outlive you.");
            end if;
            LAMP->place := PLAYER;
            goldPieces -:= price;
          when {'N'}: noop;
          when {'Q'}:
            quit := TRUE;
          otherwise:
            okay := FALSE;
            writeln;
            writeln("** Please answer Y, N or Q.");
        end case;
      until okay;
    end if;
  end func; (* buyLamp *)


const proc: readFlares is func
  local
    var integer: number is 0;
    var boolean: okay is TRUE;
  begin (* readFlares *)
    if not quitProgram and (goldPieces >= 1) then
      writeln;
      writeln("Ok, " <& species <& ", you have " <& goldPieces <& " GP'S left.");
      repeat
        writeln;
        write("Five flares cost 1 GP. How many do you want? ");
        readNumber(number, okay, quitProgram);
        if not quitProgram then
          if okay then
            if number > 5 * goldPieces then
              writeln;
              writeln("** You can afford only " <& 5 * 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 quitProgram;
      if okay then
        flares +:= number;
        goldPieces -:= (number + 4) div 5;
      end if;
    end if;
  end func; (* readFlares *)


const proc: sellTreasures (inout boolean: quit) is func
  local
    var integer: price is 0;
    var objecttype: obj is NOOBJECT;
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* sellTreasures *)
    for obj range list_of_treasures & [](RUNESTAFF, ORBOFZOT) do
      if not quit and (obj->place = PLAYER) then
        price := rand(1, 150) +
            150 * pred(rand(1, succ(ord(obj) - ord(RUBY))));
        repeat
          okay := TRUE;
          writeln;
          write("Do you want to sell the " <& obj->name <&
                " for " <& price <& " GP'S? ");
          readChar(ch);
          case ch of
            when {'Y'}:
              obj->place := NOWHERE;
              goldPieces +:= price;
            when {'N'}: noop;
            when {'Q'}:
              quit := 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: buyTreasures (inout boolean: quit) is func
  local
    var integer: price is 0;
    var objecttype: obj is NOOBJECT;
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* buyTreasures *)
    for obj range list_of_treasures do
      if not quit and (obj->place <> PLAYER) then
        price := 125 * succ(ord(obj) - ord(RUBY)) + rand(1, 250) +
            250 * pred(rand(1, succ(ord(obj) - ord(RUBY))));
        if price <= goldPieces then
          repeat
            okay := TRUE;
            writeln;
            write("Do you want to buy the " <& obj->name <&
                  " for " <& price <& " GP'S? ");
            readChar(ch);
            case ch of
              when {'Y'}:
                obj->place := PLAYER;
                goldPieces -:= price;
              when {'N'}: noop;
              when {'Q'}:
                quit := 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: execute (SELL) is func
  local
    var boolean: quit is FALSE;
  begin (* execute (SELL) *)
    quit := FALSE;
    if currentRoom->roomer <> VENDOR then
      writeln;
      writeln("** You can only sell to a vendor!");
    elsif count(TREASURES) = 0 then
      writeln;
      writeln("** You have nothing to offer!");
    else
      sellTreasures(quit);
    end if;
  end func; (* execute (SELL) *)


const proc: execute (BUY) is func
  local
    var boolean: quit is FALSE;
  begin (* execute (BUY) *)
    quit := FALSE;
    if currentRoom->roomer <> VENDOR then
      writeln;
      writeln("** You can only buy from a vendor!");
    elsif 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, " <& species <& ".");
        when { 9}:
          writeln("You're too poor to trade, " <& species <& ".");
        when {10}:
          writeln("I don't trade with a beggar, " <& species <& ".");
        when {11}:
          write("Even ");
          write_a(rand(animatetype));
          writeln(" knows that money is need for trading.");
        when {12}:
          write("With ");
          numberName(goldPieces);
          writeln(" GP'S no trade can be done.");
        when {13}:
          write("It's typical for ");
          sexName(maleSex);
          writeln(" " <& species <&
                  " that they want to trade without enough money.");
        when {14}:
          write("Sorry ");
          titleName(maleSex);
          writeln(" I'm afraid I don't give credit.");
      end case;
    else
      buyArmor(200, 150, 125, quit);
      buyWeapon(200, 150, 125, quit);
      buyAttribute("strength",     strength,     100, quit);
      buyAttribute("intelligence", intelligence, 100, quit);
      buyAttribute("dexterity",    dexterity,    100, quit);
      buyLamp(100, quit);
      buyTreasures(quit);
    end if;
  end func; (* execute (BUY) *)


const proc: checkArmor (in integer: strike) is func
  local
    var integer: number is 0;
  begin (* checkArmor *)
    if armor <> NOARMOR then
      number := strike - ord(armor);
      armorStrength -:= ord(armor);
      if number < 0 then
        armorStrength -:= number;
        number := 0;
      end if;
      if armorStrength < 0 then
        armorStrength := 0;
        armor := NOARMOR;
        writeln;
        writeln("YOUR ARMOR HAS BEEN DESTROYED . . . GOOD LUCK!");
      end if;
    end if;
    strength -:= number;
  end func; (* checkArmor *)


const proc: contentInfo (in roomref: a_room) is func
  begin (* contentInfo *)
    case a_room->transfer of
      when {NOTRANSFER}:
        if a_room->roomer = NOBODY then
          if a_room->contents <> EMPTYROOM then
            case a_room->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 availTreasure(a_room) then
            write("T");
          elsif UP in a_room->connections then
            write("U");
          elsif DOWN in a_room->connections then
            write("D");
          else
            write(".");
          end if;
        elsif a_room->roomer = VENDOR then
          write("V");
        else
          write("M");
        end if;
      when {SINKHOLE}: write("S");
      when {WARP}:     write("W");
    end case;
  end func; (* contentInfo *)


const proc: execute (MAP) is func
  local
    var integer: x1 is 0;
    var integer: y1 is 0;
    var integer: z1 is 0;
    var roomref: a_room is roomref.NIL;
  begin (* execute (MAP) *)
    writeln;
    if blind then
      writeln("** You are blind, you dumb " <& species <& "!");
    else
      z1 := currentRoom->zPos;
      for x1 range 1 to SIZE_LABY do
        for y1 range 1 to SIZE_LABY do
          a_room := &LABYRINTH[x1][y1][z1];
          if a_room->visited then
            if a_room = currentRoom then
              write("<");
              contentInfo(currentRoom);
              write(">  ");
            else
              write(" ");
              contentInfo(a_room);
              write("   ");
            end if;
          else
            write("     ");
          end if;
        end for;
        writeln;
        writeln;
      end for;
      write("You are at ");
      writePos(currentRoom);
    end if;
  end func; (* execute (MAP) *)


const proc: execute (FLARE) is func
  local
    var integer: num1 is 0;
    var integer: num2 is 0;
    var integer: x1 is 0;
    var integer: y1 is 0;
    var integer: z1 is 0;
    var roomref: a_room is roomref.NIL;
  begin (* execute (FLARE) *)
    writeln;
    if flares = 0 then
      writeln("** Hey, bright one, you're out of flares!");
    elsif blind then
      writeln("** You can't see anything, you dumb " <& species <& "!");
    else
      decr(flares);
      z1 := currentRoom->zPos;
      for num1 range pred(currentRoom->xPos) to succ(currentRoom->xPos) do
        x1 := range_laby(num1);
        for num2 range pred(currentRoom->yPos) to succ(currentRoom->yPos) do
          y1 := range_laby(num2);
          a_room := &LABYRINTH[x1][y1][z1];
          a_room->visited := TRUE;
          write(" ");
          contentInfo(a_room);
          write("   ");
        end for;
        writeln;
        writeln;
      end for;
      write("You are at ");
      writePos(currentRoom);
    end if;
  end func; (* execute (FLARE) *)


const proc: execute (LIGHT) is func
  local
    var integer: x1 is 0;
    var integer: y1 is 0;
    var integer: z1 is 0;
    var char: ch is ' ';
    var roomref: a_room is roomref.NIL;
  begin (* execute (LIGHT) *)
    writeln;
    if LAMP->place <> PLAYER then
      writeln("** You don't have a lamp, " <& species <& "!");
    elsif blind then
      writeln("** You are blind, you dumb " <& species <& "!");
    else
      write("Where do you want to shine the lamp (N, S, E, W)? ");
      readChar(ch);
      if not ch in {'N', 'S', 'E', 'W'} then
        writeln;
        writeln("** That's not a direction, " <& species <& "!");
      else
        x1 := currentRoom->xPos;
        y1 := currentRoom->yPos;
        z1 := currentRoom->zPos;
        case ch of
          when {'N'}: x1 := range_laby(pred(x1));
          when {'S'}: x1 := range_laby(succ(x1));
          when {'W'}: y1 := range_laby(pred(y1));
          when {'E'}: y1 := range_laby(succ(y1));
        end case;
        a_room := &LABYRINTH[x1][y1][z1];
        a_room->visited := TRUE;
        writeln;
        write("The lamp shines into a room at ");
        writePos(a_room);
        write("You see ");
        writeRoom(a_room);
        writeConnections(a_room);
        writeAnimates(a_room);
        writeObjects(a_room);
      end if;
    end if;
  end func; (* execute (LIGHT) *)


const proc: execute (DRINK) is func
  local
    var integer: number is 0;
  begin (* execute (DRINK) *)
    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}:
          strength := range18(strength + rand(1, 3));
          writeln("feel stronger.");

        when {2}:
          strength -:= rand(1, 3);
          writeln("feel weaker.");
          if strength < 1 then
            living := FALSE;
          end if;

        when {3}:
          intelligence := range18(intelligence + rand(1, 3));
          writeln("feel smarter.");

        when {4}:
          intelligence -:= rand(1, 3);
          writeln("feel dumber.");
          if intelligence < 1 then
            living := FALSE;
          end if;

        when {5}:
          dexterity := range18(dexterity + rand(1, 3));
          writeln("feel nimbler.");

        when {6}:
          dexterity -:= rand(1, 3);
          writeln("feel clumsier.");
          if dexterity < 1 then
            living := FALSE;
          end if;

        when {7}:
          number := rand(0, 2);
          if number >= ord(species) then
            number := succ(number);
          end if;
          species := list_of_species[succ(number)];
          write("become ");
          write_a(species);
          writeln(".");

        when {8}:
          maleSex := not maleSex;
          write("turn into a ");
          sexName(maleSex);
          writeln(" " <& species <& ".");
      end case;
    end if;
  end func; (* execute (DRINK) *)


const proc: execute (READ) is func
  begin (* execute (READ) *)
    writeln;
    if currentRoom->contents <> BOOK then
      writeln("** There is nothing that can be read!");
    else
      writeln("You open the book and");
      case rand(1, 6) of

        when {1}:
          writeln("Flash! Oh no! You are now a blind " <& species <& "!");
          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 " <& species <&
                      " who finds a book and then dies.");
            when {4}:
              write("It's volume number ");
              numberName(rand(1, 20));
              writeln(" 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!");
          dexterity := 18;

        when {5}:
          writeln("It's a manual of strength!");
          strength := 18;

        when {6}:
          writeln("The book sticks to your hands -");
          writeln("Now you are unable to draw your weapon!");
          weaponBlocked := TRUE;
      end case;
      currentRoom->contents := EMPTYROOM;
    end if;
  end func; (* execute (READ) *)


const proc: viewOrb is func
  local
    var roomref: a_room is roomref.NIL;
  begin (* viewOrb *)
    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}:
            write_a(rand(animatetype));
            writeln(" killing you!");
          when {8}:
            write_a(rand(speciestype));
            writeln(" finding your faded bones!");
          when {9}:
            write_a(rand(speciestype));
            write(" which tells ");
            write_a(rand(speciestype));
            writeln(" that you are dead!");
          when {10}:
            write("a ");
            sexName(not maleSex);
            writeln(" " <& species <& " giving flowers on your grave!");
        end case;
        decr(strength);
        write("This message makes you weaker. Your strength is now ");
        if strength < 1 then
          living := FALSE;
          writeln("zero!");
        else
          numberName(strength);
          writeln(".");
        end if;

      when {2}:
        case rand(1, 4) of
          when {1}:
            write("yourself drinking from a pool and becoming ");
            write_a(rand(animatetype));
            writeln("!");
          when {2}:
            write_a(rand(animatetype));
            write(" drinking from a pool and becoming ");
            write_a(rand(speciestype));
            writeln(".");
          when {3}:
            write_a(rand(speciestype));
            write(" drinking from a pool and becoming ");
            writeAnyAdjective();
            writeln(" spider.");
          when {4}:
            write("a young ");
            if rand(FALSE, TRUE) then
              write("man");
            else
              write("woman");
            end if;
            writeln(" drinking from a pool and becoming as old as the hills.");
        end case;

      when {3}:
        case rand(1, 2) of
          when {1}:
            write_a(rand(animatetype));
            writeln(" gazing back at you.");
          when {2}:
            write("that you are watched from ");
            write_a(rand(speciestype));
            writeln(".");
        end case;

      when {4}:
        a_room := &LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)];
        a_room->visited := TRUE;
        writeRoom(a_room);
        writeConnections(a_room);
        write("You can also see that this room is at ");
        writePos(a_room);
        writeAnimates(a_room);
        writeObjects(a_room);

      when {5}:
        write("the *ORB OF ZOT* at ");
        if rand(FALSE, TRUE) then
          writePos(&LABYRINTH[ORBOFZOT->xPos][ORBOFZOT->yPos][ORBOFZOT->zPos]);
        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}:
            write_a(rand(speciestype));
            writeln(" announcing todays program of the orb.");
        end case;
    end case;
  end func; (* viewOrb *)


const proc: execute (GAZE) is func
  begin (* execute (GAZE) *)
    writeln;
    if blind then
      writeln("** You can't see anything, you dumb " <& 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}:
          viewOrb();
      end case;
    elsif currentRoom->roomer = VENDOR then
      write("You are gazing at the Vendor. ");
      if maleSex then
        writeln("But the Vendor does not like male " <& species <& ".");
      else
        writeln("The Vendor smiles and shows his wedding-ring.");
      end if;
    else
      write("The " <& currentRoom->roomer);
      if maleSex then
        writeln(" is shocked by the scowl of a strong male " <& species <& ".");
        activeMonster := FALSE;
      else
        writeln(" cannot be shocked by the scowl of a female " <& species <& ".");
      end if;
    end if;
  end func; (* execute (GAZE) *)


const proc: monsterDies (in animatetype: monster, inout boolean: livingMonster) is func
  local
    var objecttype: obj is NOOBJECT;
  begin (* monsterDies *)
    livingMonster := FALSE;
    writeln;
    writeln("The " <& monster <& " lies dead at your feet!");
    if mealHour + 60 <= turns then
      writeln;
      write("You spend an hour eating " <& monster <& " ");
      writeAnyFood();
      writeln(".");
      mealHour := turns;
    end if;
    for obj range list_of_objects do
      if (currentRoom->xPos = obj->xPos) and
          (currentRoom->yPos = obj->yPos) and
          (currentRoom->zPos = obj->zPos) and
          (obj->place = ANYROOM) then
        writeln("\a");
        writeln("Great Zot! You've found the " <& obj->name <& "!");
        obj->place := PLAYER;
      end if;
    end for;
    if monster = VENDOR then
      writeln;
      writeln("You get all his wares:");
      writeln("  plate armor");
      armor := PLATE;
      armorStrength := 21;
      writeln("  a sword");
      weapon := SWORD;
      writeln("  a strength potion");
      strength := range18(strength + rand(1, 6));
      writeln("  an intelligence potion");
      intelligence := range18(intelligence + rand(1, 6));
      writeln("  a dexterity potion");
      dexterity := range18(dexterity + rand(1, 6));
      if LAMP->place <> PLAYER then
        writeln("  a lamp");
      end if;
      LAMP->place := PLAYER;
    else
      decr(monsterCount);
    end if;
    writeln;
    write("You get his hoard of ");
    findGoldPieces(99);
    currentRoom->roomer := NOBODY;
  end func; (* monsterDies *)


const proc: monsterAttacks (in animatetype: monster) is func
  begin (* monsterAttacks *)
    if webCount > 0 then
      decr(webCount);
      if webCount = 0 then
        writeln;
        writeln("The web just broke!");
      end if;
    end if;
    writeln;
    write("The " <& monster);
    if webCount > 0 then
      writeln(" is stuck and can't attack now!");
    elsif dexterity >= rand(3, 21) + 3 * ord(blind) then
      writeln(" attacks!  What luck, he missed you!");
    else
      writeln(" attacks!  Ouch! He hit you!");
      checkArmor(aggressionOfMonster);
      if strength < 1 then
        living := FALSE;
      end if;
    end if;
  end func; (* monsterAttacks *)


const proc: attackMonster (in animatetype: monster, inout boolean: livingMonster) is func
  begin (* attackMonster *)
    if weapon = NOWEAPON then
      writeln;
      write("** Pounding on ");
      write_a(monster);
      writeln(" won't hurt it!");
    elsif weaponBlocked then
      writeln;
      writeln("** You can't beat it to death with a book!");
    elsif dexterity < rand(1, 20) + (3 * ord(blind)) then
      writeln;
      writeln("You missed, too bad!");
    else
      writeln;
      writeln("You hit the evil " <& monster <& ".");
      monsterStrength -:= ord(weapon);
      if (monster = GARGOYLE) or (monster = DRAGON) then
        if rand(1, 8) = 1 then
          writeln;
          writeln("OH NO!  Your " <& weapon <& " broke!");
          weapon := NOWEAPON;
        end if;
      end if;
      if monsterStrength <= 0 then
        monsterDies(monster, livingMonster);
      end if;
    end if;
  end func; (* attackMonster *)


const proc: castSpell (in animatetype: monster, inout boolean: livingMonster) is func
  local
    var integer: number is 0;
    var char: ch is ' ';
  begin (* castSpell *)
    writeln;
    write("Which spell (web, fireball, deathspell)? ");
    readChar(ch);
    writeln;
    if ch = 'W' then
      decr(strength);
      webCount := rand(2, 9);
      if strength < 1 then
        living := FALSE;
      end if;
    elsif ch = 'F' then
      decr(strength);
      decr(intelligence);
      if (intelligence < 1) or (strength < 1) then
        living := FALSE;
      else
        number := rand(2, 14);
        writeln;
        writeln("It does " <& number <& " points worth of damage.");
        monsterStrength -:= number;
        if monsterStrength <= 0 then
          monsterDies(monster, livingMonster);
        end if;
      end if;
    elsif ch = 'D' then
      write("DEATH . . . ");
      if intelligence < rand(16, 19) then
        writeln("YOURS!");
        intelligence := 0;
        living := FALSE;
      else
        writeln("HIS!");
        monsterStrength := 0;
        monsterDies(monster, livingMonster);
      end if;
    else
      writeln("** Try one of the options given.");
    end if;
  end func; (* castSpell *)


const proc: execute (QUITCOMMAND) is func
  local
    var char: ch is ' ';
  begin (* execute (QUITCOMMAND) *)
    writeln;
    write("Do you really want to quit now? ");
    readChar(ch);
    if ch <> 'Y' then
      writeln;
      writeln("** Then don't say that you do!");
    else
      quitProgram := TRUE;
    end if;
  end func; (* execute (QUITCOMMAND) *)


const proc: bribeMonster (in animatetype: monster, inout boolean: bribed) is func
  local
    var objecttype: obj is NOOBJECT;
    var char: ch is ' ';
    var boolean: okay is TRUE;
  begin (* bribeMonster *)
    bribed := FALSE;
    if count(TREASURES) = 0 then
      writeln;
      writeln("All I want is your life!");
    else
      obj := one_of_owned(TREASURES);
      repeat
        okay := TRUE;
        writeln;
        write("I want the " <& obj->name <& ". Will you give it to me? ");
        readChar(ch);
        if not ch in {'Y', 'N', 'Q'} then
          okay := FALSE;
          writeln;
          writeln("** Please answer yes or no.");
        end if;
      until okay;
      if ch = 'Q' then
        execute(QUITCOMMAND);
      elsif ch = 'Y' then
        obj->place := ANYROOM;
        obj->xPos := currentRoom->xPos;
        obj->yPos := currentRoom->yPos;
        obj->zPos := currentRoom->zPos;
        writeln;
        writeln("Ok, just don't tell anyone else.");
        if monster = VENDOR then
          angryVendors := FALSE;
        end if;
        bribed := TRUE;
      end if;
    end if;
  end func; (* bribeMonster *)


const proc: newMonster is func
  local
    var animatetype: monster is NOBODY;
  begin (* newMonster *)
    monster := currentRoom->roomer;
    livingMonster := TRUE;
    bribed := FALSE;
    webCount := 0;
    aggressionOfMonster := 1 + ord(monster) div 2;
    monsterStrength := ord(monster) + 2;
    if (monster = VENDOR) and not angryVendors then
      writeln;
      writeln("You'll be sorry that you did that!");
      angryVendors := TRUE;
    end if;
    if (lethargic and RUBY->place <> PLAYER) or
        blind or (dexterity < rand(1, 18)) then
      activeMonster := TRUE;
    else
      activeMonster := FALSE;
    end if;
  end func; (* newMonster *)


const proc: retreatFromMonster is func
  local
    var animatetype: monster is NOBODY;
  begin (* retreatFromMonster *)
    if livingMonster then
      if not bribed then
        monster := currentRoom->roomer;
        monsterAttacks(monster);
        if 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;
      livingMonster := FALSE;
    end if;
  end func; (* retreatFromMonster *)


const proc: meetMonster is func
  local
    var animatetype: monster is NOBODY;
  begin (* meetMonster *)
    if livingMonster and not quitProgram then
      if not bribed then
        monster := currentRoom->roomer;
        if activeMonster then
          monsterAttacks(monster);
        end if;
        activeMonster := TRUE;
        if living then
          writeln;
          write("You're facing ");
          write_a(monster);
          writeln("!");
          writeln("Your strength is " <& strength <&
                  " and your dexterity is " <& dexterity <& ".");
        end if;
      end if;
    end if;
  end func; (* meetMonster *)


const proc: execute (ATTACK) is func
  begin (* execute (ATTACK) *)
    if currentRoom->roomer = NOBODY then
      writeln;
      writeln("** There is nothing that can be attacked!");
    else
      if livingMonster then
        bribed := FALSE;
      else
        newMonster();
      end if;
      attackMonster(currentRoom->roomer, livingMonster);
      activeMonster := TRUE;
    end if;
  end func; (* execute (ATTACK) *)


const proc: execute (CAST) is func
  begin (* execute (CAST) *)
    if currentRoom->roomer = NOBODY then
      writeln;
      writeln("** There is nothing that can be casted!");
    elsif intelligence < 15 then
      writeln;
      writeln("** Your intelligence must be 15 or more to cast a spell!");
    else
      if livingMonster then
        bribed := FALSE;
      else
        newMonster();
      end if;
      castSpell(currentRoom->roomer, livingMonster);
      activeMonster := TRUE;
    end if;
  end func; (* execute (CAST) *)


const proc: execute (BRIBE) is func
  begin (* execute (BRIBE) *)
    if currentRoom->roomer = NOBODY then
      writeln;
      writeln("** There is nothing that can be bribed!");
    elsif livingMonster then
      if bribed then
        writeln;
        writeln("I will not give you more than your life.");
      else
        bribeMonster(currentRoom->roomer, bribed);
      end if;
    else
      writeln;
      writeln("That does not work.");
    end if;
  end func; (* execute (BRIBE) *)


const proc: meetVendor is func
  begin (* meetVendor *)
    if angryVendors then
      newMonster();
    else
      writeln("You may buy from, sell to, attack, or ignore the vendor.");
    end if;
  end func; (* meetVendor *)


const proc: enterRoom is func
  begin (* enterRoom *)
(*!!
    writeln(currentRoom->xPos <& " " <& currentRoom->yPos <& " " <& currentRoom->zPos);
!!*)
    execute(LOOK);
    if currentRoom->roomer = VENDOR then
      meetVendor();
    elsif currentRoom->roomer <> NOBODY then
      newMonster();
    end if;
  end func; (* enterRoom *)


const proc: readCoordinate (in char: coordname, inout integer: coordinate) is func
  local
    var boolean: okay is TRUE;
  begin (* readCoordinate *)
    repeat
      writeln;
      write("Please enter the " <& coordname <& "-coordinate? ");
      readNumber(coordinate, okay, quitProgram);
      if okay then
        if coordinate < 1 or coordinate > SIZE_LABY then
          writeln;
          writeln("** Try a number from 1 to " <& SIZE_LABY <& ".");
          okay := FALSE;
        end if;
      else
        writeln;
        writeln("** Would you please be so kind to type a number, " <& species <& ".");
      end if;
    until okay;
  end func; (* readCoordinate *)


const proc: execute (TELEPORT) is func
  local
    var integer: x1 is 0;
    var integer: y1 is 0;
    var integer: z1 is 0;
  begin (* execute (TELEPORT) *)
    if RUNESTAFF->place <> PLAYER then
      writeln;
      writeln("** You can't teleport without the Runestaff!");
    else
      readCoordinate('x', x1);
      readCoordinate('y', y1);
      readCoordinate('z', z1);
      currentRoom := &LABYRINTH[x1][y1][z1];
      if (currentRoom->xPos = ORBOFZOT->xPos) and
          (currentRoom->yPos = ORBOFZOT->yPos) and
          (currentRoom->zPos = ORBOFZOT->zPos) and
          (ORBOFZOT->place = NOWHERE) then
        writeln;
        writeln("Great unmitigated Zot!");
        writeln;
        writeln("You just found the *ORB OF ZOT*!");
        writeln;
        writeln("The Runestaff has disappeared!");
        RUNESTAFF->place := NOWHERE;
        ORBOFZOT->place := PLAYER;
        currentRoom->visited := TRUE;
        currentRoom->transfer := NOTRANSFER;
      else
        enterRoom();
      end if;
    end if;
  end func; (* execute (TELEPORT) *)


const proc: go (in directtype: direction) is func
  local
    var char: ch is ' ';
  begin (* go *)
    if (direction = NORTH) and
        (currentRoom->contents = ENTRANCE) then
      writeln;
      write("Do you really want to leave the castle? ");
      readChar(ch);
      if ch <> 'Y' then
        writeln;
        writeln("** Then don't say that you do!");
      else
        retreatFromMonster();
        leaveCastle := TRUE;
      end if;
    elsif direction in currentRoom->connections then
      retreatFromMonster();
      currentRoom := &LABYRINTH[range_laby(currentRoom->xPos + delta_x[direction])]
          [range_laby(currentRoom->yPos + delta_y[direction])]
          [range_level(currentRoom->zPos + delta_z[direction])];
      enterRoom();
    else
      writeln;
      writeln("** There is no way in this direction!");
    end if;
  end func; (* go *)


const proc: openChest is func
  local
    var directtype: direct is NORTH;
  begin (* openChest *)
    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(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(rand(1, 6));
              if strength < 1 then
                living := FALSE;
              end if;
              currentRoom->contents := EMPTYROOM;

            when {4}:
              turns +:= 20;
              direct := rand(DIRECTION);
              writeln("...  GAS!!  You stagger from the room to the " <& direct <& "!");
              currentRoom->contents := EMPTYCHEST;
              go(direct);

            when {5}:
              write("find ");
              writeAnyAdjective();
              writeln(" skeleton.");
              writeln("It seems that this " <& rand(speciestype) <&
                      " was also an adventurer.");
              currentRoom->contents := CHESTWITHSKELETON;

            when {6}:
              write("find ");
              findFlares(4);
              currentRoom->contents := EMPTYCHEST;

            when {7}:
              if armor = NOARMOR then
                armor := LEATHER;
              end if;
              writeln("find a brand new " <& armor <& " armor.");
              armorStrength := ord(armor) * 7;
              currentRoom->contents := EMPTYCHEST;
          end case;
      end case;
    end if;
  end func; (* openChest *)


const proc: execute (OPEN) is func
  begin (* execute (OPEN) *)
    writeln;
    if currentRoom->contents <> CLOSEDCHEST then
      writeln("** The only thing opend, was your big mouth!");
    else
      openChest();
    end if;
  end func; (* execute (OPEN) *)


const proc: execute (ILLEGAL) is func
  begin (* execute *)
    writeln;
    writeln("** Silly " <& species <& ", that wasn't a valid command!");
  end func; (* execute *)


const proc: execute (WAIT) is func
  begin (* execute (WAIT) *)
    writeln;
    writeln("Waiting ...");
  end func; (* execute (WAIT) *)


const proc: execute (INVENTORY) is func
  begin (* execute (INVENTORY) *)
    writeln;
    writeln("You have:");
    listInventory();
  end func; (* execute (INVENTORY) *)


const func commandtype: readCommand is func
  result
    var commandtype: current_command is ILLEGAL;
  local
    var string: stri is "";
    var char: ch1 is ' ';
    var char: ch2 is ' ';
  begin (* readCommand *)
    writeln;
    write(" -> ");
    readln(stri);
    if stri = "" then
      current_command := WAIT;
    else
      ch1 := upper(stri[1]);
      if length(stri) >= 2 then
        ch2 := upper(stri[2]);
      else
        ch2 := ' ';
      end if;
      if ch1 >= 'A' and ch1 <= 'Z' then
        case ch1 of
          when {'A'}:   current_command := ATTACK;
          when {'B'}:
            if (ch2 = ' ') or (ch2 = 'U') then
              current_command := BUY;
            elsif ch2 = 'R' then
              current_command := BRIBE;
            else
              current_command := ILLEGAL;
            end if;
          when {'C'}:   current_command := CAST;
          when {'D'}:
            if (ch2 = ' ') or (ch2 = 'O') then
              current_command := GO_DOWN;
            elsif ch2 = 'R' then
              current_command := DRINK;
            else
              current_command := ILLEGAL;
            end if;
          when {'E'}:   current_command := GO_EAST;
          when {'F'}:   current_command := FLARE;
          when {'G'}:   current_command := GAZE;
          when {'H'}:   current_command := HELP;
          when {'I'}:   current_command := INVENTORY;
          when {'J'}:   current_command := ILLEGAL;
          when {'K'}:   current_command := ILLEGAL;
          when {'L'}:
            if (ch2 = ' ') or (ch2 = 'O') then
              current_command := LOOK;
            elsif ch2 = 'A' then
              current_command := LIGHT;
            else
              current_command := ILLEGAL;
            end if;
          when {'M'}:   current_command := MAP;
          when {'N'}:   current_command := GO_NORTH;
          when {'O'}:   current_command := OPEN;
          when {'P'}:   current_command := ILLEGAL;
          when {'Q'}:   current_command := QUITCOMMAND;
          when {'R'}:   current_command := READ;
          when {'S'}:
            if (ch2 = ' ') or (ch2 = 'O') then
              current_command := GO_SOUTH;
            elsif ch2 = 'T' then
              current_command := STATUS;
            elsif ch2 = 'E' then
              current_command := SELL;
            else
              current_command := ILLEGAL;
            end if;
          when {'T'}:   current_command := TELEPORT;
          when {'U'}:   current_command := GO_UP;
          when {'V'}:   current_command := ILLEGAL;
          when {'W'}:   current_command := GO_WEST;
          when {'X'}:   current_command := ILLEGAL;
          when {'Y'}:   current_command := ILLEGAL;
          when {'Z'}:   current_command := ILLEGAL;
        end case;
      else
        current_command := ILLEGAL;
      end if;
    end if;
  end func; (* readCommand *)


const proc: executeCommand is func
  local
    var commandtype: current_command is ILLEGAL;
  begin (* executeCommand *)
    current_command := readCommand();
    case current_command of
      when {GO_NORTH}:    go(NORTH);
      when {GO_SOUTH}:    go(SOUTH);
      when {GO_EAST}:     go(EAST);
      when {GO_WEST}:     go(WEST);
      when {GO_UP}:       go(UP);
      when {GO_DOWN}:     go(DOWN);
      when {WAIT}:        execute(WAIT);
      when {INVENTORY}:   execute(INVENTORY);
      when {HELP}:        execute(HELP);
      when {LOOK}:        execute(LOOK);
      when {MAP}:         execute(MAP);
      when {FLARE}:       execute(FLARE);
      when {LIGHT}:       execute(LIGHT);
      when {ATTACK}:      execute(ATTACK);
      when {CAST}:        execute(CAST);
      when {BRIBE}:       execute(BRIBE);
      when {STATUS}:      execute(STATUS);
      when {OPEN}:        execute(OPEN);
      when {READ}:        execute(READ);
      when {GAZE}:        execute(GAZE);
      when {TELEPORT}:    execute(TELEPORT);
      when {DRINK}:       execute(DRINK);
      when {SELL}:        execute(SELL);
      when {BUY}:         execute(BUY);
      when {QUITCOMMAND}: execute(QUITCOMMAND);
      otherwise:          execute(ILLEGAL);
    end case;
    meetMonster();
  end func; (* executeCommand *)


const proc: incident is func
  local
    var objecttype: obj is NOOBJECT;
  begin (* incident *)
    if PEARL->place <> PLAYER then
      if currentRoom->occurance = LEECH then
        writeln("You pocket has a leetch. Now you will lose goldPieces.");
        currentRoom->occurance := NOOCCURANCE;
        haveLeech := TRUE;
      end if;
      if haveLeech then
        goldPieces -:= rand(1, 3);
        if goldPieces < 0 then
          goldPieces := 0;
        end if;
      end if;
    end if;
    if RUBY->place <> PLAYER then
      if currentRoom->occurance = LETHARGY then
        writeln("You feel that you are lethargic now.");
        currentRoom->occurance := NOOCCURANCE;
        lethargic := TRUE;
      end if;
      if lethargic then
        incr(turns);
      end if;
    end if;
    if GREENGEM->place <> PLAYER then
      if currentRoom->occurance = 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->occurance := NOOCCURANCE;
        forgetting := TRUE;
      end if;
      if forgetting then
        LABYRINTH[rand(1, SIZE_LABY)][rand(1, SIZE_LABY)][rand(1, NUM_LEVELS)].visited := FALSE;
      end if;
    end if;
    if (armor <> NOARMOR) and (currentRoom->occurance = STEALARMOR) then
      writeln("You are knocked down from behind and somebody steals your " <&
              armor <& " armor.");
      currentRoom->occurance := NOOCCURANCE;
      armor := NOARMOR;
    end if;
    if (weapon <> NOWEAPON) and (currentRoom->occurance = STEALWEAPON) then
      writeln("You realize that somebody has stolen your " <& weapon <& ".");
      currentRoom->occurance := NOOCCURANCE;
      weapon := NOWEAPON;
    end if;
    if (LAMP->place = PLAYER) and (currentRoom->occurance = STEALLAMP) then
      writeln("You realize that somebody has stolen your lamp.");
      currentRoom->occurance := NOOCCURANCE;
      LAMP->place := NOWHERE;
    end if;
    if (flares <> 0) and (currentRoom->occurance = STEALFLARES) then
      writeln("You realize that somebody has stolen all your flares.");
      currentRoom->occurance := NOOCCURANCE;
      flares := 0;
    end if;
    if currentRoom->occurance = STEALTREASURE then
      if count(TREASURES) <> 0 then
        obj := one_of_owned(TREASURES);
        writeln("You realize that somebody has stolen the " <& obj->name <& ".");
        currentRoom->occurance := NOOCCURANCE;
        obj->place := NOWHERE;
      end if;
    end if;
    if currentRoom->occurance = FINDGOLD then
      if currentRoom->roomer = NOBODY then
        write("Here you find ");
        findGoldPieces(10);
      else
        write("Here are ");
        numberName(rand(2, 11));
        writeln(" GP'S. But the " <& currentRoom->roomer <&
                " is faster and takes them.");
      end if;
      currentRoom->occurance := NOOCCURANCE;
    end if;
    if currentRoom->occurance = FINDFLARES then
      if currentRoom->roomer = NOBODY then
        write("Here you find ");
        findFlares(4);
      else
        write("Here are ");
        numberName(rand(2, 5));
        writeln(" flares. But the " <& currentRoom->roomer <&
                " is faster and takes them.");
      end if;
      currentRoom->occurance := NOOCCURANCE;
    end if;
  end func; (* incident *)


const proc: curesAndDissolves is func
  begin (* curesAndDissolves *)
    if blind and (OPAL->place = PLAYER) then
      writeln;
      writeln("The opal Eye cures your blindness!");
      blind := FALSE;
    end if;
    if weaponBlocked and (BLUEFLAME->place = PLAYER) then
      writeln;
      writeln("The blue Flame dissolves the book!");
      weaponBlocked := FALSE;
    end if;
    if haveLeech and (PEARL->place = PLAYER) then
      writeln;
      writeln("The pale pearl fixes the leech in your pocket.");
      haveLeech := FALSE;
    end if;
    if lethargic and (RUBY->place = PLAYER) then
      writeln;
      writeln("The ruby red stops your lethargy.");
      lethargic := FALSE;
    end if;
    if forgetting and (GREENGEM->place = PLAYER) then
      writeln;
      writeln("The green Gem stops the forgetting of the map.");
      forgetting := FALSE;
    end if;
  end func; (* curesAndDissolves *)


const proc: die is func
  begin (* die *)
    writeln("\a");
    writeln("*" mult 78);
    writeln("A noble effort, oh formerly living " <& species <& "!");
    writeln;
    write("You died due to lack of ");
    if strength < 1 then
      writeln("strength.");
    end if;
    if intelligence < 1 then
      writeln("intelligence.");
    end if;
    if dexterity < 1 then
      writeln("dexterity.");
    end if;
    writeln;
    writeln("At the time you died, you had:");
    listInventory();
    writeln;
    writeln("And it took you " <& turns <& " turns!");
  end func; (* die *)


const proc: exitCastle is func
  begin (* exitCastle *)
    writeln("\a");
    write("You left the castle with");
    if ORBOFZOT->place <> PLAYER then
      write("out");
    end if;
    writeln(" the *ORB OF ZOT*.");
    writeln;
    if ORBOFZOT->place = PLAYER then
      writeln("An incredibly glorious victory!!");
      writeln;
      writeln("In addition, you got out with the following:");
      writeln("  your life");
      ORBOFZOT->place := NOWHERE;
    else
      writeln("A less than awe-inspiring defeat.");
      writeln;
      writeln("when you left the castle, you had:");
      writeln("  your miserable life");
    end if;
    listInventory();
    writeln;
    writeln("And it took you " <& turns <& " turns!");
  end func; (* exitCastle *)


const proc: main is func
  local
    var char: ch is ' ';
  begin (* main *)
    startText();
    repeat
      initVars();
      initScalars();
      readSpecies();
      readSex();
      readAttributes();
      buyArmor(7, 5, 3, quitProgram);
      buyWeapon(7, 5, 3, quitProgram);
      buyLamp(2, quitProgram);
      readFlares();
      if not quitProgram then
        writeln;
        writeln("Ok, " <& species <& ", you are now entering the castle.");
        writeln("Type H for help.");
        currentRoom := &LABYRINTH[1][4][1];
        enterRoom();
        repeat
          incr(turns);
          incident();
          curesAndDissolves();
          writeRemark();
          executeCommand();
        until not living or leaveCastle or quitProgram;
        if not living then
          die();
        elsif leaveCastle then
          exitCastle();
        end if;
      end if;
      repeat
        writeln;
        write("Are you foolish enough to want to play again? ");
        readChar(ch);
        if not ch in {'Y', 'N'} then
          writeln;
          writeln("** Please answer yes or no.");
        end if;
      until ch = 'Y' or ch = 'N';
      writeln;
      if ch = 'Y' then
        writeln("Some " <& species <& "s never learn!");
      else
        writeln("Maybe dumb " <& species <& " is not so dumb after all!");
      end if;
    until ch = 'N';
  end func; (* main *)
