(*
   Adventure in Pascal - March 1979

   Written by
      George H. Richmond
      Storage Technology Corperation

   With the support of
      Mike Preston
      University of Colorado at Boulder
      English Department

   And the University of Colorado Computing Center

   Retyped from a 1986 listing and converted to Lazarus
   by Meteoricshipyards - August 2015

   Data File format.

   1) Message of the Day
   2) Directions, Actions, and Nouns
   3) Noun descriptions  + prefix
      - either 1 line short + n lines long description
      - or 1 line per state of noun
   4) Synonyms  - prefix
   5) Room description  + prefix
      line 1: column 2   Blank = land
                         B = Shore or beach
                         W = Lake
              column 3   blank = No pools
                         O = Pool of oil
                         W = Pool of water
              column 4   blank = inside cavern
                         O = Outside cavern
              column 5-70  = Internal Name
      Line 2:    Brief description
      line 3-25: Long description
   6) Interconnections    - prefix
      a) from,
      b) to,
      c) direction,
      d) optional block number
         (repeat c and d as necessary)
   7) Ojbect placement   + prefix
      a) location
      b) list of nouns
   8) Special Locations  - prefix
      a) starting and resurrection position
      b) treasure deposit position
      c) boat starting and resurrection position
    9) extra line at end of file to handle fix for missing
        filename^ construct in Lazarus.

   Implementation changes -- Lazarus has some reserved words that
   were not in Pascal when this was written.  I have changed
   the identifiers by adding an underscore after the word.

   The new() procedure format that created a record type with a variant
   of a specific size is not available in Lazarus.
   Thus new(record_pointer,variant)
   is just new(record_pointer) and the record is the largest size that
   is needed for any variant.  Thus, most of procedure NEWDP is commented
   out.
*)


PROGRAM AdventP;

{$mode objfpc}{$H+}

Uses {$IFDEF UNIX} {$IFDEF UseCThreads}
cthreads, {$ENDIF} {$ENDIF}
Classes,
SysUtils;

LABEL 
   50;
(* go ask question *)

CONST 
   WORDSIZE =  20;
(* number of characters in a string *)
   LINEWIDTH =  70;
(* Num of characters in a line *)
   DESCMAX =  10;
(* Max lines in a description *)
   NOBLOCK =  20;
(* Max number of different block type *)
   ORCNUMBER =  6;
(* Number of Orcs in the cavern *)
   ORCSAFE =  90;
(* Moves between orc appearances *)

   letter =  ['A' .. 'Z', 'a' .. 'z'];
   uppercase =  ['A' .. 'Z'];
   digit =  ['0' .. '9'];
   null =  [chr(0)];


TYPE 
   DescNum =  1..DESCMAX;
   word =  packed array [1..WORDSIZE] OF char;
   Line =  packed array [1..LINEWIDTH] OF char;
   Description =  RECORD
      Case NDLS: DESCNUM OF 
         1:  (c1: Line);
         2:  (c2: Array[1..2] Of Line);
         3:  (c3: Array[1..3] Of Line);
         4:  (c4: Array[1..4] Of Line);
         5:  (c5: Array[1..5] Of Line);
         6:  (c6: Array[1..6] Of Line);
         7:  (c7: Array[1..7] Of Line);
         8:  (c8: Array[1..8] Of Line);
         9:  (c9: Array[1..9] Of Line);
         10:  (c10: Array[1..10] Of Line);
   END;
(* Description *)
   DEFNTYPE =  (DEFN, NODE);
   LOCALE =  (INSIDE, OUTSIDE);
   QUESTTYPE =  (NOQUEST, INFOQUEST, DEADQUEST,
                 LASTCHANCE, QUITQUEST);
   WordType =  (DIRECT, ACT, KNOWN, LOCATE,
                UNKNOWN);
   Direction =  (ENTER, EXIT, ALTER, CROSS,
                 DOWN, EAST, JUMP, MAGIC,
                 NORTH, NORTHEAST, NORTHWEST, SOUTH,
                 SOUTHEAST, SOUTHWEST, UP, WEST);
   Action =  (BRIEF, BUILD, DESCRIBE, DRINK,
              DROP, EAT, EMPTY, FEED,
              FILL, HELP, INFO, INVEN,
              KILL, LEFT, LOCK, LOOK,
              NO, OFF, ON_, QUIT,
              RAISE_, RESIGN, RIGHT, ROW, RUB,
              SAVE, SCORE, SWIM, TAKE,
              THROW, UNLOCK, VERBOSE, WAVE,
              YES);
   NOUN =  (NILL, ALL, AXE, BOAT,
            BOTTLE, BRIDGE, CAGE, FOOD,
            HAMMER, KEYS, KNIFE, LADDER,
            LAMP, MATCH, NAIL, OIL,
            PLANT, ROD, ROPE, SHARD,
            WATER, WOOD, CHAIN, CHEST,
            COIN, CRYSTAL, DIAMOND, EGG,
            EMERALD, FUR, GOLD, IVORY,
            NECKLACE, PEARL, PILLOW, PLATINUM,
            PYRAMID, RING, RUBY, RUG,
            SILVER, SPICE, TEAK, TRIDENT,
            VASE, BEAR, BIRD, CLAM,
            DRAGON, ORC, PIRATE, SNAKE,
            TROLL, WOLF);
   NounSet =  SET OF Axe .. Wolf;
   LocPTR =  ^ Location;
   DescPTR =  ^ Description;
   NamePTR =  ^ NameDEFN;

   Location =  packed RECORD
      Name:  NamePTR;
      Tell:  DescPTR;
      Present:  NounSET;
      Passage:  packed array [Direction] OF 
                packed RECORD
                   Gate:  boolean;
                   Target:  LocPTR;
                END;
      Wet:  (Dry, OilWet, WaterWet);
      Class_:  (Land, Beach, Lake);
      Pool:  (NoPool, OilPool, WaterPool);
      Side:  Locale;
      Block:  boolean;
      Warn:  0..NOBLOCK;
      MagCH:  char;
      Visit:  boolean;
   END;
(* location *)

   NameDEFN =  RECORD
      SLNK:  NamePTR;
      Case NDF: DEFNTYPE OF 
         DEFN:  (SDFN: word;
                 Case Meaning: Wordtype Of
                 DIRECT: (DirVal: Direction);
         ACT:  (ActVal: ACTION);
         KNOWN:  (NounVal: NOUN);
         LOCATE:  (LocVal: LOCPTR);
         UNKNOWN:  (UnVal: word));
         NODE:  (LLNK, RLNK: NamePTR);
   END;
(* NameDEFN *)

   NounDescr =  packed RECORD
      Name:  NamePTR;
      Tell:  DescPTR;
      Told:  boolean;
      Special:  boolean;
      Case What: NOUN OF 
         Bottle:  (BottleContents: (EmptyBottle,
                   OilInBottle,
                   WaterInBottle));
         Cage:  (CageContents: (EmptyCage,
                 BirdInCage));
         Lamp:  (Burning: boolean;
                 TimeLeft: integer);
         Match:  (NOfMatches: integer);
         Nail:  (NOfNails: integer);
         Plant:  (Height: (Little, Stage1,
                  Stage2, Full,
                  OverGrown));
         Wood:  (PileSize: integer);
         Chest:  (ChestState: (EmptyChest,
                  TreasureChest,
                  LockedChest);
         ChestContents:  NounSET);
         Bear:  (BearState: (Angry, Happy));
         Bird:  (BirdState: (FreeBird, CagedBird));
         Clam:  (ClamOpn: (Never, HasBeen));
         Wolf:  (Life: (Alive, Dead));
   END;
(* NounDescr *)

VAR 
   Nouns:  array [Noun] OF NounDescr;
   String_:  word;
(* Word returned by ReadToken *)
   Rvalue:  integer;
(* Value returned by ReadToken *)
   Column:  integer;
(* Current data line column *)
   Definition:  boolean;
(* Initialization or execution flag *)
   LineBuffer:  Line;
(* One text line from data or tty *)
   Root:  NamePTR;
(* Root of data structure *)
   Void:  NamePTR;
(* Unknown word descriptor pointer *)
   WAll:  NamePTR;
(* Pointer to 'ALL' descriptor *)
   WordPTR:  NamePTR;
(* Current word definition pointer *)

   Commands:  integer;
(* Count of commands given *)
   Moves:  integer;
(* Count of moves taken *)
   DarkMoves:  integer;
(* Count of moves in the dark *)
   Done:  boolean;
(* Flag when adventurer is done *)

   Where:  LocPTR;
(* Current location of adventurer *)
   Was:  LocPTR;
(* Where adventure last was *)
   StartLoc:  LocPTR;
(* Starting location of adventure *)
   TreasLoc:  LocPTR;
(* Where Treasure must be deposited *)

   MaxTreas:  NounSET;
(* Set of all treasure placed in cavern *)
   Treas:  NounSET;
(* Set of all possible treasures *)
   Discovt:  NounSET;
(* Set of all treasures discovered *)

   Question:  QuestTYPE;
(* Current Question *)
   Carry:  NounSet;
(* Objects carried by adventurer *)
   Briefly:  boolean;
(* Brief description flag *)
   NumDied:  integer;
(* number o times adventurer died *)

   RowFlag:  boolean;
(* word 'ROW' encountered *)
   BurnTime:  integer;
(* Time lamps burns on fuel *)
   NumOrc:  integer;
(* Number of Orcs generated *)
   SafOrc:  integer;
(* Time between Orc generations *)
   MaxVisit:  integer;
(* Number of possible positions *)
   ActVisit:  integer;
(* Actual positions visited *)
   MOfDay:  Line;
(* Message of the Day *)
   Strangle:  integer;
(* Count of Dragon/Snake Cycles *)
   BoatLoc:  LocPTR;
(* Home location of boat *)
   BoatPos:  LocPTR;
(* Current location of boat *)
   Rightech:  boolean;
(* right technique for dragon *)
   ChestLoc:  LocPtr;
(* location of pirate's chest *)
   PState:  (PWAIT, PACTIVE, PDONE);
(* Pirate states *)
   Advent4:  Text;
(* data file *)
   DebugFile:  Text;
(* debug file -- * Debug *)
   debugging:  boolean;

   FBuffer:  line;
(* to replace "advent4^" *)
   firstRead:  boolean;
   askquestionimmediately:  boolean;
   wordwords:  array[wordtype] OF 
               string =  ('DIRECT', 'ACT', 'KNOWN', 'LOCATE', 'UNKNOWN');
   nounwords:  array [noun] OF 
               string =  ('NILL', 'ALL', 'AXE', 'BOAT',
                          'BOTTLE', 'BRIDGE', 'CAGE', 'FOOD', 'HAMMER',
                          'KEYS', 'KNIFE', 'LADDER', 'LAMP', 'MATCH',
                          'NAIL', 'OIL', 'PLANT', 'ROD', 'ROPE',
                          'SHARD', 'WATER', 'WOOD', 'CHAIN', 'CHEST',
                          'COIN', 'CRYSTAL', 'DIAMOND', 'EGG', 'EMERALD',
                          'FUR', 'GOLD', 'IVORY', 'NECKLACE', 'PEARL',
                          'PILLOW', 'PLATINUM', 'PYRAMID', 'RING', 'RUBY',
                          'RUG', 'SILVER', 'SPICE', 'TEAK', 'TRIDENT',
                          'VASE', 'BEAR', 'BIRD', 'CLAM', 'DRAGON',
                          'ORC', 'PIRATE', 'SNAKE', 'TROLL', 'WOLF');
   actionwords:  array[action] OF 
                 string =  ('BRIEF', 'BUILD', 'DESCRIBE', 'DRINK', 'DROP',
                            'EAT', 'EMPTY', 'FEED', 'FILL', 'HELP',
                            'INFO', 'INVEN', 'KILL', 'LEFT', 'LOCK',
                            'LOOK', 'NO', 'OFF', 'ON', 'QUIT',
                            'RAISE', 'RESIGN', 'RIGHT', 'ROW', 'RUB',
                            'SAVE', 'SCORE', 'SWIM', 'TAKE', 'THROW',
                            'UNLOCK', 'VERBOSE', 'WAVE', 'YES');
   directwords:  array[direction] OF 
                 string =  ('ENTER', 'EXIT', 'ALTER', 'CROSS', 'DOWN',
                            'EAST', 'JUMP', 'MAGIC', 'NORTH', 'NORTHEAST', 'NORTHWEST',
                            'SOUTH', 'SOUTHEAST', 'SOUTHWEST', 'UP', 'WEST');
   questwords:  array[questtype] OF 
                string =  ('NOQUEST', 'INFOQUEST', 'DEADQUEST', 'LASTCHANCE',
                           'QUITQUEST');


  (*  I/O Procedures *)

  (* Procedure Snap ( X : Word ); Fortran; *)

(* Snap is an assembler procedure that saves memory after the
   the data file has been read in, so as to keep the pointers
   true.  It turns the memory into a loadable program, that
   starts right after the Snap routine was called.  This
   worked on the Control Data Corperation's NOS operating
   system. *)



PROCEDURE DEBUGIT(l: String);

BEGIN
IF debugging THEN
   writeln(debugfile, l);
flush(debugfile);
END;

FUNCTION bool2str(b: boolean):  string;
BEGIN
IF b THEN
   bool2str := 'True'
ELSE
   bool2str := 'False';
END;

FUNCTION NamePtrtoString(np: NamePtr):  string;

VAR 
   s:  string;
BEGIN
WITH np^ DO
   BEGIN
   s := 'NamePtr ';
IF ndf = node THEN
   s := s + ' node '
ELSE
   BEGIN
   s := s + sdfn + ' ' + wordwords[meaning] + ' ';
CASE meaning OF 
   DIRECT:  s := s + directwords[DirVal] + ' ';
   ACT:  s := s + actionwords[ActVal] + ' ';
   KNOWN:  s := s + nounwords[NounVal] + ' ';
   LOCATE:  s := s + LocVal^.Name^.sdfn + ' ';
   UNKNOWN:  s := s + trimright(UnVal) + ' ';
END;
END;
(* ELSE *)
END;
(* with *)
NamePtrtoString := s;
END;
(* toString *)

PROCEDURE debugroot1;

VAR 
   np:  nameptr;
   s:  string;
BEGIN
IF root = NIL THEN
   debugit('Root = nil!!!!')
ELSE
   BEGIN
   debugit('Root = ' + nameptrtostring(root));
np := root;
WHILE (np <> NIL) DO
   WITH np^ DO
      BEGIN
      s := nameptrtostring(np);
CASE meaning OF 
   DIRECT:  s := s + directwords[DirVal] + ' ';
   ACT:  s := s + actionwords[ActVal] + ' ';
   KNOWN:  s := s + nounwords[NounVal] + ' ';
   LOCATE:  s := s + LocVal^.Name^.sdfn + ' ';
   UNKNOWN:  s := s + trimright(UnVal) + ' ';
END;
(* case *)
debugit(s);
np := np^.SLNK;
END;
END;
debugit('end of list');
END;
(* debugroot1 *)



FUNCTION NounSettoString(ns: nounset):  string;

VAR 
   s:  string;
   n:  noun;
BEGIN
(* nounset to string *)
s := '';
FOR n := nill TO wolf DO
   IF n IN ns THEN
      s := s + ' ' + nounwords[n];
NounSettoString := s;
END;
(* nounset to string *)

FUNCTION LocPtrToString(lp: LocPtr; long: boolean):  string;

VAR 
   s:  string;
   n:  noun;
   d:  direction;
BEGIN
WITH lp^ DO
   BEGIN
   IF (Name <> NIL) THEN
      s := NamePtrtoString(Name);
s := s + Tell^.c1;
IF Present = [] THEN
   s := s + ' [] '
ELSE
   BEGIN
   s := s + ' [ ';
FOR n := nill TO wolf DO
   IF n IN Present THEN
      s := s + nounwords[n] + ' ';
s := s + '] ';
END;
IF long THEN
   BEGIN

END;
(* long *)
LocPtrToString := s;
END;
(* with *)
END;

(* LocPtrToString)
                 Passage : Packed Array [ Direction ] OF
                              packed RECORD
                                 Gate : BOOLEAN;
                                 Target : LocPTR;
                              END;
                 Wet     : (Dry, OilWet, WaterWet );
                 Class_  : (Land, Beach, Lake );
                 Pool    : (NoPool, OilPool, WaterPool );
                 Side    : Locale;
                 Block   : BOOLEAN;
                 Warn    : 0..NOBLOCK;
                 MagCH   : CHAR;
                 Visit   : BOOLEAN;  &*)

