(*
   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.

   Removed the deaths associated with moving on to the lake without the boat, and
   rowing the boat on to land.  Since to get a perfect score requires checking
   every possible location, it didn't make sense.
*)


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, restore, 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 *)
   SaveFile: Text; 
   DebugFile: Text; (* debug file -- * Debug *)
   debugging: boolean;

   FBuffer: line; (* to replace "advent4^" *)
   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', 'RESTORE', '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/file 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 boolToString(b: boolean): string;
      BEGIN
      IF b THEN
         boolToString := 'True'
      ELSE
         boolToString := 'False';
      END;

   FUNCTION intToString(i: INTEGER): string ;
      VAR s:string;
      BEGIN
      str(i,s);
      intToString := s;
      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 + trimright(sdfn) + ' ' + wordwords[meaning] + ' ';
         CASE meaning OF
            DIRECT: s := s + directwords[DirVal] + ' ';
            ACT: s := s + actionwords[ActVal] + ' ';
            KNOWN: s := s + nounwords[NounVal] + ' ';
            LOCATE: s := s + trimright(LocVal^.Name^.sdfn) + ' ';
            UNKNOWN: s := s + trimright(UnVal) + ' ';
            END;
         END (* ELSE *)
      END; (* WITH *)
   NamePtrtoString := s;
   END;  (* toString *)

   FUNCTION IntegerToString(i:INTEGER):string;
      VAR s: string;
      BEGIN
      str(i:5, s);
      IntegerToString := s;
      END;

   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;
      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)     *)

   PROCEDURE dumpdictionary;

      PROCEDURE processnode1(n :nameptr);
         BEGIN
         debugit(nameptrtostring(n));
         IF n^.SLNK <> nil THEN
            processnode1(n^.slnk);
         END;

      PROCEDURE processnode2(n : nameptr; path: string);
         BEGIN
         IF n <> nil THEN
            BEGIN
            debugit(path+' '+nameptrtostring(n));
            IF n^. ndf = node THEN
               BEGIN
               processnode2(n^.llnk, path+'<');
               processnode2(n^.rlnk, path+'>');
               END
            END;
         END;
      
      BEGIN (* dump dictionary *)
      debugit('dumping dictionary.  Sequentially: ');
      processnode1(root);
      debugit(' ');
      debugit('dumping dictionary.  Tree: ');
      processnode2(root,'-');
      debugit(' ');
      END;  (* dump dictionary *)



   PROCEDURE ReadLine;
      VAR
         i, j: INTEGER;

      BEGIN (* readline *)
      debugit('>readline');
      i := 0;
      IF not Definition THEN (* game play phase *)
         BEGIN
         Write('> ');
         readln(linebuffer);
         column := 1;
         j := Linewidth;
         WHILE (j > 1) AND (linebuffer[j] <> chr(0)) DO
            BEGIN
            linebuffer[j] := ' '; (* clean up for debugging *)
               j := j - 1;
            END;
            debugit('<readline =' + trim(linebuffer));
         END
      ELSE (* definition phase *)
         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 - ' + trimright(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
         *)

      BEGIN (* ReadToken *)
      (* These assignments were moved to global variables to avoid setting them each call 
         letter := ['A' .. 'Z', 'a' .. 'z' ];
         uppercase := [ 'A' .. 'Z' ];
         digit  := ['0' .. '9' ];
         null := [ chr(0) ];
      *)
      alltypes := letter + digit + null;
      IF definition THEN alltypes := alltypes + ['_','.'];

      1:
      RValue := 0;
      digits := True;
      i := 0;
      WHILE (column <= LINEWIDTH) AND (not (LineBuffer[column] in alltypes)) DO
         column := column + 1;

      IF column > LINEWIDTH THEN (* no token in rest of line *)
         string_[1] := chr(0)
      ELSE   (* put the token into string_ *)
         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  (* word or number found *)
         IF digits THEN
            BEGIN    (*  debugit('-readtoken digits detected');  *)
            IF not definition THEN
               goto 1;  (* no numbers from player during game *)
            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;
            debugit('readToken - rvalue ' + integerToString(rvalue));
            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
                  BEGIN
                  writeln('I don''t know the word '+ string_);
                  goto 1;  (* word not in "dictionary" *)
                  END;
               debugit('<ReadToken - ' + trimRight(string_) + ' ' + NamePtrtoString(WordPtr));
               END
            ELSE
               debugit('<ReadToken = ' + trimRight(string_));
            END  (* not digit *)

      ELSE (* first character is chr(0) meaning no token found *)
         IF definition THEN
            wordptr := nil
         ELSE
            wordptr := void;

      END; (* ReadToken *)


   FUNCTION FindName(T: WordTYPE): NamePTR;
   (* was in initialize, but moved out to be used by restore function 
    *)
      VAR
         np: namePTR;
      BEGIN (* findname *)
      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_);
            writeln('failure ni findname ' + string_);
            Halt;
           END;
      Findname := np;
      END; (* findname  *)


  (* 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;
         VAR
            dir: shortstring;
         BEGIN
         dir := ' ';
         getdir(0, dir);
         writeln(dir);
         Assign(Advent4, 'AdventureP_Data.txt');
         reset(Advent4);
         readln(Advent4, fbuffer);
         Assign(DebugFile, 'debugfile.txt');
         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);*)
         p2 := nil;
         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 *)


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

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

      PROCEDURE EnterAction(a: Action);
         VAR p1: nameptr;
         BEGIN
         NextToken;
         p1 := Insert;
         p1^.meaning := Act;
         p1^.actval := a;
         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 *)
         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;
         debugit('<LoadSynonyms');
         END; (* LoadSynonyms *)

      PROCEDURE LoadRoomDescriptions;
         VAR
            temp: description;
            dp: descptr;
            np: nameptr;
            rp: locptr;
            di: direction;
            i, j, count: INTEGER;

         BEGIN (* LoadRoomDescriptions *)
         (* WHILE advent4^ = '+' DO *)
         count := 0;
         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_));
               count := count + 1;
               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 ' + integerToString(count));
         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;
         (* Removes the names of the rooms from the dictionary. 
            This procedure is not called, because the save and 
            restore functions are no longer implemented by SNAP,
            so the names of the rooms are still required during 
            normal game processing. *)
         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 slnk <> nil *)
      p1 := tieslnk(root,0);
      END; (* buildtree *)

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

      GetFIL;
      (* Reset(Advent4); moved to getfil*)
      ReadLine;
      MOfDay := LineBuffer;
      ReadLine;
      
      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;
      dumpdictionary;
      LoadSynonyms;
      LoadRoomDescriptions;
      LoadInterconnections;
      LoadNounLocations;
      LoadSpecialLocations;
      BoatPos := BoatLoc;
      BoatLoc^.present := BoatLoc^.present + [boat];
      (* RemoveWords; removed for saving and restoring game.*)
      Buildtree;
      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 '+ integerToString(maxvisit));
      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; (* case *)
            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, maxtreasures : INTEGER;

      BEGIN (* scoregame *)
      maxtreasures := card(maxtreas);
      S := trunc(70 +
               100 * card(discovt) / maxtreasures +
               200 * card(maxtreas * treasloc^.present) / maxtreasures +
               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 s < 0 THEN
         BEGIN
         writeln('100 * # discovered treasures '+ inttostring(card(discovt)) +
              ' / Max treasures '+ inttostring(maxtreasures) +
              ' = ' + inttostring(trunc(100 * card(discovt) / maxtreasures)) );
         writeln('200 * treasures secured ' + inttostring(card(maxtreas*treasloc^.present)) +
              ' / max treasures = ' + inttostring(trunc(200 * card(maxtreas * treasloc^.present) / maxtreasures))  );
         writeln('130 * actvisit ' + inttostring(actvisit) +
              ' / maxvisit ' + inttostring(maxvisit) +
              ' ' + inttostring(trunc(130 * actvisit / maxvisit)));
         writeln('-17 * numdied ' + inttostring(numdied) + ' '
              + inttostring( -17 * numdied) );

         END;
      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
         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;
                                             oops; 
                                             goto 9 
                                             END
                                          ELSE
                                             where := target;
                                       13:   BEGIN
                                             writeln('you have falln off the cliff.');
                                             go := False;
                                             oops; 
                                             goto 9 
                                             END;
                                       15:   BEGIN
                                             writeln('The cave ceiling falls on you.');
                                             go := False;
                                             oops; 
                                             goto 9 
                                             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;
                                             oops; 
                                             goto 9 
                                             END;
                                       18:   BEGIN
                                             writeln('You have suffocated in bad air.');
                                             go := False;
                                             oops; 
                                             goto 9 
                                             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;
                                                oops; 
                                                goto 9 
                                                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;
                                 writeln('You can''t row the boat on land.  Get out of it to');
                                 writeln('go that direction.');
                                 (* oops;
                                    goto 9 *)
                                 go := false;
                                 END;
                              beach: ;
                              lake: IF not (boat in carry) THEN
                                 BEGIN
                                 (* writeln('You''ve walked out on water');
                                    writeln('Which is not kosher.'); *)
                                 writeln('A fully provisioned adventurer cannot swim.  Use');
                                 writeln('a boat if you want to go on the water.');
                                 where := last;
                                 (* oops;
                                    goto 9 *)
                                 go := false;
                                 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!');
                                 oops; 
                                 goto 9 
                                 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
                     Write('Don''t be silly, you pour ');
                     writeln(pword,', not drop it.');
                     go := false;
                     END (* oil or water *)
                  ELSE IF cp = bird THEN
                     IF bird in carry THEN
                        BEGIN
                        nouns[cage].cagecontents := emptycage;
                        nouns[bird].birdstate := freebird;
                        carry := carry - [bird];
                        IF class_ <> lake THEN
                           present := present + [bird];
                        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);
                           side := temp;
                           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;
          VAR
              s  : Line;
              n  : noun;
              linelen, i, count  : INTEGER;
              objlist : string;
              filename: shortstring;
              dir: shortstring;

         PROCEDURE addobjtoline(n: noun);
            VAR k : INTEGER;
                nounlen : INTEGER;
            BEGIN (* addobjtoline *)

            WITH nouns[n].Name^ DO
               BEGIN
               nounlen := 1;
               WHILE sdfn[nounlen] <> chr(0) DO
                  nounlen := nounlen + 1;
               nounlen := nounlen -1; (* get rid of that chr(0) *)
               IF nounlen + linelen > LINEWIDTH THEN
                  BEGIN
                  writeln(savefile,s);
                  FOR k := 1 TO LINEWIDTH DO
                     s[k] := ' ';
                  linelen := 0;
                  END;
               FOR k := 1 TO nounlen DO
                  s[linelen+k] := sdfn[k];
               linelen := linelen + k +  1;
               END (* with *)
            END; (* add object to line *)

          PROCEDURE processlocation(n:nameptr;path : shortstring);
             VAR i : INTEGER;
                 nn : noun;
             BEGIN
               (* debugit('path = ' + path); *)
                IF (n^.NDF = DEFN) AND (n^.meaning = LOCATE) THEN
                 WITH n^.locval^ DO
                    IF (wet <> dry) OR (pool<>nopool)
                       OR block OR visit OR (present <> []) THEN

                       BEGIN
                       FOR i := 1 TO LINEWIDTH DO s[i] := ' ';
                       s[1] := '+'; count := count + 1;
                       i := 1;
                       REPEAT
                          s[i+1] := n^.SDFN[i];
                          i := i + 1;
                       UNTIL  (i = 21) OR(n^.SDFN[i] = chr(0));

                       IF wet = oilwet THEN s[22] :='O';
                       IF wet = waterwet THEN s[22] := 'W';
                       IF pool=oilpool THEN s[23] := 'O';
                       IF pool= waterpool THEN s[23] := 'W';
                       IF block THEN s[24] := 'B';
                       IF visit THEN s[25] := 'V';

                       linelen := 26;
                       IF present <> [] THEN
                          FOR nn := AXE TO WOLF DO
                             IF nn IN present THEN
                                addobjtoline(nn);
                       writeln(savefile,s);
                       END;

                    IF (n^.NDF = node) AND (n^.rlnk <> nil) THEN
                       processlocation(n^.rlnk,path+'>');
                    IF (n^.NDF = node) AND (n^.llnk <> nil) THEN
                       processlocation(n^.llnk,path+'<');

             END; (* process location *)



      BEGIN (* action save *)
        count := 0;
        filename := '                     ';

        definition := True; (* to allow the reading OF the save file name *)
        readtoken;
        definition := False;
        debugit('Saving to string ' + string_);

        IF string_[1] <> chr(0) THEN
           BEGIN
           dir := ' ';
           getdir(0, dir); (*?*)
           i := 1;
           WHILE string_[i] in  (letter + digit) DO
              BEGIN
              filename[i] := string_[i];
              i := i + 1;
              END;
           debugit('Saving to '+filename);
           TRY
           Assign(SaveFile, filename);
           rewrite(SaveFile);
           except on E:Exception DO
              BEGIN
              WRITELN('File open exception: '+E.message);
              END;
           END;  (* try  *)
           (*  writeln('To resume type: ''-advent(advorg=', pword, ')''.'); *)
           (* snap(string_) *)

           processlocation(root,'-');

              
           FOR i := 1 TO LINEWIDTH DO s[i] := ' ';
           objlist := '-' + trimright(where^.name^.sdfn) + ' ';
           IF was = nil THEN objlist := objlist + trimright(where^.name^.sdfn)
           ELSE objlist := objlist + trimright(was^.name^.sdfn);
           objlist := objlist + ' ';
           linelen := length(objlist);
           FOR i := 1 TO linelen DO
               IF objlist[i] <> chr(0) THEN
                  s[i] := objlist[i]
               ELSE
                  s[i] := ' ';
           FOR n := AXE TO WOLF DO
                 IF n IN carry THEN
                    addobjtoline(n);
              writeln(savefile,s);
              
              FOR i := 1 TO LINEWIDTH DO s[i] := ' ';
              s[1] := '+';
              linelen := 2;
              FOR n := Chain TO Vase DO
                 IF n in discovt THEN
                    addobjtoline(n);
              writeln(savefile,s);
              
              writeln(savefile,'-', strangle, ' ', commands, ' ', moves, ' ',
                        darkmoves, ' ', numdied, ' ', actvisit, ' ',
                        nouns[lamp].timeleft, ' ', nouns[match].nofmatches, ' ',
                        nouns[nail].NOfNails, ' ', nouns[wood].pilesize, ' ',
                        NumOrc);

              FOR i := 1 TO LINEWIDTH DO s[i] := ' ';
              s[1] := '+';
              IF rightech THEN s[2] := 'T' ELSE s[2] := 'F';
              IF briefly THEN s[3] := 'B' ELSE s[3] := 'V';
              IF pstate = pwait THEN s[4] := 'W' 
              ELSE IF pstate = pactive THEN s[4] := 'A' 
              ELSE s[4] := 'D';
              CASE nouns[bottle].bottlecontents of
                  emptybottle: s[5] := 'E';
                  oilinbottle: s[5] := 'O';
                  waterinbottle: s[5] := 'W';
              END;
              CASE nouns[cage].cagecontents of
                  emptycage: s[6] := 'E';
                  BirdInCage : s[6] := 'B';
              END;
              IF nouns[lamp].burning THEN s[7] := 'B';
              CASE nouns[plant].Height of
                  Little: s[8] := 'L';
                  stage1: s[8] := '1';
                  stage2: s[8] := '2';
                  full : s[8] := 'F';
                  overgrown: s[8] := 'O';
              END;
              CASE nouns[chest].cheststate of
                  emptychest: s[9] := 'E';
                  treasurechest: s[9] := 'T';
                  lockedchest: s[9] := 'L';
              END;
              CASE nouns[bear].BearState of
                  angry: s[10] := 'A';
                  happy: s[10] := 'H';
              END;
              CASE nouns[bird].birdstate of
                  freebird: s[11] := 'F';
                  cagedbird: s[11] := 'C';
              END;
              IF nouns[clam].clamopn = hasbeen THEN
                 s[12] := 'H'
              ELSE
                 s[12] := 'N';
              IF nouns[wolf].life = alive THEN
                 s[13] := 'A'
              ELSE
                 s[13] := 'D';
              IF nouns[lamp].Burning THEN
                 s[14] := 'B'
              ELSE
                 s[14] := 'N';
              writeln(savefile,s);
              close(savefile);
          writeln('Your adventure has been saved on ', pword, '.');
          debugit(' save ' + integerToString(count));

        END
      ELSE
           writeln('There was a problem with your savefile name.');
      END; (* action save *)


    PROCEDURE actionrestore;
       LABEL 30; (* error exit *)
       VAR np, np2: nameptr;
           i : INTEGER;
           s : string;
           b : boolean;
           filename : shortstring;


          PROCEDURE clearlocation(n:nameptr;path : shortstring);
             BEGIN
                debugit('path = ' + path);
                IF (n^.NDF = DEFN) AND (n^.meaning = LOCATE) THEN
                 WITH n^.locval^ DO
                    BEGIN
                    wet := dry;
                    pool := nopool;
                    block := false;
                    present := [];
                    visit := false;
                    END; (* with *)
                 IF (n^.NDF = node) AND (n^.rlnk <> nil) THEN
                    clearlocation(n^.rlnk,path+'>');
                 IF (n^.NDF = node) AND (n^.llnk <> nil) THEN
                    clearlocation(n^.llnk,path+'<');

             END; (* clear location *)
             
       Function ReadNounSet: nounset;
          VAR n: nameptr;
              ns: nounset;
          BEGIN
          ns := [];
          readtoken;
          debugit('>ReadNounSet');
          REPEAT
             IF string_[1] <> chr(0) THEN
                BEGIN
                IF wordptr^.meaning = KNOWN THEN
                   ns := ns + [wordptr^.nounval];
                readtoken;
                END;
             IF string_[1] = chr(0) THEN (* EOLN? *)
                IF (fbuffer[1] <> '+') AND (fbuffer[1] <> '-' ) THEN
                   BEGIN
                   definition := true;  readline;    definition := False;
                   readtoken;
                   END;
          UNTIL string_[1] = chr(0);
          ReadNounSet := ns;
          END; (* read noun set *)
          
       PROCEDURE processRooms;
          VAR thisroom : locptr;
          BEGIN
          WHILE fBuffer[1] = '+' DO
             BEGIN
             definition := true;  readline;    definition := False;
             Column := 2;
             ReadToken;
             IF (wordptr <> nil) AND (wordptr^.meaning = locate) THEN
                thisroom := wordptr^.locval
             ELSE
                BEGIN
                writeln('Error reading in location data from save file ');
                readline;
                halt;
                END;
             debugit('Restore room ' + nameptrtostring(wordptr));
             WITH thisroom^ DO
                   BEGIN
                   IF linebuffer[22] = 'O' THEN
                      wet := oilwet
                   ELSE IF linebuffer[22] = 'W' THEN
                      wet := waterwet;
                   IF linebuffer[23] = 'O' THEN
                      pool := oilpool
                   ELSE IF linebuffer[23] = 'W' THEN
                      pool := waterpool;
                   IF linebuffer[24] = 'B' THEN
                      BEGIN
                      block := true;
                      debugit(trim(thisroom^.Name^.SDFN)+' has block set ');
                      END;
                   IF linebuffer[25] = 'V' THEN
                      visit := true;
                   END; (* with *)

             column := 26;
             string_[1] := chr(0);
             debugit('Putting items back into room ');
             thisroom^.Present := readnounset;
             END; (* WHILE loop - process each room *) 
          END;   (* processing rooms *)



       BEGIN  (* action restore *)
       filename := '                     ';
       definition := True; (* to allow the reading of the save file name *)
       debugit('reading save file name. column: '+integerToString(column)
          + ' definition '+ booltostring(definition));
       readtoken;
       definition := False;
       debugit('Save file name '+string_);
       IF string_[1] <> chr(0) THEN
          BEGIN
          i := 1;
          WHILE string_[i] in  (letter + digit) DO
             BEGIN
             filename[i] := string_[i];
             i := i + 1;
             END;

          IF not FileExists(filename) THEN
             BEGIN
             writeln('No file named "', filename, '" found.');
             goto 30;
             END;
          
          Assign(advent4, filename);

          reset(advent4);
          readln(advent4,fBuffer);
          debugit('cleaning up dungeon.');
          clearlocation(root, '-');
          debugit('Putting items back where they belong.') ;

          processrooms;
          
          (* where, was,  carry *)
          carry := [];
          definition := true;  readline;    definition := False;
          column := 2;
          readtoken;
          IF wordptr ^.Meaning <> Locate THEN
             Begin
             writeln('This is not a save file.');
             readln;
             halt;
             END;
          where := wordptr^.LocVal;
          readtoken;

          was := wordptr^.LocVal;
          b := true;
          readtoken;
          WHILE b DO
             BEGIN
             IF (string_[1] = chr(0)) AND (fbuffer[1] = '+') THEN
                b := false
             ELSE IF (string_[1] = chr(0)) THEN
                BEGIN (* END of line, and more items on next line *)
                definition := true;  readline;    definition := False;
                readtoken;
                END;
             IF b THEN
                BEGIN
                carry := carry + [wordptr^.NounVal]  ;
                readtoken;
                END;
             END;

          (* discovered treasures *)
          definition := true;  readline;    definition := False;
          column := 2;

          discovt := readnounset;
          
          (*  misc INTEGER values *)

          definition := true; (* to read in numbers *)
          readline;
          column := 2;
          readtoken;  strangle  := rvalue;
          readtoken;  commands := rvalue;
          readtoken;  moves    := rvalue;
          readtoken;  darkmoves:= rvalue;

          readtoken;  numdied  := rvalue;
          readtoken;  actvisit := rvalue;
          readtoken;  nouns[lamp].timeleft := rvalue;
          readtoken;  nouns[match].nofmatches := rvalue;
          readtoken;  nouns[nail].NOfNails := rvalue;
          readtoken;  nouns[wood].pilesize := rvalue;
          readtoken;  numOrc := rvalue;

          (* misc non numeric values *)
          readline;
          definition := false;

          IF linebuffer[2] = 'T' THEN rightech := true ELSE rightech := false;
          IF linebuffer[3] = 'B' THEN briefly := true ELSE briefly := false;
          IF linebuffer[4] = 'W' THEN pstate := pwait
          ELSE IF linebuffer[4] = 'A' THEN pstate := pactive
          ELSE pstate := pdone;
          CASE linebuffer[5] of
              'E' : nouns[bottle].bottlecontents := emptybottle;
              'O' : nouns[bottle].bottlecontents := oilinbottle ;
              'W' : nouns[bottle].bottlecontents := waterinbottle;
          END;
          IF linebuffer[6] = 'E' THEN nouns[cage].cagecontents := emptycage
          ELSE  nouns[cage].cagecontents := BirdInCage;
          IF linebuffer[7] = 'B' THEN nouns[lamp].burning := true;
          CASE linebuffer[8] of
              'L' : nouns[plant].Height := Little;
              '1' : nouns[plant].Height := stage1;
              '2' : nouns[plant].Height := stage2;
              'F' : nouns[plant].Height := full;
              'O' : nouns[plant].Height := overgrown
          END;
          CASE linebuffer[9] of
              'E': nouns[chest].cheststate := emptychest ;
              'T': nouns[chest].cheststate := treasurechest;
              'L': nouns[chest].cheststate := lockedchest;
          END;
          IF linebuffer[10] = 'A' THEN nouns[bear].BearState := angry
          ELSE  nouns[bear].BearState := happy;
          IF linebuffer[11] = 'F' THEN nouns[bird].birdstate := freebird
          ELSE nouns[bird].birdstate := cagedbird;
          IF linebuffer[12] = 'H' THEN nouns[clam].clamopn := hasbeen
          ELSE nouns[clam].clamopn := Never;
          IF linebuffer[13] = 'A' THEN nouns[wolf].life := alive
          ELSE nouns[wolf].life := dead;
          IF linebuffer[14] = 'B' THEN nouns[lamp].burning := true
          ELSE nouns[lamp].burning := false;

          debugit(' statuses: burning '+ linebuffer[14]+ ' ' +boolTostring(nouns[lamp].burning));
          debugit(' brief ' + linebuffer[4] + boolToString( briefly));
          debugit(' bottle ' + linebuffer[5] + intToString( ord(nouns[bottle].bottlecontents ) ) );
          debugit(' Plant ' + linebuffer[8] + intToString( ord(nouns[plant].Height) ) );

          close(advent4);
          writeln('Your adventure has been restored.');
          END
       ELSE
          writeln('Problem with save file name, no restore done.');
       30:
       definition := False;
       telllocation(False) ;
       END; (* actionrestore *)
      
      
      
    BEGIN (* doaction *)
      ap := wordptr^.actval;
      IF not (ap in [fill, row, restore, save, swim]) THEN
      BEGIN (* not 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; (* not 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;
        restore: actionrestore;
        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;(* knife not being charried *)
      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 (* Orcs follow *)
                     was^.present := was^.present - [orc];
                     present := present + [orc];
                     END;

      IF knife in carry THEN (* Only 1 knife in 1 place at a time *)
         IF knife in present THEN
            present := present - [knife];

      IF question = noquest THEN
         BEGIN (* various events *)
         IF where <> was THEN
            telllocation(briefly);
         IF (where = was) AND (warn = 14) THEN
            BEGIN  (* Only 1 turn on the lava x*)
            Write('You stood too long on the ');
            writeln('lava and cooked your goose.');
            oops;
            END;  
         IF knife in carry THEN
            IF (wet = waterwet) OR (class_ <> land) OR
              (pool = waterpool) THEN
              BEGIN   (* moisture destroys the knife *)
              carry := carry - [knife];
              writeln('The moist air causes the knife to discolor and ');
              writeln('crumble into dust.');
              END; (* moisture destroys the knife *)  
         IF ([dragon, snake] * present) <> [] THEN
            BEGIN   (* An animal that affects over several turns is present *)
            IF rightech THEN
               rightech := False
            ELSE
               strangle := strangle + 1;
            i := strangle div 7;
            IF knife in carry THEN
               BEGIN   (* animals don't like the knife 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; (* animals don't like the knife x*)

            IF strangle = 7 * i THEN
               BEGIN    
               CASE i OF
                  1: IF dragon in present THEN
                        BEGIN  
                        Write('The dragon singes your ');
                        writeln('hair WITH his breath.');
                        END 
                     ELSE
                        writeln('The snake coils menacingly around you.');
                  2: IF dragon in present THEN  
                        writeln('The dragon scorches your clothes WITH his breath.')
                     ELSE           
                        writeln('The snake coils tightly around you.');
                  3: BEGIN    (* It killed you x*)
                     IF dragon in present THEN
                        writeln('The dragon roasts you to a cinder.')
                     ELSE       
                        writeln('The snake squeezes and crushes your bones.');
                     oops;
                     END (* it killed you *) 
                  END;(* CASE *)
               END;(* strangle multiple of 7 *) 
            END;(* dragon or snake here *)  
      END; (* various events, no question *)

      was := where;
      WITH nouns[lamp] DO
         IF burning THEN
            BEGIN  (* Lamp on  x*)
            timeleft := timeleft - 1;
            IF timeleft = 0 THEN
               BEGIN   (* out of oil  x*)
               burning := False;
               IF lamp in (carry + present) THEN
                  BEGIN   (* lamp here and just went dark  x*)
                  writeln('The lantern just ran out of fuel.');
                  writeln('You''ll need oil to refill it and a match to light it.');
                  END;
               END(* lamp out of oil *)
            ELSE IF timeleft = 15 THEN
               BEGIN     (* warn fuel low x*)
               writeln('The lantern is running low on fuel.');
               writeln('You may be able to fill it WITH some oil.');
               END;(* lamp running low *)
            END; (* burning lamp *)  (* 13  x*)

      IF orc in present THEN
        throw(False)
      ELSE
         IF (class_ = land) AND (side = inside) THEN
            BEGIN      (* Inside on land  *)
            IF pstate = pactive THEN
               IF random < 0.06333 THEN
                  IF random < 0.3333 THEN
                     BEGIN    (* Pirate  *)
                     Write('A pirate appears out of the ');
                     writeln('darkness for just a moment.');
                     IF (treas * carry) <> [] THEN
                        BEGIN (* theft *)
                        Write('While he''s here he says: "I''ll take');
                        writeln('your treasures and hide them away.');
                        WITH nouns[chest] DO
                           BEGIN   (* put treasures in chest *)
                           chestcontents := chestcontents + treas * carry;
                           cheststate := lockedchest;
                           END; (* put treasures in chest *)
                        carry := carry - treas * carry;
                        END;(* theft *)
                     END  (* pirate shows up *)
                  ELSE
                     writeln(
                        'A pirate runs by, pokes you in the ribs, laughs, and disappears.');

            IF saforc > 0 THEN (* not time for an orc *)
               saforc := saforc - 1
            ELSE
               IF numorc > 0 THEN
                  IF random < 0.1 THEN
                     BEGIN  (* orc could show up *)
                     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 *)
                           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 *)
                        ELSE
                           BEGIN    (* Not first orc encounter *)
                           present := present + [orc];    -==(oIo)==-
                           throw(True);
                           END;     (* Not first orc encounter *)
                     END;(* orc could shows up *)
 
            END;     (* inside on land *)
      END; (* WITH where *)
   END; (* stageuniverse *)


   BEGIN (* main program *)
   debugging := True;
   Initialize;
   REPEAT
     stageuniverse;
     debugit('Main program, current location: '+locptrtostring(where,false));
     50: (* ask question immediately *)
     IF not done THEN
        queryhuman;

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