(***********************************************)
(*     A  d  v  e  n  t  u  r  e     # 2       *)
(*                                             *)
(* This is the second example of the Pascal    *)
(* adventure game from the book :              *)
(*                                             *)
(*    PROGRAMMING YOUR OWN ADVENTURE GAMES     *)
(*                  IN PASCAL                  *)
(*                                             *)
(* Log:                                       *)
(* ----                                        *)
(* 1984: First release       - Richard C. Vile *)
(* 2026: Port to Free Pascal - D. Rioual       *)
(*                                             *)
(***********************************************)
PROGRAM adventure2;
CONST
  ff = 12;
  
TYPE

  rooms        = (start, grandroom, vestibule, narrow1,
                  lakeshore, island, brink, iceroom,
                  ogreroom, narrow2, pit, crystal,
                  batscave, steam, deadend, ladder,
                  maze, stairs, echoes, warmroom,
                  incline, honeycomb, roundroom,
                  mudroom, deeppool, coldroom, narrow3,
                  narrow4, river, rockyroom, siltroom,
                  alcove, flames, m0, m1, m2, m3, m4,
                  m5, m6, m7, m8, m9, m10, m11, m12,
                  m13, m14, m15, m16, m17, m18, m19,
                  same, nowhere);

  directions   = (n, s, e, w, u, d);

  cmds         = (carry, drop, help, light,
                  invent, take, tally, push,
                  dig, look, open, unlock,
                  eat, nocmd);

  objects      = (lamp, treasure, key,
                  sandwich, bottle, shovel,
                  noobj);
  
  
  collection   = SET OF objects;

  pname        = STRING[40];
  storyline    = STRING[80];
  byte         = 0..255;

  whichsection = (indexsection, descsection);

  placerec     =
    
    RECORD

      CASE section:whichsection OF
 
        indexsection: ( tableentry:     INTEGER);

        descsection:  ( name:           pname;
                        id:             INTEGER;
                        dbegin:         INTEGER;
                        dend:           INTEGER;
                        link:           byte   );
    END;

VAR
  xfile:        FILE OF placerec;
  narrate:      FILE OF storyline;

  places:       ARRAY[rooms] OF placerec;
  whatshere:    ARRAY[rooms] OF collection;
  visited:      ARRAY[rooms] OF BOOLEAN;

  stash:        collection;

  command:      STRING;
  { holds user typed direction } 

  head,
  tail:         STRING;
  { hold SEPARATE words OF command }

  cmdnames:     ARRAY[cmds] OF STRING;
  objnames:     ARRAY[objects] OF STRING;
  ch:           CHAR;

  dchars:       SET OF CHAR;
  { characters which correspond TO the
    acceptable initial letters OF
    direction commands. initialized TO
    ['n', 's', 'e' 'w', u', 'd']       }

  location:     rooms;

  turns:        INTEGER;
  indark:       INTEGER;
  hasdug:       INTEGER;

  done:         BOOLEAN;
  quit:         BOOLEAN;
  lit:          BOOLEAN;
  eaten:        BOOLEAN;
  awake:        BOOLEAN;
  readmsg:      BOOLEAN;
  cooked:       BOOLEAN;
  candig:       BOOLEAN;
  chgloc:       BOOLEAN;

{*********}
{ w i p e }
{*********}
PROCEDURE wipe;
BEGIN
  write (chr (ff));
END;

{************************************}
{ i  n  t  r  o  d  u  c  t  i  o  n }
{************************************}
PROCEDURE introduction;
BEGIN
  wipe;         { clear screen }

  writeln;
  writeln ('Welcome to miniadventure!');
  writeln ('Your goal will be to find a treasure');
  writeln ('and bring it back to your starting');
  writeln ('point. You will also get points');
  writeln ('for finding each location in the');
  writeln ('adventure. Points will be deducted');
  writeln ('for various undesirable happenings:');
  writeln ('waking the ogre, getting eaten,');
  writeln ('getting toasted, etc.');
  writeln;
  writeln ('I will guide you and be your eyes');
  writeln ('and ears. Command me with one or');
  writeln('two word phrases, such as');
  writeln('"CARRY KEY" or "NORTH".');
  writeln;
  writeln ('I only look at the first letter');
  writeln ('of commands that tell me which');
  writeln ('direction to take. Thus, I take');
  writeln ('"NORTH" and "N" to be the same.');
  writeln;
  writeln ('When you are ready to begin your');
  writeln ('adventure, just press RETURN"');

  readln (command);

  wipe;

END { PROCEDURE introduction };

{************************************}
{    i  n  i  t  i  a  l  i  z  e    }
{************************************}
PROCEDURE initialize;
VAR
  loc: rooms;
BEGIN

  location := start;
  dchars   := ['q', 'n', 's', 'e', 'w', 'u', 'd'];
  done     := false;
  quit     := false;
  cooked   := false;
  eaten    := false;
  lit      := false;
  awake    := false;
  readmsg  := false;
  candig   := false;
  chgloc   := true;
  turns    := 0;
  indark   := 0;
  hasdug   := 0;

  FOR loc := start TO nowhere DO
  BEGIN

    visited[loc]      := false;
    whatshere[loc]    := [];
  
  END { DO };

  stash               := [];
  whatshere[start]    := [lamp];
  whatshere[coldroom] := [shovel];
  whatshere[narrow4]  := [key];
  whatshere[deadend]  := [sandwich];
  whatshere[mudroom]  := [bottle];

  cmdnames[carry]     := 'carry';
  cmdnames[drop]      := 'drop';
  cmdnames[help]      := 'help';
  cmdnames[light]     := 'light';
  cmdnames[invent]    := 'inventory';
  cmdnames[take]      := 'take';
  cmdnames[tally]     := 'score';
  cmdnames[push]      := 'push';
  cmdnames[dig]       := 'dig';
  cmdnames[look]      := 'look';
  cmdnames[open]      := 'open';
  cmdnames[unlock]    := 'unlock';
  cmdnames[eat]       := 'eat';
  cmdnames[nocmd]     := 'sentinel';

  objnames[lamp]      :='lamp';
  objnames[treasure]  := 'treasure';
  objnames[shovel]    := 'shovel';
  objnames[key]       := 'key';
  objnames[sandwich]  := 'sandwich';
  objnames[bottle]    := 'bottle';
  objnames[noobj]     := 'sentinel';

  (* old code :
  reset (xfile, 'a2.db80.x');
  reset (narrate, 'a2.db80');
  *)
  assign (xfile, 'a2.db80.x');
  reset (xfile);

  assign (narrate, 'a2.db80');
  reset (narrate);

  loc := start;

  (* old code :
  seek (xfile, 31);
  get (xfile);
  places[loc] := xfile^;
  *)
  seek (xfile, 31);
  read (xfile, places[loc]);

  REPEAT
    
    loc := succ (loc);

    (* old code :
    get (xfile); 
    places[loc] := xfile^;
    *)
    read(xfile, places[loc]);

  UNTIL loc = flames;
  
  close (xfile);
  
END { PROCEDURE initialize };

{************************************}
{  s  h  o  w  o  b  j  e  c  t  s   }
{************************************}
PROCEDURE showobjects;
VAR
  lobj: objects;

BEGIN
  FOR lobj := lamp TO noobj DO
    IF lobj IN whatshere[location] THEN
    BEGIN
      
      write ('There is a ');
      write (objnames[lobj]);
      writeln (' here.');
    
    END { IF lobj IN.. }
  { enddo };

END { PROCEDURE showobjects };

{************************************}
{          s    h    o    w          }
{************************************}
PROCEDURE show (where: rooms);
VAR
  i:    INTEGER;
  tmp:  storyline;

BEGIN
  IF (chgloc AND lit) OR (location = start) THEN
  BEGIN

    WITH places[where] DO
    BEGIN
      FOR i := dbegin TO dend DO
      BEGIN

        seek (narrate, i);
        (* old code :
        get (narrate);
        write (narrate^);
        *)
        read (narrate, tmp);
        writeln (tmp);
      
      END { DO };
    END { WITH places };
  END { IF chgloc };

  showobjects; 
END { PROCEDURE show }; 

{************************************}
{       s    c    o    r    e        }
{************************************}
FUNCTION score: INTEGER;
VAR
  loc:  rooms;
  sc:   INTEGER;

BEGIN 
  sc := 0; 
  
  FOR loc := start TO flames DO
    IF visited[loc] THEN
      sc := sc + 5;
    { endif }
  { enddo }; 

  IF NOT quit THEN 
    sc := sc + 140; 

  IF cooked THEN
    sc := sc - 50;

  IF eaten THEN
    sc := sc - 50;

  IF awake THEN
    sc := sc - 25; 

  score := sc;

END { FUNCTION score }; 

{************************************}
{    c o n g r at u l a t i o n s    }
{************************************}
PROCEDURE congratulations;
BEGIN 

  IF NOT cooked THEN
  BEGIN 

    IF NOT quit THEN
    BEGIN 
       
      writeln ('***** Congratulations *****');
      writeln;
      write ('You got the treasure out in only ');
      writeln (turns:4,' turns.'); 

    END; 

    writeln ('you scored ', score:4);
    writeln (' points out of a maximum of 300 pts.');
    writeln ('So long for now. come again soon!'); 
  
  END
  ELSE 
    
    writeln ('Sorry about that - try again soon!');
  
  { endif };
  
  readln (command);
  wipe; 

END { PROCEDURE congratulations };

{************************************}
{     o  b  j  l  o  o  k  u  p      }
{************************************}
FUNCTION objlookup: objects;
VAR
  lobj: objects;

BEGIN 
  objnames[noobj] := tail;
  lobj            := lamp; 

  WHILE tail <> objnames[lobj] DO
  BEGIN
    { old debug statements - leave in
      for historical edification.
    write (tail);
    write ('<>');
    writeln (objnames[lobj]);
    }
    lobj := succ (lobj);

  END { DO };
  
  objlookup := lobj;

END;

{************************************}
{       c  k  o  b  j  e  c  t       }
{************************************}
FUNCTION ckobject (it:objects): BOOLEAN;
BEGIN

  ckobject := false;

  IF it IN whatshere[location] THEN
    ckobject := true
  { endif };

END { FUNCTION ckobject };

{************************************}
{       p   c   a   r   r   y        }
{************************************}
PROCEDURE pcarry;
VAR
  it: objects;
BEGIN
  it := objlookup;

  IF NOT ckobject (it) THEN
  BEGIN

    write ('I don''t see any ');
    write (tail);
    writeln (' here.');

  END
  ELSE
  BEGIN

    writeln ('Ok');

    stash := stash + [it];
    whatshere[location] := whatshere[location] - [it]

  END { IF NOT it IN ... }

END { PROCEDURE pcarry };

{************************************}
{        p   d   r   o   p           }
{************************************}
PROCEDURE pdrop;
VAR
  it:   objects;
BEGIN

  it := objlookup;

  IF NOT (it IN stash) THEN
  BEGIN

    write ('You are not carrying any ');
    writeln (tail);

  END
  ELSE
  BEGIN
    
    writeln ('Ok');
    stash := stash - [it];
    whatshere[location] := whatshere[location] + [it];

  END {IF NOT it IN stash };

END { PROCEDURE drop };

{************************************}
{          p   h   e   l   p         }
{************************************}
PROCEDURE phelp;
BEGIN
  
  IF readmsg THEN
  BEGIN

    writeln ('The treasure is deep in the maze');

  END
  ELSE
  BEGIN
    writeln ('There are hints to be found');
    writeln ('near the lake and in the alcove.');

  END { IF readmsg};

END { PROCEDURE phelp };


{************************************}
{       p   l   i   g   h   t        }
{************************************}
PROCEDURE plight;
BEGIN

  IF NOT (lamp IN stash) THEN
    writeln ('You are not carrying the lamp.')
  ELSE
  BEGIN
    IF (tail = 'on')
       OR
       (tail = 'lamp')
       OR
       (tail ='')
    THEN
      lit := true
    ELSE
      lit := false
    { endif };
  
  END { IF NOT lamp IN stash };

  IF lit THEN  
    writeln ('Your lamp is now on.')
  ELSE
    writeln ('Your lamp is off.');
  { endif };

END { PROCEDURE plight };

{************************************}
{     p  i  n  v  e  n  t  o  r      }
{************************************}
PROCEDURE pinventory;
VAR
  lobj: objects;
BEGIN

  IF stash <> [] THEN
  BEGIN
    writeln ('You are currently holding: ');
    FOR lobj := lamp TO noobj DO
    BEGIN

      IF lobj IN stash THEN
        writeln (objnames[lobj])
      { endif }

    END { FOR 1obj := ... };
  END { IF stash <> [] };

END { PROCEDURE pinventory };

{************************************}
{          p   p   u   s   h         }
{************************************}
PROCEDURE ppush;
VAR 

  newtail: STRING;
  p:       INTEGER;
BEGIN 

  p := pos (' ', tail);
  IF p = 0 THEN
    newtail := ''
  ELSE
  BEGIN 
  
    newtail := copy(tail,p+1,length(tail)-p);
    tail    := copy(tail,1,p-1); 
  
  END { IF p = 0 }; 

  IF (tail = 'treasure') THEN
  BEGIN 

    IF (treasure IN whatshere[narrow1])
       AND
       (location = narrow1) THEN
    BEGIN 

      writeln ('Ok');
      whatshere[vestibule] := whatshere[vestibule] + [treasure];
      whatshere[narrow1]  := whatshere[narrow1] - [treasure]; 

    END { IF treasure ... }; 

  END
  ELSE
  BEGIN

    writeln ('Sorry, but I don''t think I can do that.');
  
  END { IF tail = 'treasure' };

END { PROCEDURE ppush };

{************************************}
{            p   d   i   g           }
{************************************}
PROCEDURE pdig;
BEGIN 

  candig := (shovel IN stash) 
            AND
            (readmsg); 

  IF (location = m19) AND candig THEN
    hasdug := hasdug + 1
  { endif }; 

  IF (location <> m19) THEN
  
    writeln ('You can''t dig here at all.')
  
  ELSE
    IF hasdug = 0 THEN
    BEGIN 

      writeln ('You can''t dig here yet.');

    END 
    ELSE
      IF hasdug = 1 THEN
      BEGIN 

        writeln ('That''s a nice pile of dirt you');
        writeln ('have shovelled. Be careful');
        writeln ('not to block your way out!'); 
      
      END
      ELSE
        IF hasdug = 2 THEN
        BEGIN 

          writeln ('I see the top of a weather-');
          writeln ('beaten chest.');
      
        END
        ELSE
          IF hasdug  = 3 THEN
          BEGIN

            writeln('You have unearthed an old');
            writeln('treasure chest. It is');
            writeln ('secured with a massive');
            writeln ('brass lock.');

          END
          ELSE
            IF hasdug = 4 THEN
            BEGIN

              writeln ('There''s nothing else here.');
              writeln ('but if you try hard, you');
              writeln ('might dig down to the');
              writeln ('lava pits!');
            
            END
            ELSE
              IF hasdug > 4 THEN
              BEGIN

                cooked := true;
                done := true;
                show (flames);
                location := flames;
                chgloc := true;
                
              END { IF hasdug > 4 }
          { END IF hasdug = 4 }
        { END IF hasdug = 3 }
      { END IF hasdug = 2 }
    { END IF hasdug = 1 }
  { END IF hasdug = 0 }
{ END IF (location <> m19 };

END { PROCEDURE pdig };

{************************************}
{         p   o   p   e   n          }
{************************************}
PROCEDURE popen;
BEGIN 

  IF (location = m19)
     AND
     (hasdug >= 3)
     AND
     (key IN stash)
  THEN
  BEGIN 
  
    writeln ('Ok');
    whatshere[m19] := whatshere[m19] + [treasure];
    writeln ('The chest is full of treasure'); 

  END { IF };

  IF (location = m19)
     AND
     (hasdug >= 3)
     AND
     ( NOT (key IN stash) )
  THEN
  BEGIN 
  
    writeln ('I''m afraid you''ll need a key');
    writeln ('to open that brass lock!'); 

  END { IF };

  IF location <> m19 THEN 
    writeln ('There''s nothing here to open!') 
  { endif };

END { PROCEDURE popen };

{************************************}
{         p   l   o   o   k          }
{************************************}
PROCEDURE plook;
VAR 
  savchg:      BOOLEAN;

BEGIN 

  savchg := chgloc;
  chgloc := true; 

  IF location <= flames THEN
    show (location)
  ELSE
    show (maze)
  { endif };

  chgloc := savchg; 

END { PROCEDURE plook };

{************************************}
{            p   e   a   t           }
{************************************}
PROCEDURE peat;
BEGIN 

  IF sandwich IN stash THEN
  BEGIN 
  
    writeln ('Oh, yummy!!');
    stash := stash - [sandwich]; 

  END
  ELSE
    IF tail = 'sandwich' THEN
      writeln ('You don''t have a sandwich')
    ELSE
      writeln ('Don''t be ridiculous!!')
    { endif }
  { endif }; 

END { PROCEDURE peat }; 

{************************************}
{     c  m  d  l  o  o  k  u  p      }
{************************************}
FUNCTION cmdlookup: cmds;
VAR
  p:    INTEGER;
  lcmd: cmds;
BEGIN 

  writeln;
  write ('===> ');
  readln (command);
  p := pos (' ' , command);

  IF p = 0 THEN
  BEGIN
    head := command;
    tail := ''
  END
  ELSE
  BEGIN
    head := copy (command, 1, p-1);
    tail := copy (command, p+1, length (command)-p);
  END { IF p = 0 };

  cmdnames[nocmd] := head;
  lcmd := carry; 

  WHILE head <> cmdnames[lcmd] DO
    lcmd := succ (lcmd)
  { END DO };
  
  cmdlookup := lcmd;

END { FUNCTION cmdlookup };

{************************************}
{       l   i   s   t   e   n        }
{************************************}
PROCEDURE listen;
VAR
  lcmd: cmds; 

BEGIN
  REPEAT 
    lcmd := cmdlookup;
    
    CASE lcmd OF

      carry:    pcarry;
      drop:     pdrop;
      help:     phelp;
      light:    plight;
      invent:   pinventory;
      take:     pcarry;
      tally:    BEGIN
                
                  write('Should you quit now, ');
                  writeln ('your score would be ');
                  writeln ((score-140):3);
                  writeln (' points of a possible 300.');
                
                END;
      
      push:     ppush;
      dig:      pdig;
      look:     plook;
      open:     popen;
      unlock:   popen;
      eat:      peat;
      nocmd:    ; 
    
    END;
  
  UNTIL lcmd = nocmd;

END { PROCEDURE listen };


{************************************}
{     d  o  c  o  m  m  a  n  d      }
{************************************}
FUNCTION docommand: CHAR;
BEGIN 

  head := '';
  tail := '';
  
  REPEAT 
    
    listen 

  UNTIL length (head) > 0;
  docommand := head[1];

END { PROCEDURE docommand };


{************************************}
{       w  h  i  c  h  w  a  y       }
{************************************}
FUNCTION whichway:directions;
BEGIN 

  turns := turns + 1;
  
  REPEAT
    ch :=  docommand;
    
    CASE ch OF 
    
      'n':       whichway := n;
      's':       whichway := s;
      'e':       whichway := e;
      'w':       whichway := w;
      'u':       whichway := u;
      'd':       whichway := d;
      'q':           quit := true; 
    
    END;
    
  UNTIL ch IN dchars;
  
  writeln;

END { FUNCTION whichway }; 


{************************************}
{         n   o   w   a   y          }
{************************************}
PROCEDURE noway;
BEGIN
  
  writeln;
  write ('There is no way to go ');
  writeln ('in that direction.');
  
  chgloc := false; 
END;


{************************************}
{       c   k   l   a   m   p        }
{************************************}
PROCEDURE cklamp;
BEGIN 

  IF (location <> start) AND (NOT lit) THEN
    indark := indark + 1
  { endif };

  IF indark > 4 THEN
  BEGIN

    quit   := true;
    cooked := true;
    done   := true; 

    writeln ('you fell into a pit and were');
    writeln ('killed. Too bad!! Maybe next');
    writeln ('time you''ll listen to me');
    writeln ('and keep your lamp on!'); 

  END
  ELSE 
    
    IF (indark > 0) AND (NOT lit) AND (location <> start) THEN
    BEGIN

      writeln ('It is now pitch dark.');
      writeln ('I wouldn''t go too far.');
      writeln ('You might fall into a pit and be killed.'); 

    END { IF indark > 0 };

{ END IF Indark > 4 }; 

  IF (turns >= 75) AND (turns < 80) THEN
  BEGIN 
  
    writeln ('I would think about wrapping this');
    writeln ('up, since your lamp is getting dim.');

  END
  ELSE 
    IF turns > 150 THEN
    BEGIN 

      writeln ('You''re in trouble now!');
      writeln ('Your lamp just went out!');
      lit := false; 

    END { IF turns > 150 }
{ END IF turns >= 75 ... };

END { PROCEDURE cklamp };


{************************************}
{       t   r   a   v   e   l        }
{************************************}
PROCEDURE travel( 
            nloc,
            sloc,
            eloc,
            wloc, 
            uloc,
            dloc: rooms);

  PROCEDURE newloc(loc:rooms);
  BEGIN 
    IF loc = nowhere THEN
      noway
    ELSE
    BEGIN
      location := loc;
      chgloc   := true;
    END { IF I }; 
  
  END { PROCEDURE newloc };

BEGIN {*** travel ***} 

  CASE whichway OF
    n:  newloc (nloc);
    s:  newloc (sloc);
    e:  newloc (eloc);
    w:  newloc (wloc);
    u:  newloc (uloc);
    d:  newloc (dloc); 

  END { CASE whichway };

END { PROCEDURE travel }; 


{************************************}
{    o  g  r  e  a  c  t  i  o  n    }
{************************************}
PROCEDURE ogreaction;
BEGIN

  IF NOT awake THEN
  BEGIN
    writeln ('This is the ogre''s lair');
    writeln ('If you are not careful, you''ll');
    writeln ('wake him.'); 

    IF (turns MOD 3) = 0 THEN
    BEGIN
    
      awake := true;
      writeln ('Now you''ve done it!');
      writeln ('You woke the ogre - better');
      writeln('get out of here while you can');
  
    END { IF };
  
  END
  ELSE
  BEGIN
    writeln ('You wouldn''t listen to me would');
    writeln ('you? You really better get out');
    writeln ('of here before you get eaten!');

    IF treasure IN stash THEN
      IF (turns MOD 2) = 0 THEN
      BEGIN
        
        writeln ('Too bad!! The ogre caught you');
        writeln ('and roasted you for dinner.');
        writeln('Better luck next time!!');
        
        eaten := true;
        quit  := true;
      
      END
      ELSE
      BEGIN
      
        writeln('Get out fast if you don''t want');
        writeln('to be a big-mac for the ogre!!');

      END
    ELSE
      IF (turns MOD 2) = 0 THEN
      BEGIN
        
        writeln('Too bad - you''ve been eaten!'); 
        eaten := true;
        quit  := true;
      END
  
  { endif }

  END { IF NOT awake };

END { PROCEDURE ogreaction };


{************************************}
{       p   s   t   a   r   t        }
{************************************}
PROCEDURE pstart;
BEGIN

  IF treasure IN stash THEN
    done := true
  ELSE
  BEGIN
  
    CASE whichway OF
    
      n,s,e,w:    noway;
      u:          writeln ('You can''t jump to the clouds!');
      d:          location := vestibule;

    END;
  
  END { IF carrying };
  
    chgloc := (location <> start);

END { PROCEDURE pstart };

{************************************}
{    p  v  e  s  t  i  b  u  l  e    }
{************************************}
PROCEDURE pvestibule;
BEGIN

  IF treasure IN whatshere[narrow1] THEN
  BEGIN
  
    write ('To the north, through a narrow ');
    writeln ('crack,'); 
    writeln ('you can see the treasure. ');

  END { IF treasure... };

  travel (narrow1, grandroom, iceroom,
          nowhere, start, nowhere);

END { PROCEDURE pvestibule };

{************************************}
{       p  n  a  r  r  o  w  1       }
{************************************}
PROCEDURE pnarrow1;
BEGIN

  CASE whichway OF
    
    n:  location := lakeshore;
    e:  location := ogreroom;
    s:  writeln ('It''s too narrow to get through!');

    w,u,d:      noway

  END { CASE whichway };

  chgloc := (location <> narrow1);

END { PROCEDURE pnarrow1 };


{************************************}
{         p  i  s  l  a  n  d        }
{************************************}
PROCEDURE pisland;
BEGIN

  travel (nowhere, lakeshore, nowhere,
          nowhere, nowhere, nowhere);

  readmsg := true;

END { PROCEDURE pisland };


{************************************}
{     p  o  g  r  e  r  o  o  m      }
{************************************}
PROCEDURE pogreroom;
VAR
  i,j: INTEGER;
BEGIN

  ogreaction;

  IF NOT eaten THEN
  BEGIN

    writeln ('There are exits to the east,');
    writeln ('north, and west');

    CASE whichway OF
    
      w:          location := narrow1;
      e:          location := batscave;
      n:          location := narrow2;
      d:
      BEGIN
    
        quit  := true;
        eaten := true;

        writeln ('Oh no!! You dummy!!!');
        writeln ('You just fell into the firepit');
        writeln ('and made such a ruckus that');
        writeln ('you woke the ogre. I hate to');
        writeln ('tell you this, but you are');
        writeln ('also trapped!');

        FOR i:= 1 TO 5 DO
        BEGIN
          FOR j:= 1 TO 1000 DO;
            write ('.');
        END { DO };

        writeln;
        writeln ('You''ve just been added to the');
        writeln ('ogre''s gourmet recipe library!');
        writeln ('Better luck next time.');

      END;
    
      s,u:  noway;

    END { CASE whichway };

  END { IF NOT eaten };

  chgloc := (location <> ogreroom);

END { PROCEDURE pogreroom };


{************************************}
{          p   m   a   z   e         }
{************************************}
PROCEDURE pmaze;
TYPE
  mazerooms = m0..same;

  PROCEDURE describe;
  BEGIN

    writeln ('You are in a maze of');
    writeln ('featureless passages.');
    writeln;

  END { PROCEDURE describe };
  
  PROCEDURE sameplace;
  BEGIN

    writeln ('You have crawled around');
    writeln ('some twisted tunnels and');
    writeln ('wound up where you began.');
  
  END { PROCEDURE sameplace };

  PROCEDURE travel (
              nloc,
              sloc,
              eloc,
              wloc,
              uloc,
              dloc: rooms);

    PROCEDURE newloc (loc:rooms);
    BEGIN

      IF loc = m0 THEN
        noway
      ELSE
        IF loc = same THEN
          sameplace
        ELSE
          location := loc
        { endif }
      { endif };
    
    END { PROCEDURE newloc };

  BEGIN   {** travel **}

    CASE whichway OF
    
      n:  newloc (nloc);
      s:  newloc (sloc);
      e:  newloc (eloc);
      w:  newloc (wloc);
      u:  newloc (uloc);
      d:  newloc (dloc);

    END {CASE whichway };

  END { PROCEDURE travel };

  PROCEDURE pm1;
  BEGIN

    writeln ('From here you can go south, east,');
    writeln ('west, or up.');

    CASE whichway OF
  
      s:        location := ladder;
      e:        location := m2;
      w:        location := m4;
      u:        location := steam;
      n,d:      noway;
  
    END;

  END { pm1 } ;

BEGIN { PROCEDURE pmaze };

  REPEAT
    IF (location <> m1) AND (location <> maze) THEN
      describe;
    { endif }

    showobjects;
    cklamp;

    CASE location OF
      maze,
      m1:       pm1;
      m2:       travel (m1, same, m0, m0, m0, m0);
      m3:       travel (m1, m0, same, m0, m0, m0);
      m4:       travel (m0, m7, m3, m5, m0, m0);
      m5:       travel (m1, m0, m0, m0, m0, m0);
      m6:       travel (m4, m0, same, m0, m0, m0);
      m7:       travel (m5, m9, m6, m8, m0, m0); 
      m8:       travel (m5, m0, m0, same, m0, m0);
      m9:       travel (m0, m11, m0, m10, m0, m0);
      m10:      travel (m8, same, m0, m0, m0, m0);
      m11:      travel (m9, m0, m6, m10, m1, m12);
      m12:      travel (m13, m0, m0, m0, m0, m16);
      m13:      travel (m14, m0, m0, m0, m0, m17);
      m14:      travel (m15, m0, m0, m0, m0, m18);
      m15:
        BEGIN
          writeln('I seem to remember buried');
          writeln('treasure near this location.');
          travel (m0, m0, m0, m0, m1, m19);
        END ;

      m16:     travel (m17, same, m0, m0, m0, m0);
      m17:     travel (m18, m16, m0, m0, m0, m0);
      m18:
        BEGIN
 
          writeln('I seem to remember a treasure');
          writeln ('near here.');
          travel (m19, m17, m0, m0, m0, m0);
        END;
    
      m19:     travel (m0, m18, m0, m0, m15, m0);
  
    END { CASE location };
  
  UNTIL (location < maze) OR (location = flames);
  chgloc := true;

END { PROCEDURE pmaze };


{************************************}
{           p   p   i   t            }
{************************************}
PROCEDURE ppit;
BEGIN

  CASE whichway OF
    d:          location := ladder;
    u: 
      BEGIN 
        writeln ('Try to climb that');
        writeln ('and you''ll kill yourself!');
      END ;

    n,s,e,w:    noway;

  END;
  chgloc := (location <> pit);

END { PROCEDURE ppit };


{************************************}
{      p   l   a   d   d   e   r     }
{************************************}
PROCEDURE pladder;
BEGIN

  CASE whichway OF
  
    n:          location := maze;
    d:          location := flames;
    u:
      IF treasure IN stash THEN
      BEGIN
      
        writeln ('You can''t carry the treasure');
        writeln ('up the ladder -');
        writeln ('it''s much too heavy!');
      
      END
      ELSE

        location := vestibule
      { endif };

    e,s,w:     noway;
  
  END;

  chgloc := (location <> ladder);

END { PROCEDURE pladder };


{************************************}
{         p  f  l  a  m  e  s        }
{************************************}
PROCEDURE pflames;
BEGIN

  cooked := true;
  done   := true;

END { PROCEDURE pflames };



{************************************}
{       =====> adventure <=====      }
{************************************}
BEGIN

  introduction;
  initialize;

  REPEAT
    visited[location] := true;
    show (location);
    cklamp;

    CASE location OF
      start:      pstart;
      grandroom:  travel (nowhere, nowhere,
                          nowhere, brink,
                          nowhere, stairs);
      vestibule:  pvestibule;
      narrow1:    pnarrow1;
      lakeshore:  travel (island, narrow1,
                          narrow2, nowhere,
                          nowhere, nowhere);
      island:     pisland;
      brink:      travel (nowhere, nowhere,
                          nowhere, ogreroom,
                          nowhere, pit);
      iceroom:    travel (ogreroom, nowhere,
                          crystal, vestibule,
                          nowhere, nowhere);
      ogreroom:   pogreroom;
      narrow2:    travel (nowhere, ogreroom,
                          steam, lakeshore,
                          nowhere, nowhere);
      pit:        ppit;
      crystal:    travel (ogreroom, nowhere,
                          maze, ogreroom,
                          nowhere, nowhere);
      batscave:   travel (steam, nowhere,
                          nowhere, ogreroom,
                          nowhere, nowhere);
      steam:      travel (deadend, batscave,
                          nowhere, narrow2,
                          nowhere, maze);
      deadend:    travel (nowhere, steam,
                          nowhere, nowhere,
                          nowhere, nowhere);      
      ladder:     pladder;
      maze:       pmaze;
      stairs:     travel (nowhere, nowhere,
                          nowhere, nowhere,
                          grandroom, echoes);
      echoes:     travel (warmroom, incline,
                          nowhere, nowhere,
                          stairs, deeppool);
      incline:    travel (nowhere, nowhere,
                          roundroom, honeycomb,
                          echoes, nowhere);
      warmroom:   travel (nowhere, echoes,
                          nowhere, nowhere,
                          nowhere, flames);
      roundroom:  travel (honeycomb, nowhere,
                          nowhere, incline,
                          nowhere, mudroom);
      honeycomb:  travel (nowhere, narrow3,
                          incline, nowhere,
                          nowhere, nowhere);
      mudroom:    travel (nowhere, nowhere,
                          nowhere, nowhere,
                          roundroom, siltroom);
      deeppool:   travel (nowhere, nowhere,
                          nowhere, nowhere,
                          mudroom, coldroom);
      coldroom:   travel (nowhere, nowhere,
                          nowhere, nowhere,
                          deeppool, nowhere);
      narrow3:    travel (honeycomb, narrow4,
                          nowhere, nowhere,
                          nowhere, nowhere);
      narrow4:    travel (narrow3, river,
                          nowhere, nowhere,
                          nowhere, maze);
      river:      travel (narrow4, rockyroom,
                          nowhere, nowhere,
                          nowhere, nowhere);
      rockyroom:  travel (river, siltroom,
                          alcove, nowhere,
                          nowhere, nowhere);
      siltroom:   travel (rockyroom, nowhere,
                          nowhere, alcove,
                          mudroom, nowhere);
      alcove:     travel (nowhere, nowhere,
                          siltroom, nowhere,
                          nowhere, nowhere);
      flames:     pflames;
    
    END { CASE location };

  UNTIL quit OR done;

  congratulations;

  close (narrate);

END.