PROCEDURE Original_ReadLine;

VAR 
   I, J:  integer;
   Stop:  boolean;
BEGIN
(* ReadLine *)
I := 0;
IF NOT Definition THEN
   BEGIN
      (*IF EOF OR EOS THEN  GETSEG(INPUT); NOS specific code *)
   IF EOLN THEN
      READLN;
WHILE (NOT EOLN) AND (I < LINEWIDTH) DO
   BEGIN
   I := I + 1;
Read(Linebuffer[I]);
END;
END
ELSE
   BEGIN
   LineBuffer := fbuffer;
WHILE (NOT EOLN(ADVENT4)) AND (I < LINEWIDTH) DO
   BEGIN
   I := I + 1;
Read(Advent4, fBuffer[I]);
END;
Readln(Advent4);
END;
J := LINEWIDTH;
REPEAT
   fBuffer[J] := CHR(0);
   J := J - 1;
UNTIL J <= I;
Stop := False;
REPEAT
   IF fBUFFER[I] = ' ' THEN
      BEGIN
      fBuffer[I] := CHR(0);
   I := I - 1;
   Stop := I < 1;
END
ELSE
   Stop := True;
UNTIL Stop;
Column := 1;
    (* debug *)
writeln(debugfile, '0readline - ' + linebuffer);
flush(debugfile);
END;
(* ReadLine *)

PROCEDURE ReadLine;

VAR 
   I, J:  integer;

BEGIN
(* readline *)
debugit('>readline');
i := 0;
IF NOT Definition THEN
   BEGIN
   Write('> ');
readln(linebuffer);
column := 1;
j := Linewidth;
WHILE (j > 1) AND (linebuffer[j] <> chr(0)) DO
   linebuffer[j] := ' ';
(* clean up for debugging *)

(*
       IF EOLN THEN READLN;
       WHILE (NOT EOLN) AND (I<LINEWIDTH) DO
          BEGIN
          I := I + 1;
          Read(Linebuffer[I]);
          END;
          for j := i to linewidth do linebuffer[j] := ' ';
          *)
debugit('<readline =' + trim(linebuffer));
END
ELSE
   BEGIN
      (* READLN will put a chr(0) at the end of the read data *)
   linebuffer := fbuffer;
ReadLN(advent4, fbuffer);
      (* debugit('+readline '+fbuffer); *)
i := 1;
WHILE fbuffer[i] <> chr(0) DO
   i := i + 1;
FOR j := i TO LINEWIDTH DO
   fbuffer[j] := chr(0);
column := 1;
      (* debug *)
debugit('<readline - ' + linebuffer);
END;
END;
(* readline *)

FUNCTION CARD(S: NOUNSET):  integer;
    (* BECAUSE LAZARUS DOESN'T SEEM TO HAVE A CARD() FUNCTION *)

VAR 
   N:  NOUN;
   CNT:  integer;
BEGIN
(* CARD *)
CNT := 0;
FOR N := NILL TO WOLF DO
   IF N IN S THEN
      CNT := CNT + 1;
CARD := CNT;
END;
(* CARD *)

PROCEDURE ReadToken;

LABEL 
   1;
(* unknown word rescan *)

VAR 
   digits:  boolean;
   ch:  char;
   I, J:  integer;
   alltypes:  SET OF char;

(*     letter,
      uppercase,        ( * added for mixed case (ascii) * )
      digit,
      alltypes,
      null    : set of CHAR; ( * originally: col .. '0' changed for lowercase*)
   s:  string;
BEGIN
(* ReadToken *)

(*  letter := ['A' .. 'Z', 'a' .. 'z' ];
  uppercase := [ 'A' .. 'Z' ];
  digit  := ['0' .. '9' ];
  null := [ chr(0) ];  *)
alltypes := letter + digit + null;
1:
    RValue := 0;
digits := True;
WHILE NOT (LineBuffer[column] IN alltypes) DO
   column := column + 1;
i := 0;
WHILE LineBuffer[column] IN (letter + digit) DO
   BEGIN
   ch := linebuffer[column];
column := column + 1;
digits := digits And (ch In digit);
IF i < WORDSIZE - 1 THEN
   BEGIN
   i := i + 1;
string_[i] := ch;
           (* added for mixed case *)
IF string_[i] IN uppercase THEN
   string_[i] := lowerCase(string_[i]);
(* convert everything to lower case *)
END;
END;
FOR j := i + 1 TO WORDSIZE DO
   string_[j] := chr(0);
IF string_[1] <> chr(0) THEN

   IF digits THEN
      BEGIN
(*  debugit('-readtoken digits detected');  *)
      IF NOT definition THEN
         GOTO 1;
i := 1;
WHILE string_[i] <> chr(0) DO
   BEGIN
   IF string_[i] IN digit THEN
      RValue := 10 * RValue + Ord(string_[i]) - Ord('0');
i := i + 1;
END;
str(rvalue, s);
debugit('readToken - rvalue ' + s);
string_[1] := chr(0);
END
(* process integer *)
ELSE (* not digits *)
   BEGIN
   IF NOT definition THEN
      BEGIN
      wordptr := ROOT;
WHILE WordPTR^.ndf <> defn DO
   IF WORDPTR^.SLNK^.sdfn < string_ THEN
      WordPTR := WordPTR^.rlnk
   ELSE
      WordPTR := WordPTR^.llnk;
IF WordPTR^.SDFN <> string_ THEN
   GOTO 1;
debugit('>ReadToken - ' + trimRight(string_) + ' ' + NamePtrtoString(WordPtr));
END
END

ELSE
   IF definition THEN
      wordptr := Nil
ELSE
   wordptr := void;

END;
(* ReadToken *)




  (* initialization procedures *)

  (* Function Random(P:REAL) : Real; Extern; *)
(* the available function from system unit is
   function Random : extended  *)



PROCEDURE Initialize;

VAR 
   DI:  Direction;
   AI:  Action;
   NI:  NOUN;
   I:  integer;

    (* PROCEDURE GETFIL; FORTRAN;  Another NOS thing *)


PROCEDURE GETFIL;
    (* debug *)

VAR 
   dir:  shortstring;
BEGIN

      (* debug *) dir := ' ';
getdir(0, dir);
      (* debug *) writeln(dir);
Assign(Advent4, 'AdventureP_Data.txt');
reset(Advent4);
readln(Advent4, fbuffer);
      (* debug *)Assign(DebugFile, 'debugfile.txt');
      (* debug *)rewrite(DebugFile);
writeln(debugfile, 'getfil');
flush(debugfile);
END;
(* GETFIL *)

FUNCTION NewDP(n: integer):  DescPTR;

VAR 
   dp:  DescPTR;
BEGIN
(* NewDP *)

(*
        CASE n OF
          1  : NEW(dp, 1);
          2  : NEW(dp, 2);
          3  : NEW(dp, 3);
          4  : NEW(dp, 4);
          5  : NEW(dp, 5);
          6  : NEW(dp, 6);
          7  : NEW(dp, 7);
          8  : NEW(dp, 8);
          9  : NEW(dp, 9);
          10 : NEW(dp,10);
        END; *)
new(dp);
dp^.NDLS := n;
NewDP := DP;
END;
(* NewDP *)

FUNCTION insert:  NamePTR;

VAR 
   p1, p2:  NamePTR;
   f:  boolean;
BEGIN
(* Insert *)
      (* trans *)(*NEW(p1, DEFN);*)
new(p1);
p1^.ndf := DEFN;
WITH p1^ DO
   BEGIN
   SLNK := Nil;
NDF := DEFN;
SDFN := STRING_;
Meaning := UNKNOWN;
END;
(* WITH p1*)

insert := p1;
IF root = NIL THEN
   root := p1
ELSE IF string_ < root^.SDFN THEN
        BEGIN
        p1^.SLNK := root;
root := p1;
END
ELSE
   BEGIN
        (*  debugit('insert - str_ >= root ') ; *)
   p2 := root;
f := p2^.SLNK <> Nil;
WHILE F DO
   BEGIN
   IF string_ > p2^.slnk^.sdfn THEN
      p2 := p2^.SLNK
   ELSE
      f := False;
f := f And (p2^.slnk <> Nil);
END;
(* while *)
p1^.slnk := p2^.slnk;
p2^.slnk := p1;
END;
      (* debug *)
IF p2 <> NIL THEN
   debugit('Insert - ' + trimRight(string_) + ' slnk = ' + trimRight(p2^.SDFN))
ELSE
   debugit('Insert - ' + trimRight(string_));

END;
(* Insert *)

FUNCTION FindName(T: WordTYPE):  NamePTR;

VAR 
   np:  namePTR;
BEGIN
(* findname *)
      (* debug *) debugit('Findname - ' + trimRight(string_));
NP := root;
WHILE NP^.SDFN <> string_ DO
   np := np^.slnk;
IF T <> UNKNOWN THEN
   IF np^.meaning <> T THEN
      BEGIN
      debugit('failure in Findname ' + string_);
Halt;
END;
Findname := np;
END;
(* findname  *)

PROCEDURE NextToken;
BEGIN
(* Nexttoken *)
      (* debug *) debugit('>NextToken');
REPEAT
   ReadToken;
   IF string_[1] = chr(0) THEN
      readline;
UNTIL string_[1] <> CHR(0);
      (* debug *) debugit('<NextToken');

END;
(* Nexttoken *)

PROCEDURE EnterDirection(D: Direction);

VAR 
   p1:  NamePTR;
BEGIN
(* EnterDirection *)
NextToken;
p1 := insert;
p1^.meaning := DIRECT;
p1^.dirval := d;
      (* debug *) debugit('EnterDirection ' + trimRight(string_));
END;
(* EnterDirection *)

PROCEDURE EnterAction(a: Action);

VAR 
   p1:  nameptr;
BEGIN
NextToken;
p1 := Insert;
p1^.meaning := Act;
p1^.actval := a;
      (* debug *) writeln(debugfile, 'Enteraction ' + trimRight(string_));
END;
(* enteraction *)

PROCEDURE EnterNoun(N: Noun);

VAR 
   P1:  NamePtr;

PROCEDURE ReadINT(Var int: integer);
BEGIN
(* ReadInt *)
debugit('>readint');
ReadToken;
IF (string_[1] <> chr(0)) OR (rvalue = 0) THEN
   BEGIN
(* DEBUG *)
   debugit('Failed to read an integer when expected ');
halt;
END;
INT := rvalue;
debugit('<readInt');
END;
(* ReadInt *)

BEGIN
(* EnterNoun *)
NextToken;
p1 := insert;
p1^.Meaning := known;
p1^.nounval := n;
WITH nouns[n] DO
   BEGIN
   Name := P1;
tell := Nil;
told := False;
what := N;
special := N In [bottle, cage, lamp, match, plant,
           chest, bear, bird, clam, wolf];
IF N IN [bottle, cage, lamp, match, nail, plant,
   wood, chest, bear, bird, clam, wolf] THEN
   CASE N OF 
      bottle:  bottlecontents := waterinbottle;
      cage:  cagecontents := emptycage;
      lamp:
             BEGIN

             burning := False;
      readint(burntime);
      timeleft := burntime;

   END;
(* lamp *)
match:  ReadInt(NOfmatches);
nail:  readint(NOfNails);
plant:  Height := little;
wood:  readint(pilesize);
chest:
        BEGIN
        cheststate := emptychest;
chestcontents := [];
END;
(* chest *)
bear:  bearstate := angry;
bird:  birdstate := freebird;
clam:  clamopn := never;
wolf:  life := alive;
END;
(* case  n *)
END;
(* with *)
      (* debug *) debugit('Enternoun ' + trimright(string_));
END;
(* EnterNoun *)

PROCEDURE loadnoundescriptions;

VAR 
   temp:  description;
   dp:  descptr;
   np:  nameptr;
   i, j:  integer;
BEGIN
(*load noun descriptions *)
      (* WHILE advent4^ = '+' DO *)
WHILE fBuffer[1] = '+' DO
   BEGIN
   ReadLine;
column := 2;
readToken;
IF string_[1] = chr(0) THEN
   BEGIN
(* debug *)
   debugit('error in noun descriptions.');
halt;
END;
np := findname(known);
i := 0;
        (* WHILE (advent4 ^ <> '+') and ( advent4 ^ <> '-') DO *)
WHILE (fBuffer[1] <> '+') AND (fBuffer[1] <> '-') DO
   BEGIN
   ReadLine;
i := I + 1;
temp.c10[i] := linebuffer;

END;
(* While *)
DP := NewDP(i);
dp^.ndls := i;
FOR j := 1 TO I DO
   dp^.c10[j] := temp.c10[j];
nouns[np^.nounval].tell := dp;
END;
(* while *)
debugit('loaded ' + trimRight(np^.SDFN));
(* debug *)
END;
(*load noun descriptions *)

PROCEDURE LoadSynonyms;

VAR 
   np, sp, tp:  NamePTR;
BEGIN
(* LoadSynonyms *)
      (* WHILE advent4^ = '-' DO *)
WHILE fbuffer[1] = '-' DO
   BEGIN
   ReadLine;
Column := 2;
ReadToken;
np := findname(unknown);
readtoken;
REPEAT
   sp := insert;
   tp := sp^.slnk;
   sp^ := np^;
   sp^.slnk := tp;
   sp^.sdfn := string_;
   readtoken;
UNTIL string_[1] = chr(0);
END;
END;
(* LoadSynonyms *)

PROCEDURE LoadRoomDescriptions;

VAR 
   temp:  description;
   dp:  descptr;
   np:  nameptr;
   rp:  locptr;
   di:  direction;
   i, j:  integer;
BEGIN
(* LoadRoomDescriptions *)
      (* WHILE advent4^ = '+' DO *)
WHILE fbuffer[1] = '+' DO
   BEGIN
   I := 0;
readline;
new(rp);
WITH rp^ DO
   BEGIN
   Name := Nil;
tell := Nil;
present := [];
FOR di := enter TO west DO
   BEGIN
   passage[di].gate := False;
passage[di].target := Nil;
END;
wet := dry;
class_ := land;
pool := nopool;
side := inside;
block := False;
warn := 0;
visit := False;
MaxVisit := MaxVisit + 1;
IF LineBuffer[2] = 'B' THEN
   class_ := beach;
IF LineBuffer[2] = 'W' THEN
   class_ := LAKE;
IF LineBuffer[3] = 'O' THEN
   pool := oilpool;
IF LineBuffer[3] = 'W' THEN
   pool := waterpool;
IF LineBuffer[4] = 'O' THEN
   side := outside;
column := 5;
readtoken;
debugit('LoadRoomDescription - room ' + trim(string_));
np := insert;
Name := np;
WITH np^ DO
   BEGIN
   Meaning := locate;
locval := rp;
END;
i := 0;
          (* WHILE (advent4 ^ <> '-') and ( advent4 ^ <> '+) DO *)
WHILE (fbuffer[1] <> '-') AND (fbuffer[1] <> '+') DO
   BEGIN
   ReadLine;
i := I + 1;
temp.c10[i] := linebuffer;
END;
(* While *)
dp := newdp(i);
dp^.ndls := i;
FOR j := 1 TO i DO
   dp^.c10[j] := temp.c10[j];
rp^.tell := dp;
END;
(* with rp^ *)
END;
(* WHILE file line starts with + *)
debugit('<LoadRoomDescription');
END;
(* LoadRoomDescriptions *)

PROCEDURE LoadInterConnections;

VAR 
   fp, tp, dp:  nameptr;
BEGIN
(* LoadInterConnections *)
      (* WHILE advent4^ = '-' DO *)
WHILE fbuffer[1] = '-' DO
   BEGIN
   ReadLine;
Column := 2;
ReadToken;
debugit('LoadInterConnections - rm ' + trimRIght(string_));
fp := findname(locate);
readtoken;
tp := findname(locate);
string_[1] := chr(0);
REPEAT
   IF string_[1] = chr(0) THEN
      readtoken;
   IF string_[1] <> chr(0) THEN
      WITH fp^.locval^ DO
         BEGIN
         dp := findname(direct);
   passage[dp^.dirval].target := tp^.locval;
   IF dp^.dirval = magic THEN
      magch := string_[1];
   readtoken;
   IF (string_[1] = chr(0)) AND (rvalue <> 0) THEN
      BEGIN
      passage[dp^.dirval].gate := True;
   block := rvalue In [1..3, 5..9, 11];
   warn := rvalue;
END;
END;
(* with *)
UNTIL (string_[1] = chr(0)) AND (rvalue = 0);
END;
(* while *)
END;
(* LoadInterConnections *)

PROCEDURE LoadNounLocations;

VAR 
   np, lp:  nameptr;
BEGIN
(* LoadNounLocations *)
debugging := true;
      (* WHILE advent4^ = '+' DO *)
WHILE fbuffer[1] = '+' DO
   BEGIN
   readline;
column := 2;
readtoken;
lp := findname(locate);
readtoken;
REPEAT
   np := findname(known);
   WITH np^ DO
      BEGIN
      IF nounval IN treas THEN
         MaxTreas := MaxTreas + [nounval];
   IF NounVal = Clam THEN
      MaxTreas := MaxTreas + [Pearl];
END;
(* with *)
WITH lp^.locval^ DO
   present := present + [np^.nounval];
ReadToken;
UNTIL string_[1] = chr(0);
END;
(* while *)
debugit('Load Noun Locations '+ nounsetToString(lp^.locval^.present) );

END;
(* LoadNounLocations *)

PROCEDURE LoadSpecialLocations;
        (* each special location is on its own line,
           with a prefix (starts column 2 *)
FUNCTION Next:  locptr;

VAR 
   np:  nameptr;
BEGIN
(* next *)
readline;
column := 2;
readtoken;
np := findname(locate);
Next := np^.locval;
END;
(* next *)

BEGIN
(* LoadSpecialLocations *)
startloc := Next;
debugit(' Start =' + LocPtrtoSTring(startloc, False));
treasloc := Next;
debugit(' Start =' + LocPtrtoSTring(treasloc, False));
boatloc := Next;
debugit(' Start =' + LocPtrtoSTring(boatloc, False));
chestloc := Next;
debugit(' Start =' + LocPtrtoSTring(chestloc, False));
END;
(* LoadSpecialLocations *)


PROCEDURE removewords;

VAR 
   p1, p2:  nameptr;
BEGIN
(* removewords *)
p1 := root;
p2 := Nil;
REPEAT
   IF (p1^.meaning = locate) OR ((p1^.meaning = direct) AND
      (p1^.dirval = alter)) THEN
      IF p2 = NIL THEN
         BEGIN
         p1 := root^.slnk;
   root := p1;
END
ELSE
   BEGIN
   p1 := p1^.slnk;
p2^.slnk := p1;
END
ELSE
   BEGIN
   p2 := p1;
p1 := p1^.slnk;
END
UNTIL p1 = NIL;
END;
(* removewords *)


PROCEDURE buildtree;

VAR 
   p1, p2, p3:  nameptr;

FUNCTION tieslnk(Var p1: nameptr; lvl: integer):  nameptr;
BEGIN
(* tieslnk *)
IF p1^.ndf = defn THEN
   tieslnk := p1
ELSE
   BEGIN
   p1^.slnk := tieslnk(p1^.llnk,lvl+1);
tieslnk := tieslnk(p1^.rlnk,lvl+1);
END;
END;
(* TieSlnk *)

BEGIN
(* buildtree *)
debugging := true;
debugit('buildtree root '+ nameptrtostring(root) + ' slink ' + nameptrtostring(root^.slnk) );
WHILE root^.slnk <> NIL DO
   BEGIN
   p1 := root;
new(p2);
WITH p2^ DO
   BEGIN
   slnk := Nil;
ndf := node;
llnk := p1;
rlnk := p1^.slnk;
END;
(* with *)
p1 := p1^.slnk^.SLNK;
root := p2;
WHILE p1 <> NIL DO
   IF p1^.slnk = NIL THEN
      BEGIN
      P2^.SLNK := p1;
p1 := Nil;
END
ELSE
   BEGIN
   new(p3);
WITH p3^ DO
   BEGIN
   slnk := Nil;
ndf := node;
llnk := p1;
rlnk := p1^.slnk;
END;
(* with *)
p1 := p1^.slnk^.slnk;
P2^.SLNK := p3;
p2 := p3;
END;
END;
(* while *)
p1 := tieslnk(root,0);
END;
(* buildtree *)

BEGIN
(* Initialize *)
    (* Linelimit(OUTPUT, -1); Another NOS function *)
debugging := false;
Definition := True;
Root := Nil;
String_[1] := chr(0);
Treas := [CHAIN..Vase];
MaxTreas := [];
Discovt := [];
MaxVisit := 0;
ActVisit := 0;

GetFIL;
debugit('Init - post getfil');
    (* Reset(Advent4); moved to getfil*)
ReadLine;
MOfDay := LineBuffer;
ReadLine;

(* Debug
              WHILE LineBuffer[1] <> Chr(0) DO
                BEGIN
                Writeln(DebugFile,LineBuffer);
                readline;
                END;   halt; *)
debugit('init - about to enter direction ');
FOR di := enter TO west DO
   BEGIN
   debugit('init-entering ' + directwords[di]);
EnterDirection(DI);
END;
FOR ai := brief TO Yes DO
   EnterAction(ai);
FOR NI := all TO wolf DO
   BEGIN
   debugit('init-entering ' + nounwords[ni]);
EnterNoun(NI);
END;
LoadNounDescriptions;
LoadSynonyms;
LoadRoomDescriptions;



LoadInterconnections;
LoadNounLocations;
LoadSpecialLocations;
BoatPos := BoatLoc;
BoatLoc^.present := BoatLoc^.present + [boat];
   (* RemoveWords; removed for saving and restoring game.*)
Buildtree;
debugging := true;
debugroot1;
Where := startloc;
was := Nil;
new(void);
WITH void^ DO
   BEGIN
   slnk := Nil;
ndf := defn;
meaning := unknown;
END;
(* with *)
new(wall);
WITH wall^ DO
   BEGIN
   slnk := Nil;
ndf := defn;
meaning := known;
nounval := all;
END;
(* with *)
string_[1] := chr(0);
rvalue := 9;
column := 1;
definition := False;
wordptr := Nil;
commands := 0;
moves := 0;
darkmoves := 0;
done := False;
briefly := False;
question := InfoQuest;
carry := [];
numdied := 0;
rowflag := False;
numorc := ORCNUMBER;
saforc := orcsafe;
strangle := 0;
rightech := False;
pstate := pwait;
    (* SNAP('ADVORG    '); function that would write out memory to a loadable program *)
IF mofday[1] <> chr(0) THEN
   BEGIN
   i := 1;
WHILE mofday[i] <> chr(0) DO
   BEGIN
   Write(mofday[i]);
i := i + 1;
END;
writeln;
END;
writeln;
writeln('Welcome to Adventure.  Would you like instructions?');

Randomize;
debugit('<init - done ');
END;
(* Initialize *)

  (* Utility Procedures *)

PROCEDURE print(Var l: line);

VAR 
   i:  integer;
BEGIN
(* print *)
i := 1;
WHILE (I < 71) AND (l[i] <> chr(0)) DO
   BEGIN
   Write(l[i]);
i := i + 1;
END;
writeln;
END;
(* PrintLN *)

FUNCTION pword:  char;

VAR 
   i:  integer;
   c:  char;
   f:  boolean;
BEGIN
(* pword *)
i := 1;
REPEAT
   c := string_[i];
   i := i + 1;
   f := i < 11;
   IF f THEN
      f := string_[i] <> chr(0);
   IF f THEN
      Write(c);
UNTIL NOT f;
pword := c;
END;
(* pword *)

PROCEDURE tellnoun(n: noun; brevity: boolean);

VAR 
   i:  integer;
   brief:  boolean;
   cn:  Noun;
BEGIN
(* tellnoun *)

brief := brevity;
WITH nouns[n], tell^ DO
   BEGIN
   IF NOT told THEN
      BEGIN
      IF n IN treas THEN
         discovt := discovt + [n];
told := True;
brief := False;
END;
IF brief THEN
   print(c10[1])
ELSE
   IF special THEN
      CASE what OF 
         Bottle:  print(c10[Ord(bottlecontents) + 2]);
         cage:  print(c10[Ord(cagecontents) + 2]);
         lamp:  print(c10[Ord(burning) + 2]);
         match:  IF NOfMatches = 0 THEN
                    print(c10[3])
                 ELSE
                    print(c10[2]);
         plant:  print(c10[Ord(Height) + 2]);
         chest:
                 BEGIN
                 print(c10[Ord(cheststate) + 2]);
         pstate := pdone;
         IF cheststate = treasurechest THEN
            IF chestcontents <> [] THEN
               BEGIN
               writeln('  I see the following things inside:');
         FOR cn := chain TO vase DO
            IF cn IN chestcontents THEN
               tellnoun(cn, True);
      END;
END;
(* chest *)
bear:  PRINT(C10[Ord(BEARSTATE) + 2]);
BIRD:  PRINT(C10[Ord(BIRDSTATE) + 2]);
CLAM:  PRINT(C10[Ord(CLAMOPN) + 2]);
WOLF:  PRINT(C10[Ord(LIFE) + 2]);
END
(* case *)
ELSE
   FOR I := 2 TO NDLS DO
      PRINT(C10[I]);
END;
(* with *)
END;
(* tellnoun *)

PROCEDURE OOPS;
BEGIN
(* OPS *)
ROWFLAG := False;
IF WORDPTR^.Meaning = DIRECT THEN
   MOVES := MOVES + 1;
WRITELN;
IF NUMDIED = 0 THEN
   WRITELN('My! You seem to have gotten yourself killed.')
ELSE
   WRITELN('My! You seem to have gotten yourself killed, again');
CASE numdied OF 
   0:
       BEGIN
       writeln('Being magical, I may be able to help you.');
   writeln('Do you want me to try to reverse the effects');
   writeln('of your recent death?');
END;
1:
    BEGIN
    writeln('You certainly know how to get into trouble!');
writeln('The second time, reversing the effects of ');
writeln('death is harder.  Shall I try?');
END;
2:
    BEGIN
    writeln('Well!  That does it!  I''m not going to help ');
writeln('you if you can''t stay out of trouble.  Do ');
writeln('you want to try your own resurrection?');
END;
3:
    BEGIN
    writeln('Taps, old buddy.  So long');
done := True;
END;
END;
(* case *)
numdied := numdied + 1;
question := deadquest;
    (* goto 50; ( * ask question immediately *)
AskQuestionImmediately := True;
END;
(* OPS *)

FUNCTION light:  boolean;
BEGIN
(* light *)
WITH where^ DO
   WITH nouns[lamp] DO
      light := (side = outside) Or ((lamp In (carry + present)) And burning);
END;
(* light *)

PROCEDURE warning;
BEGIN
(* warning *)
WITH where^ DO
   IF block THEN
      BEGIN
      IF warn IN [1..9] THEN
         CASE warn OF 
            1:  writeln('The door is locked.');
            2:  writeln('The grate is locked.');
            3:  writeln('The iron door is rusted shut.');
            4:  tellnoun(plant, False);
            5:  writeln('The fissure blocks your way.');
            6:  writeln('a shimmering wall blocks the passage');
            7:  writeln('The fault blocks your way.');
            8:  writeln('The wall blocks your way.');
            9:  writeln('The canyon blocks your way.');
         END;
(* case *)
END
(* IF *)
ELSE
   IF warn IN [1..9, 12] THEN
      CASE warn OF 
         1:  writeln('The door is unlocked.');
         2:  writeln('The grate is unlocked.');
         3:  writeln('Th43e iron door is open.');
         4:  tellnoun(plant, False);
         5:  writeln('A crystal bridge spans the fissure.');
         6:  writeln('The passage is clear.');
         7:  writeln('The rope provides a way past the fault.');
         8:  writeln('The ladder rests in place.');
         9:  writeln('The bridge spans the canyon.');
         12:  IF (commands MOD 3) <> 0 THEN
                 writeln('An armed guard patrols the passage.');
      END;
(* case *)
END;
(* warning *)

PROCEDURE telllocation(brevity: boolean);

VAR 
   i:  integer;
   np:  Noun;
   tset:  Nounset;
BEGIN
(* tell location *)
IF light THEN
   WITH where^, tell^ DO
      BEGIN
      IF brevity AND visit THEN
         print(c10[1])
      ELSE
         FOR i := 2 TO ndls DO
            print(c10[i]);
IF NOT visit THEN
   BEGIN
   actvisit := actvisit + 1;
visit := True;
END;
CASE wet OF 
   dry: ;
   oilwet:  writeln('The ground is wet with oil.');
   waterwet:  writeln('The ground is wet with water.');
END;
(* case *)
IF warn <> 0 THEN
   warning;
IF boat IN carry THEN
   writeln('You are in a boat.');
IF bear IN carry THEN
   writeln('A large bear is following you.');
tset := present - [oil, plant, water, dragon, snake];
IF warn IN [7, 8, 9] THEN
   CASE warn OF 
      7:  tset := tset - [rope];
      8:  tset := tset - [ladder];
      9:  tset := tset - [bridge];
   END;
(* with *)
IF tset <> [] THEN
   BEGIN
   debugit('TellLocation tset ' + NounSettoString(tset));
IF card(tset) = 1 THEN
   writeln('  I see an object here.')
ELSE
   writeln('  I see objects here.');
FOR np := axe TO wolf DO
   IF np IN tset THEN
      tellnoun(np, True);
END;
IF dragon IN present THEN
   writeln('The dragon blocks your way!');
IF wolf IN present THEN
   writeln('The wolf blocks your way!');
IF bear IN present THEN
   writeln('The bear blocks your way!');
IF snake IN present THEN
   writeln('The snake blocks your way!');
END
(* with *)
ELSE (* not light *)
   BEGIN
   writeln('it''s too dark to see where you''re going.  If you');
writeln('proceed much further you may fall into a pit.');
END;
END;
(* tell location *)

PROCEDURE scoregame;

VAR 
   s, t:  integer;
BEGIN
(* scoregame *)
S := trunc(70 +
     100 * card(discovt) / card( maxtreas) +
     200 * card(maxtreas * treasloc^.present) / card(maxtreas) +
     130 * actvisit / maxvisit -
     17 * numdied);
writeln('You moved    ', moves: 4, ' times.');
writeln('You gave me  ', commands: 4, ' commands.');
writeln('Your score was ', s:4, ' out of 500.');
IF done THEN
   BEGIN
   writeln;
IF s = 500 THEN
   t := 6
ELSE
   BEGIN
   t := s Div 85;
s := 85 * (T + 1) - S;
IF T = 5 THEN
   S := S - 10;
END;
CASE t OF 
   0:  writeln('You are obviously a rank amateur. ');
   1:  writeln('You have achieved the rank of novice adventurer.');
   2:  writeln('You''ve acheived the rank of junior adventurer.');
   3:  writeln('You are a master adventure, class A.');
   4:  writeln('You have made master adventurer, class B.');
   5:  writeln('You have reached master adventure, class C.');
   6:  writeln('You''re a grandmaster adventurer! ');
END;
IF t <> 6 THEN
   writeln('You need ', s, ' more points for the next rank.');
IF t = 5 THEN
   BEGIN
   IF discovt <> maxtreas THEN
      writeln('Not finding all the treasures.');
IF discovt * treasloc^.present <> discovt THEN
   writeln('Not taking the treasures to the proper place.');
IF actvisit <> maxvisit THEN
   writeln('not completely exploring the park.');
IF numdied <> 0 THEN
   writeln('dying or resigning.');
END;
END;
END;
(* scoregame *)

  (* Game playing procedures *)

PROCEDURE queryhuman;

LABEL 
   99, (* don't understand loop *)
   100;
(* ask question immediately (oops) point *)

VAR 
   First:  boolean;
   idontunderstand:  boolean;

PROCEDURE blewit;
BEGIN
(* blewit *)
rowflag := False;
CASE trunc(random * 3) OF 
   0:  writeln('I don''t understand.');
   1:  writeln('Please rephrase that.');
   3:  writeln('You''ve got to be kidding.');
END;
      (* goto 99; *)
idontunderstand := True;
END;
(* blewit *)

PROCEDURE domovement;

LABEL 
   9;
(* blewit escape *)

VAR 
   go:  boolean;
   last:  locptr;
BEGIN
(* domovement *)
WITH where^ DO
   IF ([dragon, snake, bear, wolf] * present) <> [] THEN
      BEGIN
      IF dragon IN present THEN
         writeln('The dragon blocks your way!')
   ELSE IF (wolf IN present) AND (nouns[wolf].life = alive) THEN
           writeln('The wolf blocks your way!')
   ELSE IF (bear IN present) AND (nouns[bear].bearstate = angry) THEN
           writeln('The bear blocks your way!')
   ELSE (* the sneaky snake *)
      writeln('The snake blocks your way!');
go := False;
END
ELSE
   CASE class_ OF 
      land:  IF rowflag THEN
                BEGIN
                Write('You can''t row on land!');
      writeln('You''re not even in a boat.');
      go := False;
   END
ELSE
   go := True;
beach:  IF NOT (wordptr^.dirval IN [enter.exit]) THEN
           IF rowflag AND (NOT (boat IN carry)) THEN
              BEGIN
              writeln('You can''t row on land.');
go := False;
END
ELSE IF (NOT rowflag) AND
        (boat IN carry) THEN
        BEGIN
        writeln('You must row your boat.');
go := False;
END
ELSE
   go := True
ELSE
   go := true;
lake:  IF rowflag OR (wordptr^.dirval IN [enter, exit]) THEN
          go := True
       ELSE
          BEGIN
          Write('You can''t walk on water!  ');
writeln('Stay in the boat.');
go := False;
END;

END;
(* case *)

WHILE go DO
   BEGIN
   last := where;
WITH wordptr^, where^ DO
   IF meaning <> direct THEN
      BEGIN
      blewit;
GOTO  9;
END
ELSE IF (dirval IN [enter, exit]) AND
        (boat IN carry + present) THEN
        IF dirval = enter THEN
           IF boat IN carry THEN
              BEGIN
              go := False;
writeln('You''re already in the boat.');
END
ELSE
   BEGIN
   carry := carry + [boat];
present := present - [boat];
writeln('you''ve launched the boat.');
END
ELSE  (* dirval = exit *)
   IF boat IN carry THEN
      IF class_ = beach THEN
         BEGIN
         carry := carry - [boat];
present := present + [boat];
boatpos := where;
writeln('You''ve beached the boat.');
END
ELSE  (* not beach, ie. lake *)
   BEGIN
   writeln('Leaving the boat here gets you very wet.');
writeln('Since you cannot tread water very long...');
go := False;
oops;
GOTO 9
END
ELSE (* not carrying, but boat here *)
   BEGIN
   go := False;
writeln('You''re not in the boat.');
END
ELSE IF (dirval = jump) AND (warn IN
        [5, 7..9, 13, 17, 19]) THEN
        BEGIN
        writeln('You fall to your death.');
go := False;
oops;
END
ELSE (* not enter/exit, or jump *)
   WITH passage[dirval] DO
      IF target <> NIL THEN
         IF gate THEN
            IF block THEN
               BEGIN
               warning;
go := False;
END
ELSE (* not block *)
   BEGIN
   IF warn IN [4, 12, 13, 15..20] THEN
      CASE warn OF 
         4:  IF gate AND (nouns[plant].Height <> full) THEN
                where := passage[alter].target
             ELSE
                where := target;
         12:  IF (commands MOD 3) <> 0 THEN
                 BEGIN
                 writeln('The armed guard sees you and attacks!');
         go := False;
         BEGIN
         oops;
         GOTO 9
      END;
END
ELSE
   where := target;
13:
     BEGIN
     writeln('you have falln off the cliff.');
go := False;
BEGIN
oops;
GOTO 9
END;
END;
15:
     BEGIN
     writeln('The cave ceiling falls on you.');
go := False;
BEGIN
oops;
GOTO 9
END;
END;
16:  IF carry <> [] THEN
        BEGIN
        writeln('You''re carrying too much to go through.');
go := False;
END
ELSE
   where := target;
17:
     BEGIN
     writeln('You have fallen down a bottomless pit.');
go := False;
BEGIN
oops;
GOTO 9
END;
END;
18:
     BEGIN
     writeln('You have suffocated in bad air.');
go := False;
BEGIN
oops;
GOTO 9
END;
END;
19:  IF (carry - [lamp]) <> [] THEN
        BEGIN
        writeln(
                'You''re carrying so much that you loose your balance');
writeln('on the ledge and fall to your death.');
go := False;
BEGIN
oops;
GOTO 9
END;
END
ELSE
   where := target;
20:  IF random < 0.5 THEN
        where := target;
ELSE
   where := passage[alter].target
END
(* case *)
ELSE (* not warn in 4,12,13,15..20 *)
   where := target;
IF (where = was) AND go THEN
   was := Nil;
END
(* not block *)
ELSE (* not gate *)
   BEGIN
   IF dirval = magic THEN
      IF string_[1] <> magch THEN
         BEGIN
         blewit;
GOTO 9;
END;
where := target;
IF where = was THEN
   was := Nil;
END
(* not gate *)
ELSE (* target = nil *)
   IF dirval = magic THEN
      BEGIN
      blewit;
GOTO 9;
END
ELSE
   BEGIN
   go := False;
writeln('There is no way to go that direction.');
IF where <> was THEN
   writeln;
END;

IF go THEN
   moves := moves + 1;
CASE where^.class_ OF 
   land:  IF boat IN carry THEN
             BEGIN
             writeln('You''ve rowed your boat onto land,');
   writeln(
           'Which was so hard to do that you got a heart attack.');
   where := last;
   BEGIN
   oops;
   GOTO 9
END;
END;
beach: ;
lake:  IF NOT (boat IN carry) THEN
          BEGIN
          writeln('You''ve walked out on water');
writeln('Which is not kosher.');
where := last;
BEGIN
oops;
GOTO 9
END;
END;
END;
(* case *)
IF light THEN
   darkmoves := 0
ELSE  (* no light *)
   BEGIN
   go := False;
darkmoves := darkmoves + 1;
IF darkmoves > 3 THEN
   IF random < 0.1 THEN
      BEGIN
      writeln;
writeln('You fell into a pit!');
BEGIN
oops;
GOTO 9
END;
END;
END;
(* no light *)
IF go THEN
   BEGIN
   readtoken;
go := go And (wordptr^.meaning = direct);
END;
(* IF go *)
END;
(* while go *)
9: ;
(* blewit escape *)
END;
(* domovement *)

PROCEDURE doaction;

LABEL 
   11;
(* blewit exit *)

VAR 
   ap:  action;
   wp:  nameptr;
   st:  word;

PROCEDURE changeblock;

VAR 
   di:  direction;
BEGIN
(* changeblock *)
WITH where^ DO
   BEGIN
   block := Not block;
di := enter;
WHILE NOT passage[di].gate DO
   di := succ(di);
WITH passage[di] DO
   IF target^.warn = warn THEN
      target^.block := Not target^.block;
END;
(* with where *)
END;
(* changeblock *)

PROCEDURE removeblock;

VAR 
   di:  direction;
BEGIN
(* removeblock *)
WITH where^ DO
   BEGIN
   block := False;
di := enter;
WHILE NOT passage[di].gate DO
   di := succ(di);
WITH passage[di] DO
   IF target^.warn = warn THEN
      BEGIN
      target^.block := False;
IF warn IN [7..9] THEN
   CASE warn OF 
      7:  target^.present := target^.present + [rope];
      8:  target^.present := target^.present + [ladder];
      9:  target^.present := target^.present + [bridge];
   END;
(* case *)
END;
END;
(* where *)
END;
(* removeblock *)

PROCEDURE setblock;

VAR 
   di:  direction;
BEGIN
(* setblock *)
WITH where^ DO
   BEGIN
   block := True;
di := enter;
WHILE NOT passage[di].gate DO
   di := succ(di);
WITH passage[di] DO
   IF target^.warn = warn THEN
      BEGIN
      target^.block := True;
IF warn IN [7..8] THEN
   CASE warn OF 
      7:  target^.present := target^.present - [rope];
      8:  target^.present := target^.present - [ladder];
   END;
(* case *)
END;
END;
(* where *)
END;
(* setblock *)

PROCEDURE actiontake;

LABEL 14;
(* oops *)

VAR 
   cp:  noun;
   go:  boolean;
   tset:  nounset;

FUNCTION loadok(n: nounset):  boolean;

VAR 
   wght:  integer;
   nv:  noun;
BEGIN
(* load ok *)
wght := 0;
FOR nv := axe TO wolf DO
   IF nv IN (carry + n) THEN
      IF nv IN [axe, bottle, cage .. keys, lamp .. nail,
         plant .. rope, chain, coin .. vase] THEN
         wght := wght + 1
   ELSE IF nv = knIFe THEN
           wght := wght + 2
   ELSE IF nv = ladder THEN
           wght := wght + 3
   ELSE IF nv = clam THEN
           wght := wght + 8
   ELSE IF nv = wood THEN
           wght := wght + nouns[wood].pilesize
   ELSE IF nv = chest THEN
           WITH nouns[chest] DO
              IF (cheststate <> treasurechest) OR
                 (chestcontents = []) THEN
                 wght := wght + 1
              ELSE
                 wght := wght + 10;
loadOK := wght <= 9;
END;
(* load ok *)

PROCEDURE dotake;

LABEL 13;
(* for replacing oops's 50 *)
BEGIN
(* dotake *)
WITH where^ DO
   IF cp IN [oil, water] THEN
      BEGIN
(* liquid *)
      writeln('You can''t take ', pword,
              ', it will flow through your hands.');
go := False;
END
(* liquid *)
ELSE IF cp IN (present + tset) THEN
        IF cp IN [boat, plant, bridge, dragon .. wolf] THEN
           BEGIN
           writeln('You can''t take a ', pword, '.');
go := False;
END
(* nouns that can't be taken *)
ELSE IF cp = bear THEN
        IF nouns[bear].bearstate = angry THEN
           BEGIN
           writeln('The bear is angry and does not like your approach.');
writeln('He attacks and mauls you.');
BEGIN
oops;
GOTO 13
END;
END
ELSE (* not angry *)
   BEGIN
   present := present - [bear];
carry := carry + [bear];
writeln('The bear will follow you.');
END
(* bear *)
ELSE IF cp = bird THEN
        IF rod IN carry THEN
           BEGIN
           writeln('The bird was unafraid when you first appeared.');
writeln('but now it withdraws as you approach.');
go := False;
END
(* carrying rod *)
ELSE IF cage IN carry THEN
        BEGIN
        present := present - [bird];
carry := carry + [bird];
nouns[cage].cagecontents := birdincage;
nouns[bird].birdstate := cagedbird;
END
(* have cage for bird *)
ELSE
   BEGIN
   writeln('You need a bird cage. ');
go := False;
END
(* bird *)
ELSE
   IF loadok([cp]) THEN
      BEGIN
      IF cp IN present THEN
         present := present - [cp]
ELSE
   WITH nouns[chest] DO
      chestcontents := chestcontents - [cp];
carry := carry + [cp];
IF cp IN treas THEN
   discovt := discovt + [cp];
IF warn IN [7, 8] THEN
   CASE warn OF 
      7:  IF cp = rope THEN
             setblock;
      8:  IF cp = ladder THEN
             setblock
   END;
(* case *)
IF cp = cage THEN
   IF nouns[cage].cagecontents = birdincage THEN
      BEGIN
      present := present - [bird];
carry := carry + [bird];
END;
END
(* load ok *)
ELSE  (* load not ok *)
   BEGIN
   writeln('You can''t carry any more weight.');
writeln('You''ll have to drop something.');
go := False;
END
(* load not ok *)
ELSE (* not in present + tset *)
   BEGIN
   IF light THEN
      writeln('I see no ', pword, ' here.')
ELSE
   writeln('It''s to dark to see anything.');
go := False;
END;
(* not in present + tset *)
13: ;
(* oops *)
END;
(* dotake *)

BEGIN
(* action take *)
WITH where^ DO
   BEGIN
   tset := present - [boat, bridge, oil, plant,
           water, dragon .. wolf];
IF chest IN present THEN
   WITH nouns[chest] DO
      IF cheststate = treasurechest THEN
         tset := tset + chestcontents;
IF wordptr^.nounval = all THEN
   IF NOT light THEN
      writeln('It''s too dark to see anything.')
ELSE IF tset = [] THEN
        writeln('I see nothing to take.')
ELSE IF NOT loadOK(tset) THEN
        writeln('You can''t take everything here.')
ELSE (* OK to take everything *)
   BEGIN
   IF card(tset) > 1 THEN
      writeln('You''ve taken the following things:')
ELSE
   writeln('You''ve taken the following thing:');
FOR cp := axe TO clam DO
   IF cp IN tset THEN
      BEGIN
      go := True;
dotake;
IF askquestionimmediately THEN
   GOTO 14;
IF go THEN
   tellnoun(cp, True);
END;
END
(* take everything *)
ELSE (* not 'all' *)
   BEGIN
   go := True;
REPEAT
   cp := wordptr^.nounval;
   dotake;
   IF askquestionimmediately THEN
      GOTO 14;
   readtoken;
UNTIL (NOT go) OR (wordptr^.meaning <> known);
IF go THEN
   writeln('OK.');
END;
(* not all *)
END;
(* with where^ *)
14: ;
(* ask question immediately *)
END;
(* action take *)

PROCEDURE actiondrop;

VAR 
   cp:  noun;
   go:  boolean;
   clm:  (nocm, onecm, twocm);

PROCEDURE dodrop;
BEGIN
(* do drop *)
WITH where ^ DO
   IF cp IN [oil, water] THEN
      BEGIN

END
(* oil or water *)
ELSE IF cp = bird THEN
        IF bird IN carry THEN
           BEGIN

END
(* bird in carry *)
ELSE
   BEGIN
   writeln('You''re not carrying a bird.');
go := false;
END
ELSE IF cp = cage THEN
        IF cage IN carry THEN
           IF bird IN carry THEN
              BEGIN
              carry := carry - [bird,cage];
IF class_ <> lake THEN
   present := present + [bird, cage ];
END
(* cage and bird *)
ELSE (* only cage *)
   BEGIN
   carry := carry - [cage];
IF class_ <> lake THEN
   present := present + [cage]
END
(* only cage *)
ELSE
   BEGIN
   writeln('You''re not carrying a cage.');
go := false;
END

ELSE IF cp IN carry THEN
        BEGIN
        carry := carry - [cp];
IF class_ <> lake THEN
   BEGIN
   present := present + [cp];
IF cp = clam THEN
   IF class_ = beach THEN
      WITH nouns[clam] DO
         BEGIN
         clm := onecm;
IF clamopn = never THEN
   BEGIN
   clamopn := hasbeen;
present := present + [pearl];
clm := twocm;
END
(* never opened *)
END;
(* with nouns[clam ] *)
IF cp = vase THEN
   IF NOT (pillow IN present) THEN
      BEGIN
      present := present - [vase];
present := present + [shard];
writeln('The ming vase delicately breaks.');
END
(* dropping without pillow *)
ELSE
   BEGIN
   present := present + [vase];
writeln('The Ming vase lands delicately on the pillow.')
END
END
(* not on lake *)
END
(* carrying the object *)
ELSE
   BEGIN
   writeln('You''re not carrying a ',pword,'.');
go := false;
END

END;
(* do drop *)

BEGIN
(* action drop *)
WITH where^ DO
   BEGIN
   clm := nocm;
go := true;
IF wordptr^.nounval = all THEN
   IF (carry -[boat,bear]) = [] THEN
      writeln('You''ve nothing to drop.')
ELSE
   BEGIN
   FOR cp := axe TO clam DO
      IF CP IN (Carry - [boat,bear]) THEN
         doDrop
END
ELSE
   REPEAT
      CP := WordPtr^.NounVal;
      DODrop;
      ReadToken
   UNTIL (wordPtr^.meaning <> known) OR (NOT go);
IF go THEN
   IF class_ = lake THEN
      writeln('Everything dropped into the lake.')
ELSE
   IF WordPtr^.meaning = known THEN
      writeln('everything has been dropped.')
ELSE
   writeln('OK.');
IF clm > nocm THEN
   BEGIN
   writeln('The clam touches the water and open momentarily');
IF clm = twocm THEN
   BEGIN
   writeln('While the clam is open something rolls out.');
END
END
(* clm > nocm *)
END;
(* with *)
END;
(* action drop *)



PROCEDURE actiondescribe;

VAR 
   cp:  noun;
BEGIN
(* actiondescribe *)
WITH where^ DO
   BEGIN
   cp := nill;
IF wordptr^.nounval = all THEN
   BEGIN
(* all *)
   IF card(carry + present) > 1 THEN
      writeln('I see the following things to describe:')
ELSE
   writeln('I see the following thing  to describe:');
FOR cp := axe TO wolf DO
   IF cp IN (carry + present) THEN
      tellnoun(cp, False);
END
(* all *)
ELSE (* no all *)
   REPEAT
      WITH wordptr^ DO
         BEGIN
         IF meaning = unknown THEN
            BEGIN
            IF cp = nill THEN
               writeln('I don''t know what to describe.');
   END
(* unknown *)
ELSE IF meaning <> known THEN
        BEGIN
        IF cp = nill THEN
           writeln('I can only describe objects.');
END
(* not known *)
ELSE
   BEGIN
   cp := nounval;
IF cp IN (carry + present) THEN
   tellnoun(cp, False)
ELSE
   writeln('I see no ', pword, ' here.');
END;
END;
(* with wordptr *)
readtoken
UNTIL wordptr = void;
END;
(* with *)
END;
(* action describe *)

PROCEDURE actioninven;

VAR 
   cp:  noun;
   tset:  nounset;
BEGIN
(* actioninven *)
tset := carry - [boat, bear];
IF tset = [] THEN
   writeln('you''re not carrying anything.')
ELSE
   BEGIN
   IF card(tset) > 1 THEN
      writeln('You are carrying the following things:')
ELSE
   writeln('You are carrying the following thing:');
FOR cp := axe TO wolf DO
   IF cp IN tset THEN
      tellnoun(cp, True);
END;
END;
(* action inven *)

PROCEDURE actionfill;
BEGIN
(* actionfill *)
ReadToken;
WITH WORDPTR^, WHERE^, Nouns[Bottle] DO
   BEGIN
   IF meaning = known THEN
      IF nounval = LAMP THEN
         BEGIN
         IF Lamp IN carry THEN
            IF nouns[lamp].TimeLeft <= 15 THEN
               IF nouns[lamp].burning THEN
                  BEGIN
                  write('You can''t fill your lantern while ');
writeln('its burning.')
END
ELSE (* not burning *)
   IF (bottle IN carry) AND
      (bottlecontents = oilinbottle) THEN
      BEGIN
      Nouns[lamp].TimeLeft := BURNTIME;
bottlecontents := emptybottle;
writeln('OK.');
END
ELSE IF pool = oilpool THEN
        BEGIN
        nouns[lamp].timeleft := burntime;
writeln('OK.')
END
ELSE
   Writeln('There is nothing here to fill your lantern.')
ELSE
   writeln('It is not time to fill the lantern.')
ELSE
   writeln('You are not carrying the lantern.')
END
(* noun is lamp *)
ELSE IF nounval = bottle THEN
        BEGIN
        readtoken;
IF NOT (bottle IN carry) THEN
   writeln('You''re not carrying a bottle.')
ELSE IF bottlecontents <> emptybottle THEN
        writeln('Your bottle is already filled.')
ELSE IF (wordptr = VOID) THEN
        CASE pool OF 
           oilpool :
                      BEGIN
                      bottlecontents := oilinbottle;
           writeln('Your bottle is now full of oil.')
        END;
waterpool :
             BEGIN
             bottlecontents := waterinbottle;
writeln('Your bottle is now full of water.')
END;
NOPOOL :
          writeln('There is nothing here with which to fill your bottle.')
END
(* case *)
ELSE IF wordptr^.nounval = oil THEN
        IF pool = oilpool THEN
           BEGIN
           bottlecontents := oilinbottle;
writeln('Your bottle is now full of oil.')
END
ELSE
   writeln('There is no oil here.')
ELSE IF wordptr^.nounval = water THEN
        IF pool = waterpool THEN
           BEGIN
           bottlecontents := waterinbottle;
writeln('Your bottle is now full of water.')
END
ELSE
   Writeln('There is no water here.')
ELSE IF wordptr^.meaning <> known THEN
        blewit
ELSE
   blewit
END
(* bottle *)
ELSE
   blewit
END
(* with *)
END;
(* actionfill *)

PROCEDURE actionempty;

LABEL 77;
BEGIN
(* action empty *)
WITH wordptr^ DO
   IF meaning = known THEN
      IF NOT(nounval IN [bottle,oil,water]) THEN
         BEGIN
         blewit;
GOTO 77;
END
ELSE
   IF bottle IN carry THEN
      WITH nouns [bottle] DO
         CASE nounval OF 
            bottle: ;
            oil :
                   IF bottlecontents <> oilinbottle THEN
                      BEGIN
                      writeln('The bottle does not contain coil.');
            GOTO 77;
         END;
water :
         IF bottlecontents <> waterinbottle THEN
            BEGIN
            writeln('The bottle does not contain water.');
GOTO 77
END;
END;
(* case *)
WITH where^, nouns[bottle] DO
   IF NOT (bottle IN carry) THEN
      writeln('You are not carrying anything that can be emptied.')
   ELSE
      CASE bottlecontents OF 
         emptybottle :  writeln('Your bottle is empty.');
         oilinbottle :
                        BEGIN
                        bottlecontents := emptybottle;
         IF class_ <> lake THEN
            IF (Warn = 3) AND block THEN
               BEGIN
               Removeblock;
         Writeln('The oil frees the door and it swings open.')
      END
   ELSE
      BEGIN
      wet := oilwet;
writeln('The ground is now wet with oil.')
END
ELSE
   writeln('You have polutted the lake with oil.')
END;
(* oil in bottle *)
waterinbottle :
                 BEGIN
                 bottlecontents := emptybottle;
IF class_ <> lake THEN
   BEGIN
   IF warn = 4 THEN
      IF nouns[plant].height < overgrown THEN
         BEGIN
         nouns[plant].height := succ(nouns[plant].height);
tellnoun(plant,false)
END
ELSE
   BEGIN
   writeln('Watering the plant is now useless.');
wet := waterwet;
writeln('The ground is now wet with water.')
END
(* overwatered *)
ELSE
   BEGIN
   wet := waterwet;
writeln('The ground is now wet with water.')
END
END
(* class <> lake *)
ELSE
   writeln('You''ve emptied your bottle in the lake.')
END
(* waterinbottle *)
END;
(* case *)
77: ;
END;
(* action empty *)

PROCEDURE ActionOn;

LABEL 16;
BEGIN
(* on *)
WITH wordptr^, where^, nouns[lamp] DO
   BEGIN
   IF meaning = known THEN
      IF nounval <> lamp THEN
         BEGIN
         blewit;
GOTO 16;
END;
IF NOT (lamp IN (carry + present)) THEN
   IF light THEN
      writeln('I see no lamp here')
ELSE
   writeln('It''s too dark to see anything.')
ELSE IF burning THEN
        writeln('The lantern is already on.')
ELSE IF NOT (match IN (carry + present)) THEN
        writeln('You need matches to light the lantern.')
ELSE IF nouns[match].nofmatches <= 0 THEN
        writeln('Sorry, you''re out of matches.')
ELSE
   BEGIN
   nouns[match].nofmatches := nouns[match].nofmatches -1;
IF nouns[match].nofmatches <= 0 THEN
   writeln('That was your last match.');
IF timeleft <= 0 THEN
   writeln('The lantern has no more fuel in it.')
ELSE
   BEGIN
(* actually light the lamp *)
   burning := true;
writeln('The lantern is on.');
IF side = inside THEN
   telllocation(briefly);
END
END
END;
(* with *)
16: ;
(* blewit *)
END;
(* Action ON *)

PROCEDURE ActionOff;
BEGIN
(* off *)
WITH wordptr^ DO
   IF (meaning = known) AND (nounval = lamp) THEN
      IF Lamp IN (carry + where^.present) THEN
         WITH Nouns[lamp] DO
            IF burning THEN
               BEGIN
               burning := false;
writeln('The lantern is off.')
END
ELSE
   writeln('The lantern is already off.')
ELSE
   IF LIGHT THEN
      writeln('I see no lantern here.')
ELSE
   writeln('It''s too dark to see anything.')
ELSE (* trying to turn on something else*)
   blewit;
END;
(* OFF *)

PROCEDURE actiondrink;
BEGIN
(* actiondrink *)
WITH wordptr^, where^, nouns[bottle] DO
   IF (meaning <> known) OR
      ((meaning = known) AND (nounval = bottle)) THEN
      IF bottle IN carry THEN
         CASE bottlecontents OF 
            emptybottle :  writeln('Your bottle is empty.');
            oilinbottle :  writeln('Ugh.  Oil is not patalatable.');
            waterinbottle:
                            BEGIN
                            writeln('Thank you, I was thirsty.');
            writeln('Your bottle is now empty.');
            bottlecontents := emptybottle
         END;
END
(* case *)
ELSE
   writeln('You''re not carrying a bottle.')
ELSE IF nounval = oil THEN
        IF pool = oilpool THEN
           writeln('Ugh.  Oil is not palatable.')
ELSE
   writeln('I see no oil here.')
ELSE IF nounval = water THEN
        IF pool = waterpool THEN
           writeln('Thank you.  I was thirsty.')
ELSE
   writeln('I see no water here.')
ELSE
   blewit
END;
(* actiondrink *)

PROCEDURE actioneat;
BEGIN
(* actioneat *)
WITH wordptr^ DO
   IF meaning = known THEN
      IF nounval <> food THEN
         blewit
   ELSE IF food IN carry THEN
           BEGIN
           carry := carry - [food];
writeln('thank you.  The food is quite tasty.');
END
ELSE
   writeln('I see nothing to eat in your possession.');
END;
(* actioneat *)

PROCEDURE actionswim;
BEGIN
(* actionswim *)
IF where^.Class_ IN [beach, lake] THEN
   BEGIN
   writeln('Blub! Blub! I forgot to tell you that fully');
writeln('equiped adventurers are to clumsy to swim.');
oops;
END;
END;
(* action swim *)

PROCEDURE ActionUnlock;
BEGIN
(* ActionUnlock *)
WITH where^ DO
   IF NOT (keys IN carry) THEN
      writeln('You''re not carrying any keys.')
   ELSE
      IF warn IN [1,2] THEN
         IF Block THEN
            BEGIN
            REMOVEBLOCK;
WARNING
END
ELSE
   writeln('The lock is already unlocked.')
ELSE IF Chest IN present THEN
        IF rod IN carry THEN
           WITH nouns[chest] DO
              IF cheststate = lockedchest THEN
                 BEGIN
                 cheststate := treasurechest;
told := false;
writeln('The chest opens revealing the treasures inside.')
END
(* locked chest *)
ELSE
   writeln('The chest is already open.')
ELSE
   writeln('You don''t have everything you need to open the chest.')
ELSE
   writeln('I see nothing with a lock around here.')
END;
(* Action unlock *)

PROCEDURE ActionLock;
BEGIN
(* Lock *)
WITH WHERE^ DO
   IF NOT (keys IN carry) THEN
      writeln('You''re not carying any keys.')
   ELSE IF warn IN [1,2] THEN
           IF block THEN
              writeln('The lock is already locked')
   ELSE
      BEGIN
      setblock;
warning;
END
ELSE
   writeln('I see no lock around here.')
END;
(* action lock *)


PROCEDURE actionrow;
BEGIN
(* actionrow *)
readtoken;
IF wordptr^.meaning = direct THEN
   BEGIN
   rowflag := True;
domovement;
rowflag := False;
END
ELSE
   writeln('Which direction do you want to row?');
END;
(* action row *)

PROCEDURE actionrub;
BEGIN
(* action rub *)
readtoken;
WITH wordptr^ DO
   IF nounval IN carry THEN
      IF nounval = rod THEN
         writeln('Rubbing the rod doesn''t do anything interesting.')
   ELSE IF nounval = lamp THEN
           writeln('Shining the lamp doesn''t do anything interestingf.')
   ELSE
      writeln('Nothing interesting happens.')
   ELSE
      writeln('You don''t have it.')
END;
(* action rub *)

PROCEDURE supplyhelp;
BEGIN
(* supplyhelp *)
writeln('  I know of directions, actions, and objects.  To');
writeln('move from one place to another, use compass points ');
writeln('or directions like: east, down, or enter.  Rarely');
writeln('a magic word will move you from one place to ');
writeln('another.  If you know the exact route, you may enter ');
writeln('a series of directions and I will follow them.');
writeln('  I know about many objects.  To manipulate');
writeln('objects, use some action word followed by an ');
writeln('object. To pick up a rod, say, ''take rod''.');
writeln('Sometimes, if you omit the object, I will assume');
writeln('all objects present.');
writeln('  Objects can have side effects.  The rod scares the');
writeln('the bird.  Some objects will change the cavern if');
writeln('properly used.');
writeln('  Some helpful words are: ''look'' - look around at');
writeln('your present position; ''describe object'' - I will');
writeln('tell you more about an object; and ''inventory'' - I');
writeln('will list what you''re carrying.  Most directions and');
writeln('some verbs can be abriviated, n for north, etc., d for down,');
writeln('l for look, x for examine or describe, and i for inventory.');
writeln('  Usually, people having trouble are trying something ');
writeln('beyond my capabilities and should try a ');
writeln('completely different tack.  Also, cave passages turn a ');
writeln('lot, and leaving a room to the north doesn''t');
writeln('guarantee you can go back by going south.');
writeln;
writeln('Good luck!');

END;
(* supplyhelp *)

PROCEDURE supplyinfo;
BEGIN
writeln('   If you want to end your adventure early, say ');
writeln('''quit''.  If you get into trouble and can''t find a');
writeln('way out, say ''resign''.  To see how well you''re ');
writeln('doing. say ''score''.  To save paper, say ''brief'',');
writeln('and I''ll tell you the full description of a room');
writeln('only the first time you get there.  to always get');
writeln('get the full description, say ''verbose''.  To suspend ');
writeln('your adventure, say ''save name''. ');
writeln('   To get full credit for a treasure you must have');
writeln('left it safely in the wellhouse.  You get points for just');
writeln('discovering treasures and exploring the cavern.');
writeln('You lose points for getting killed or resigning. ');

END;
(* supply info *)

PROCEDURE actionbuild;

LABEL 19;
(* blewit label *)

VAR di:  direction;
BEGIN
(* action build *)
WITH where^, wordptr^ DO
   BEGIN
   IF NOT (nounval IN [bridge, ladder]) THEN
      BEGIN
      blewit;
GOTO 19
END
ELSE
   IF NOT ([hammer, nail, wood] <= (carry + present)) THEN
      writeln('You don''t have all the things you need to build a',pword,'.')
ELSE
   BEGIN
(* do have the equipment *)
   WITH nouns[nail] DO
      BEGIN
      nofnails := nofnails - 1;
IF nofnails <= 0 THEN
   BEGIN
   writeln('You''ve used your last nails.');
carry := carry - [nail];
present := present - [nail];
END
END;
(* with nails *)
WITH nouns[wood] DO
   BEGIN
   IF nounval = ladder THEN
      pilesize := pilesize -1
   ELSE
      pilesize := pilesize -3;
IF pilesize <= 0 THEN
   BEGIN
   writeln('You''ve used your last wood.');
carry := carry - [wood];
present := present - [wood];
END
END;
(* wood *)
present := present + [nounval];
writeln('You''ve build a ',pword,'.');
IF (warn = 9) AND (nounval = bridge) THEN
   removeblock
END
(* have equipment *)
END;
(* with *)
19: ;
END;
(* action build *)


PROCEDURE actionraise;

LABEL 20;
BEGIN
(* actionraise *)
WITH where^ DO
   BEGIN
   IF wordptr^.nounval <> ladder THEN
      BEGIN
      blewit;
GOTO 20
END
ELSE IF NOT (ladder IN (carry + present)) THEN
        writeln('There is no ladder here to raise.')
ELSE
   BEGIN
   carry := carry - [ladder];
present := present + [ladder];
IF warn = 8 THEN
   BEGIN
   removeblock;
warning
END
ELSE
   writeln('The ladder has been raised.')
END
END;
(* with where^ *)
20 : ;
(* blewit escape point *)
END;
(* action raise *)



PROCEDURE actionthrow;

BEGIN
(* actionthrow *)
WITH wordptr^, where ^ DO
   IF nounval = rod THEN
      IF Rod IN carry THEN
         BEGIN
         carry := carry - [rod];
Present := present + [rod];
IF warn = 5 THEN
   BEGIN
   changeblock;
warning
END
ELSE
   IF class_ = land THEN
      writeln('Nothing unusual happens.')
ELSE
   BEGIN
   present := present - [rod];
writeln('The rod falls in the lake ')
END
(* threw rod in lake *)
END
(* carrying rod *)
ELSE
   writeln('You''re not carrying a rod.')
ELSE IF nounval = rope THEN
        IF rope IN carry THEN
           BEGIN
           carry := carry - [rope];
present := present + [rope];
IF warn = 7 THEN
   BEGIN
   removeblock;
warning
END
ELSE
   IF class_ = land THEN
      writeln('The rope falls to the ground.')
ELSE
   BEGIN
   present := present - [rope];
writeln('The rope falls into the lake.')
END
END
(* rope in carry *)
ELSE
   Writeln('You''r not carrying a rope.')
ELSE IF nounval = bird THEN
        IF bird IN carry THEN
           BEGIN
           carry := carry - [bird];
present := present + [bird];
nouns[cage].cagecontents := emptycage;
nouns[bird].birdstate := freebird;
IF snake IN present THEN
   BEGIN
   present := present - [snake];
writeln('The bird attacks the snake and in an astonishing flurry');
writeln('the snake is driven away.');
strangle := 0
END
(* snake here *)
ELSE IF dragon IN present THEN
        BEGIN
        Present := present - [bird];
write('The bird attacks the dragon ');
writeln('and in an astonishing flurry');
writeln('the dragon burns the bird to a cinder.')
END
(* dragon here *)
ELSE
   IF class_ = land THEN
      writeln('The bird flutter in the air and lands nearby.')
ELSE
   BEGIN
   present := present - [bird];
write('The bird flutters in the air ');
writeln('and flies away.')
END
END
(* carrying bird *)
ELSE
   writeln('You''re not carrying the bird.')
ELSE IF nounval IN [axe,knife] THEN
        IF nounval IN carry THEN
           BEGIN
           carry := carry - [nounval];
IF Class_ = land THEN
   present := present + [nounval];
IF orc IN present THEN
   IF random < 0.5 THEN
      BEGIN
      writeln('You''ve killed an orc.');
Write('He disappears in a cloud ');
writeln('of greasy black smoke.');
present := present - [orc]
END
ELSE
   writeln('The ',pword,' bounces harmless off the orc.')
ELSE IF Dragon IN present THEN
        IF nounval = axe THEN
           IF Random < 0.33 THEN
              BEGIN
              writeln('You''ve killed the dragon.');
writeln('It contracts into wrinkles and disappears.');
present := present - [dragon];
strangle := 0
END
(*killed a dragon *)
ELSE
   BEGIN
   rightech := true;
writeln('The axe bounces harmlessly off the dragon.');
END
ELSE
   writeln('The knife bounces harmlessly off the dragon.')
ELSE
   IF class_ = land THEN
      IF ([bear,clam,snake,troll,wolf]*present) <> [] THEN
         BEGIN
(*another animal *)
         IF bear IN present THEN
            writeln('The ',pword,' bounces harmlessly off the bear.')
ELSE IF clam IN present THEN
        writeln('The ',pword,' bounces harmlessly off the clam.')
ELSE IF snake IN present THEN
        writeln('The ',pword,' bounces harmlessly off the snake.')
ELSE IF troll IN present THEN
        writeln('The ',pword,' bounces harmlessly off the troll.')
ELSE IF wolf IN present THEN
        BEGIN
        IF nouns[wolf].life = dead THEN
           BEGIN
           writeln('Awww, leave the poor wolf alone.');
carry := carry + [nounval];
present := present - [nounval]
END
ELSE
   IF random < 0.45 THEN
      BEGIN
      writeln('You killed the wolf.');
nouns[wolf].life := dead;
END
ELSE
   writeln('The ',pword,' bounces harmlessly off the wolf.')
END
(* wolf *)
END
(* another animal *)
ELSE IF bird IN present THEN
        BEGIN
        present := present - [bird];
boatloc^.present := boatloc^.present + [bird];
writeln('The ',pword,' misses the bird and it flies away.')
END
(* bird *)
ELSE
   writeln('The ',pword,' falls to the ground.')
ELSE
   writeln('The ',pword,' falls into the water.')
END
(* carrying knife or axe *)
ELSE
   IF nounval = axe THEN
      writeln('You''re not carrying an axe.')
ELSE
   writeln('You''re not carrying a knife.')
ELSE
   blewit;

END;
(* action throw *)



PROCEDURE actionwave;

VAR 
   temp:  locale;
   enemy:  noun;
BEGIN
(* actionwave *)
enemy := NILL;
WITH wordptr^, where ^ DO
   IF nounval = axe THEN
      IF axe IN carry THEN
         BEGIN
(* carrying the axe *)
         IF dragon IN present THEN enemy := dragon
   ELSE IF orc IN present THEN enemy := orc
   ELSE IF snake IN present THEN enemy := snake
   ELSE IF troll IN present THEN enemy := troll
   ELSE IF bear IN present THEN enemy := bear
   ELSE IF (wolf IN present) AND (nouns[wolf].life = alive)
           THEN enemy := wolf
   ELSE
      writeln('There are no enemies here.');
IF enemy <> nill THEN
   IF random < 0.5 THEN
      BEGIN
      writeln('You killed a ');
tellnoun(enemy,true);
IF enemy <> wolf THEN
   writeln('It shrivels up and disapears.')
ELSE
   nouns[wolf].life := dead;
END
(* hit it! *)
ELSE  (* missed *)
   BEGIN
   rightech := true;
writeln('A mightly swing, but it missed.')
END
(* missed *)

END
(* axe in carry *)
ELSE
   writeln('You are not carrying the axe.')
ELSE IF nounval = rod THEN
        IF rod IN carry THEN
           IF warn = 6 THEN
              BEGIN
              changeblock;
warning;
END
ELSE
   CASE random(3) OF 
      0:  writeln('Nothing unusual happens.');
      1:  writeln('Nothing peculiar happens.');
      2:  IF light THEN
             writeln('Strange, that sounded like thunder.')
          ELSE
             BEGIN
             writeln('a lightning bolt flashes overhead, showing:');
      temp := side;
      side := outside;
      telllocation(false);
   END
(* wave in the dark *)
END
(* case *)
ELSE
   writeln('you are not carrying the rod')
ELSE
   blewit;
END;
(* actionwave *)

PROCEDURE actionfeed;

LABEL 15;
(* replacement for blewit *)

VAR 
   cp:  noun;
BEGIN
(* actionfeed *)
WITH wordPtr^, Where^ DO
   IF NOT (food IN carry) THEN
      Writeln('You''re not carrying any food.')
   ELSE
      BEGIN
(* have food *)
      IF wordptr <> void THEN
         IF NOT (Nounval IN [bear .. wolf ]) THEN
            BEGIN
            blewit;
GOTO 15;
END
ELSE
   CP := nounval
ELSE
   BEGIN
(* no noun *)
   cp := bear;
WHILE NOT (cp IN (carry + present)) AND (cp < wolf) DO
   cp := succ(cp);
IF NOT (cp IN (carry + present)) THEN
   BEGIN
   blewit;
GOTO 15
END;
END;
(* find something to feed here *)
IF cp IN [ bear, dragon, snake, wolf ] THEN
   carry := carry - [food];
IF cp IN [ bear .. wolf ] THEN
   CASE cp OF 
      bear :
              BEGIN
              nouns[bear].BearState := happy;
      write('The bear eats you''re food and ');
      writeln('becomes rather friendly.');
   END;
bird :  writeln('The bird needs seed, not your sandwich.');
clam :  writeln('You can''t feed a clam food.  It needs a body of water.');
dragon:  writeln('The dragon eats the food, and eyes you hungrily.');
orc:  writeln('The orc is too angry to eat food.');
pirate:  blewit;
snake:  writeln('The snake eats the food and eyes you hungrily.');
troll:  writeln('The troll snarls and demands a treasure, not food.');
wolf:  writeln('The wolf eats the food and eyes you hungrily.');
END
(* CASE *)
ELSE
   writeln('There''s nothing here to feed.')
END;
(* have food *)
15: ;
(* blewit exit *)
END;
(* action feed *)

PROCEDURE actionresign;
BEGIN
(* action resign *)
writeln('I see you''ve resigned by holding your breath.');
writeln('By the way, blue is a bad skin color.');
oops;
END;
(* action resign *)

PROCEDURE actionquit;
BEGIN
writeln('Do you really want to quit now?');
question := quitquest;
END;
(* action quit *)

PROCEDURE actionsave;
BEGIN
(* action save *)
definition := True;
(* to allow the reading of the save file name *)
readtoken;
definition := False;
IF string_[1] <> chr(0) THEN
   BEGIN
   writeln('Your adventure has been saved on ', pword, '.');
writeln('To resume type: ''-advent(advorg=', pword, ')''.');
          (* snap(string_) *)
writeln('Your adventure has been restored.');
END;
END;
(* action save *)

BEGIN
(* doaction *)
ap := wordptr^.actval;
IF NOT (ap IN [fill, row, save, swim]) THEN
   BEGIN
(* fill,row,save,swim *)
   readtoken;
IF ap IN [brief, help..inven, left..no, quit, right,
   score, unlock, verbose, yes] THEN
   BEGIN
   IF wordptr <> void THEN
      BEGIN
      blewit;
GOTO 11;
END;
END

ELSE IF ap IN [build, drink, eat..fill, kill, off, on_,
        raise_, throw, wave] THEN
        BEGIN
(* build ... wave *)
        IF wordptr^.meaning <> known THEN
           IF ap IN [build, feed, fill, kill, raise_, throw,
              wave] THEN
              BEGIN
              blewit;
GOTO 11;
END
ELSE IF wordptr <> void THEN
        BEGIN
        blewit;
GOTO 11;
END;
IF wordptr <> void THEN
   BEGIN
(* <> void *)
   wp := wordptr;
st := string_;
readtoken;
IF wordptr <> void THEN
   BEGIN
   blewit;
GOTO 11;
END;

wordptr := wp;
string_ := st;
END;
(* <> void *)
END
(* build ... wave *)
ELSE
   IF wordptr = void THEN
      wordptr := wall
ELSE IF wordptr^.meaning <> known THEN
        BEGIN
        blewit;
GOTO 11;
END;
END;
(* fill,row,save,swim *)

IF NOT light THEN
   IF ap IN [build .. drink, eat, feed, inven, kill,
      lock, look, off, raise_, swim, throw, unlock] THEN
      BEGIN
      writeln('It''s too dark to see anything.');
          (* goto 50 *)
askquestionimmediately := True;
GOTO 11;
END;
(* check for light *)
CASE ap OF 
   brief:
           BEGIN
           briefly := True;
   writeln('OK, I''ll describe locations briefly.');
END;
build:  actionbuild;
describe:  actiondescribe;
drink:  actiondrink;
drop:  actiondrop;
eat:  actioneat;
empty:  actionempty;
feed:  actionfeed;
fill:  actionfill;
help:  supplyhelp;
info:  supplyinfo;
inven:  actioninven;
kill:
       BEGIN
       Write('Please be more specific ');
writeln('on how to do that.');
END;
left:
       BEGIN
       Write('I don''t know how to go left.  ');
writeln('Use compass points.');
END;
lock:  actionlock;
look:  telllocation(False);
no:  blewit;
off:  actionoff;
on_:  actionon;
quit:  actionquit;
raise_:  actionraise;
resign:  actionresign;
right:
        BEGIN
        Write('I don''t know how to go right.  ');
writeln('Use compass points.');
END;
row:  actionRow;
rub:  actionrub;
save:  actionsave;
score:  scoregame;
swim:  actionswim;
take:  actiontake;
throw:  actionthrow;
unlock:  actionunlock;
verbose:
          BEGIN
          briefly := False;
writeln('OK.  I''ll descrbe location s fully.');
END;
wave:  actionwave;
yes:  blewit;
END;
(* case *)
11: ;
(* blewit escape *)
END;
(* do action *)


PROCEDURE analyzequestion;

PROCEDURE restart;
BEGIN
writeln;
WITH startloc^ DO
   BEGIN
   IF lamp IN carry THEN
      BEGIN
      carry := carry - [lamp];
present := present + [lamp];
END;
(*lamp *)
IF match IN carry THEN
   BEGIN
   carry := carry - [match];
nouns[lamp].burning := False;
END;
(* match *)
END;
(* with *)
IF boat IN carry THEN
   carry := carry - [boat]
ELSE
   boatpos^.present := boatpos^.present - [boat];
boatloc^.present := boatloc^.present + [boat];
WITH where^ DO
   IF class_ <> lake THEN
      present := present + carry;
carry := [];
done := False;
question := noquest;
where := startloc;
was := Nil;
rowflag := False;
END;
(* restart *)

PROCEDURE yninfo;
BEGIN
WITH wordptr^ DO
   IF (meaning = DIRECT) AND (dirval = NORTH) THEN
      BEGIN
      writeln('Very well.');
writeln;
question := noquest;
END
ELSE IF meaning = act THEN
        IF actval = no THEN
           BEGIN
           writeln('Very well.');
writeln;
question := noquest;
END
ELSE
   IF actval = yes THEN
      BEGIN
      writeln('  Welcome to adventure.  Somwhere nearby is');
writeln('Colossal cave, where others have found ');
writeln('fortunes in treasure and gold.  Though it is');
writeln('rumored that some who enter are never seen ');
writeln('again.  Magic is said to work in the cave.  I');
writeln('will be your eyes and hands.  Direct me with');
writeln('commands of one or two words.  Should you get');
writeln('stuck, type ''help'' for some general hints.');
writeln('For information on how to end your adventure ');
writeln('and other pertinent items.  Type ''info''. ');
writeln;
question := noquest;
END
ELSE
   writeln('Please answer the question with yes or no.')
ELSE
   writeln('Please answer the question with yes or no.');
          (* kludge - can't see how the initial room description is printed *)
telllocation(False);
END;
(* yninfo *)

PROCEDURE resurrect1;
BEGIN
(* resurrect1 *)
WITH wordptr^ DO
   IF meaning = act THEN
      IF actval = no THEN
         BEGIN
         writeln('very well.');
done := True;
END
ELSE
   IF actval = yes THEN
      BEGIN
      question := noquest;
CASE numdied OF 
   1:
       BEGIN
       writeln('Great! Where did I put my magic ');
   writeln('dust?  Ah... Here it is.  I''ll ');
   writeln('sprinkle some dust over you and ');
   writeln(' . . . . > poof < . . . . ');
   writeln('The room disappears in a cloud of ');
   writeln('green smoke and when the air clears');
   writeln('you find yourself... ');
   restart;
END;
2:
    BEGIN
    writeln('Where did I put my magic dust?  Wor,');
writeln('There is just alittle bit left.');
writeln('I''ll sprinkle what''s left and ');
writeln(' . . . . > puff < . . . . ');
writeln('The room fades away in a green haze and ');
restart;
END;
3:
    BEGIN
    writeln('I''ll leave you one hint before I let');
writeln('You try it yourself.  You''ll need a powerful');
writeln('magic word.  Goodbye!');
question := lastchance;
END;
END;
(* case *)
END
ELSE
   IF actval = quit THEN
      done := True
ELSE
   writeln('Please answer the question with Yes or No.')
ELSE
   writeln('Please answer the question with Yes or No.');
END;
(* resurrect1 *)

PROCEDURE resurrect2;
BEGIN
(* resurrect2 *)
WITH wordptr^ DO
   BEGIN
   done := True;
IF meaning = direct THEN
   IF dirval = magic THEN
      IF string_[1] = 'z' THEN
         BEGIN
         writeln('Congratulations; you did it.');
done := False;
restart;
END
ELSE
   writeln('See, only I have sufficient magic.')
ELSE
   writeln('See, only I have sufficient magic.')
ELSE
   writeln('See, only I have sufficient magic.');
END;
(* with *)
END;
(* resurrect2 *)

PROCEDURE ynquit;
BEGIN
(*ynquit *)
WITH wordptr^ DO
   IF meaning = act THEN
      IF actval = no THEN
         BEGIN
         writeln('OK.');
question := noquest;
END
ELSE IF actval = yes THEN
        BEGIN
        writeln('very well.');
question := noquest;
done := True;
END
ELSE
   writeln('Please answer Yes or No.');
END;
(* ynquit *)

BEGIN
(* analyzequestion *)
CASE question OF 
   noquest:
             BEGIN
             debugit('Analyzequestion - noquest');
   halt;
END;
infoquest:  yninfo;
deadquest:  resurrect1;
lastchance:  resurrect2;
quitquest:  ynquit;
END;
(* case *)
debugit('<analyzequestion ' + questwords[question]);
END;
(* analyzequestion *)

BEGIN
(* query human *)
99: (* don''t understand loop *)
     idontunderstand := False;
(* replacement for label *)
askquestionimmediately := false;
readline;
commands := commands + 1;
readtoken;
IF wordptr = void THEN
   BEGIN
   blewit;
GOTO 99;
END;
IF question = noquest THEN
   BEGIN
   CASE wordptr^.meaning OF 
      direct:  domovement;
      act:  doaction;
      known:  blewit;
      locate:  blewit;
      unknown:  blewit;
   END;
IF askquestionimmediately THEN
   GOTO 100;
IF idontunderstand THEN
   GOTO 99;
END
(* noquest *)
ELSE
   analyzequestion;
100: ;
(* oops replacement *)
END;
(* query human *)


PROCEDURE stageuniverse;

VAR 
   i:  integer;

PROCEDURE throw(miss: boolean);
BEGIN
(* throw *)
WITH where^ DO
   IF (random < 0.5) OR miss THEN
      IF NOT (knife IN carry) THEN
         BEGIN
         IF knife IN present THEN
            BEGIN
            Write('The orc picks up the knife ');
writeln('and throws it at you.');
END
ELSE
   BEGIN
   present := present + [knife];
writeln('The orc throws a knife at you.');
END;
writeln;
IF (random < 0.1) AND (NOT miss) THEN
   BEGIN
   writeln('It hits you!');
oops;
END
ELSE
   writeln('It misses you!');
IF random < 0.25 THEN
   BEGIN
   present := present - [orc];
writeln;
writeln('Strange, the orc just ran away.');
numorc := numorc + 1;
saforc := orcsafe;
END;
END;
(* with *)
END;
(* throw *)

BEGIN
(* stage universe *)
WITH where^ DO
   BEGIN
(* 1 *)
   IF was <> NIL THEN
      IF where <> was THEN
         IF (class_ = land) AND (side = inside) AND light THEN
            IF orc IN was^.present THEN
               IF NOT (orc IN present) THEN
                  BEGIN
(* 2 x*)
                  was^.present := was^.present - [orc];
present := present + [orc];
END;
(* 2 x*)

IF knife IN carry THEN
   IF knife IN present THEN
      present := present - [knife];

IF question = noquest THEN
   BEGIN
(* 3 x*)
   IF where <> was THEN
      telllocation(briefly);
IF (where = was) AND (warn = 14) THEN
   BEGIN
(* 4 x*)
   Write('You stood too long on the ');
writeln('lava and cooked your goose.');
oops;
END;
(* 4 x*)
IF knife IN carry THEN
   IF (wet = waterwet) OR (class_ <> land) OR
      (pool = waterpool) THEN
      BEGIN
(* 5 x*)
      carry := carry - [knife];
writeln('The moist air causes the knife to discolor and ');
writeln('crumble into dust.');
END;
(* moisture destroys the knife *)  (* 5 x*)
IF ([dragon, snake] * present) <> [] THEN
   BEGIN
(* 6 *)
   IF rightech THEN
      rightech := False
ELSE
   strangle := strangle + 1;
i := strangle Div 7;
IF knife IN carry THEN
   BEGIN
(* 7 x*)
   strangle := 21;
i := 3;
writeln;
IF dragon IN present THEN
   writeln('The dragon sees your knife ')
ELSE
   writeln(
           'The snake sees your knife and becomes extremely angry.');
END;
(* 7 x*)

IF strangle = 7 * i THEN
   BEGIN
(* 8 x*)
   CASE i OF 
      1:  IF dragon IN present THEN
             BEGIN
(* 9 x*)
             Write('The dragon singes your ');
      writeln('hair with his breath.');
   END
(* 9 x*)
ELSE
   writeln('The snake coils menacingly around you.');
2:  IF dragon IN present THEN  (* 10  x*)
       writeln('The dragon scorches your clothes with his breath.')
    ELSE           (* 10 x*)
       writeln('The snake coils tightly around you.');
3:
    BEGIN
(* 11 x*)
    IF dragon IN present THEN
       writeln('The dragon roasts you to a cinder.')
    ELSE       (* 12 x*)
       writeln('The snake squeezes and crushes your bones.');
oops;
END
(* 3rd case *) (* 11 x*)
END;
(* case *)
END;
(* strangle multiple of 7 *) (* 8 x*)
END;
(* dragon or snake here *)  (* 6 x*)
END;
(* no question *) (* 3 x*)

was := where;
WITH nouns[lamp] DO
   IF burning THEN
      BEGIN
(* 13  x*)
      timeleft := timeleft - 1;
IF timeleft = 0 THEN
   BEGIN
(* 14  x*)
   burning := False;
IF lamp IN (carry + present) THEN
   BEGIN
(* 15  x*)
   writeln('The lantern just ran out of fuel.');
writeln('You''ll need oil to refill it and a match to light it.');
END;
(* 15  x*)
END
(* lamp out of oil *)  (* 14  x*)
ELSE IF timeleft = 15 THEN
        BEGIN
(* 16  x*)
        writeln('The lantern is running low on fuel.');
writeln('You may be able to fill it with some oil.');
END;
(* lamp running low *) (* 16  x*)
END;
(* burning lamp *)  (* 13  x*)
IF orc IN present THEN
   throw(False)
ELSE
   IF (class_ = land) AND (side = inside) THEN
      BEGIN
(* 17  *)
      IF pstate = pactive THEN
         IF random < 0.06333 THEN

            IF random < 0.3333 THEN
               BEGIN
(* 18  *)
               Write('A pirate appears out of the ');
writeln('darkness for just a moment.');
IF (treas * carry) <> [] THEN
   BEGIN
(* theft *) (* 19 x*)
   Write('While he''s here he says: "I''ll take');
writeln('your treasures and hide them away.');
WITH nouns[chest] DO
   BEGIN
(* 2p *) (* 20 x*)
   chestcontents := chestcontents + treas * carry;
cheststate := lockedchest;
END;
(* with chest *) (* 20 x*)
carry := carry - treas * carry;
END;
(* theft *)    (* 19 x*)
END
(* pirate shows up *)    (* 18 x*)
ELSE             (* 21 x*)
   writeln(
           'A pirate runs by, pokes you in the ribs, laughs, and disappears.');

IF saforc > 0 THEN
   saforc := saforc - 1
ELSE
   IF numorc > 0 THEN
      IF random < 0.1 THEN
         BEGIN
(* orc could show up *) (* 22x *)
         numorc := numorc - 1;
IF (numorc = (orcnumber DIV 2)) AND (pstate = pwait) THEN
   pstate := pactive;
saforc := orcsafe;
writeln('An ugly and mean orc has found you.');
IF numorc = orcnumber - 1 THEN
   BEGIN
(* first orc encounter *) (* 23 x *)
   present := present + [axe];
writeln('The orc throws an axe at you.');
writeln('It misses you!');
writeln('Strange, the orc just ran away.');

END
(* first orc, axe *)  (* 23 x*)
ELSE
   BEGIN
(* 24 x*)
   present := present + [orc];
throw(True);
END;
(* 24 x*)
END;
(* orc could shows up *)  (* 22 x *)

END;
(* inside on land *) (* 17  *)
END;
(* with *)
END;
(* stageuniverse *)


BEGIN
(* main program *)

debugging := True;
Initialize;
REPEAT
   stageuniverse;
   debugit(locptrtostring(where,false));
   50: (* ask question immediately *)
        IF NOT done THEN
           queryhuman;

UNTIL done;
scoregame;
readline;
END.
(* Main program *)