! -----------------------------------------------------------------------------
! "phxlib.h"
! Control routines for Phoenix-compiled games
! (c) Graham Nelson, 990818
! -----------------------------------------------------------------------------
! Define pre and postcommand routines if the Phoenix source hasn't already
! -----------------------------------------------------------------------------

#ifndef PreCommand;
[ PreCommand; ];
#endif;
#ifndef PostCommand;
[ PostCommand; ];
#endif;

! -----------------------------------------------------------------------------
! The entry point to the Phoenix source code, catching the stack frame
! to permit a RETURN LEAVE to have the effect of returning from this routine
! -----------------------------------------------------------------------------

[ BeginSubroutineNest R dp;
  Return_State = 0;
  @catch -> Leave_StackFrame;
  if (dp) R.call(dp); else R.call();
];

! -----------------------------------------------------------------------------
! Reference resolution and the RESOLVE instruction
! Output: 0 if unresolvable, o if object o, r if room r
! -----------------------------------------------------------------------------

[ Resolve R Ob Zob Ans;
  if ((R < -1024) || (R >= 0)) Ob = (R+$1000)%$400;
  else Ob = (R+$1000)%$100;
  Zob = Ob;
  if (Ob == 0) {
      ! This is the case of ()O and ()R
      if (Word2_Slot-->Reference_LX)
          Zob = Word2_Slot-->Reference_LX;
      if (R~=0 && Zob && Zob ofclass Room)
          Zob = child(Zob);
  }
  R = R - Ob;
  switch (R) {
      -2048: Ans = Zob;
      -1024: Ans = Resolve(Read_Variable(Ob));
       -768: Ans = parent(Zob); if (Ans && Ans ofclass Room) Ans = 0;
       -512: Ans = sibling(Zob);
       -256: Ans = child(Zob);
          0: Ans = Zob;
       1024: Ans = Resolve(Read_Variable(Ob));
  }
  if (R < 0 && Ans && Ans ofclass Room) Ans = child(Ans);
  if (R >= 0 && Ans && Ans ofclass Item)
      do Ans = parent(Ans); until (Ans == 0 || Ans ofclass Room);
!  print "Resolved to: ", Ans, "^";
  return Ans;
];

[ ResolveInstr R;
  if (R && R ofclass Item) return R-2048;
  return R;
];

[ TestProperty obj attr;
  if (obj ~= 0) {
      @test_attr obj attr ?yes;
  }
  rfalse;
.yes;
  rtrue;
];

! -----------------------------------------------------------------------------
! Miscellaneous tests for SKIP instructions
! -----------------------------------------------------------------------------

[ MiscTest_MOVED;
  if (Resolve(PLAYER) ~= start_of_command_room) rtrue;
  rfalse;
];
[ MiscTest_LIGHT o p;
  if (Resolve(PLAYER) has attribute_0) rtrue; ! If room has light...
  objectloop (o has attribute_0 && o hasnt attribute_1) {
      p = o;
      do {
          if (p in Resolve(PLAYER)) rtrue;
          p = parent(p);
          if (p && p ofclass Item && p has attribute_1 or attribute_2) 
              break;
      } until (p == 0);
  }
  rfalse;
];
[ MiscTest_W1SPX;
  if (Word1_Slot-->Special_LX) rtrue;
  rfalse;
];
[ MiscTest_W2SPX;
  if (Word2_Slot-->Special_LX) rtrue;
  rfalse;
];
[ MiscTest_W1SP sm;
  if (Word1_Slot-->Special_LX == sm) rtrue;
  rfalse;
];
[ MiscTest_W2SP sm;
  if (Word2_Slot-->Special_LX == sm) rtrue;
  rfalse;
];
[ MiscTest_W1DI;
  if (Word1_Slot-->Direction_LX) rtrue;
  rfalse;
];
[ MiscTest_W2DI;
  if (Word2_Slot-->Direction_LX) rtrue;
  rfalse;
];
[ MiscTest_W2EX;
  if (Word2_Slot-->0) rtrue; rfalse;
];
[ MiscTest_W1OB;
  if (Word1_Slot-->Reference_LX ofclass Item) rtrue;
  rfalse;
];
[ MiscTest_W1RM;
  if (Word1_Slot-->Reference_LX ofclass Room) rtrue;
  rfalse;
];
[ MiscTest_W2OB;
  if (Word2_Slot-->Reference_LX ofclass Item) rtrue;
  rfalse;
];
[ MiscTest_W2RM;
  if (Word2_Slot-->Reference_LX ofclass Room) rtrue;
  rfalse;
];

! -----------------------------------------------------------------------------
! Other test routines
! -----------------------------------------------------------------------------

[ AdjComparison R1 R2 x;
  for (x=1:x<=DirectionLookup-->0:x++)
      if (R1 provides DirectionLookup-->x)
          if (R1.&(DirectionLookup-->x)-->0 == R2) rtrue;
  rfalse;
];

[ IndirectlyContains A B;
  if (A == 0) "*** IndirectlyContains called with A = 0 ***^";
  while (parent(A)) {
      A = parent(A);
      if (A == B) rtrue;
  }
  rfalse;
];

! -----------------------------------------------------------------------------
! ASK instructions
! -----------------------------------------------------------------------------

! flag = true for ASKANY, false for ASK
[ AskInstruction Question flag i ws j;
  for (::) {
      Question.call();
      buffer2->0 = 120;
      parse2->0 = 15;  ! Allow to split input into this many words
      ReadLine(buffer2, parse2);
      if (parse2-->1 == '#undo') { @restore_undo -> j; }
      for (i=0: i<8: i++) Word2_Slot-->i = 0;
      if (parse2-->1 ~= 0) {
          ws = WordArraySlot(parse2-->1);
          if (ws) for (i=0: i<8: i++) Word2_Slot-->i = ws-->i;
          parse-->3 = parse2-->1;
          SetSecondWordText(buffer2, parse2, 1);
          return;
      } else {
          if (flag) {
              SetSecondWordText(buffer2, parse2, 1);
              return;
          }
          print "I don't understand that!^";      
      }
  }
];

! Ask a yes/no question
[ AskQuestion Question i;
  Question.call();
  for (::) {
      buffer2->0 = 120;
      parse2->0 = 15;  ! Allow to split input into this many words
      parse2->1 = 0; parse2-->1 = 0;
      ReadLine(buffer2, parse2);
      if (parse2-->1 == 'y//' or 'yes') rtrue;
      if (parse2-->1 == 'n//' or 'no') rfalse;
      if (parse2-->1 == '#undo') { @restore_undo -> i; }
      print "Please answer the question (Y or N): ";
  }
];

! -----------------------------------------------------------------------------
! Reading input from the user
! -----------------------------------------------------------------------------

[ ReadLine buffer parse i x;
  ! Get a line of input and tokenise it
  read buffer parse;
  ! If all words were recognised, just return
  x = 0;
  for (i=0:i<parse->1: i++)
      if (parse-->((i*2)+1) == 0) x = 1;
  if (x == 0) return;
  ! Truncate input to five characters and try again
  buffer3-->0 = buffer-->0;
  x = 0;
  for (i=2:i<=(buffer->1)+1: i++) {
      buffer3->i = buffer->i;
      if (x < 0) {
          if (buffer->i ~= 32) x = 1;
      } else {
          if (buffer->i ~= 32) {
              if (x > 4) buffer3->i = 32;
              x++;
          } else x = -1;
      }
  }
  parse3-->0 = parse-->0;
  @tokenise buffer3 parse3;
  ! Copy back any newly recognised tokens
  for (i=0:i<parse->1: i++) {
      if (parse-->((i*2)+1) == 0)
          parse-->((i*2)+1) = parse3-->((i*2)+1);
  }
];

[ GetMoreInput n;
  print "> ";
  buffer2->0 = 120;
  parse2->0 = 15;
  ReadLine(buffer2, parse2);
  if (parse2->1 >= 1) {
      if (n == 1) {
          SetSecondWordText(buffer, parse, 1);
          parse->1 = 2;
          parse-->3 = parse-->1;
          parse-->1 = parse2-->1;
          rtrue;
      } else if (n == 2) {
          SetSecondWordText(buffer2, parse2, 1);
          parse->1 = 2;
          parse-->3 = parse2-->1;
          rtrue;
      }
  }
  rfalse;
];

! -----------------------------------------------------------------------------
! First and second word management
! -----------------------------------------------------------------------------

[ SetSecondWordText b p n at len i;
  if (n==1) { at = p->5; len = p->4; } else { at = p->9; len = p->8; }
!  print "At = ", at, " len = ", len, "^";
  if (len > 31) len = 31;
  SWText->0 = len;
  for (i=0:i<len:i++) SWText->(i+1) = b->(at+i);
];

[ PrintFirstWord;
  print (address) parse-->1;
];  

[ PrintSecondWord i;
  for (i=1:i<=SWText->0:i++) print (char) SWText->i;
];  

! -----------------------------------------------------------------------------
! The text variable
! -----------------------------------------------------------------------------

[ PrintTextVar i;
!  if (TV_R) TV_R();
  for (i=2:i<=TheTextVar-->0:i++) {
      print (char) TheTextVar->i;
  }
];

[ SetTextVariableWITH R;
!  TV_R = R;
!  print "[Textvar to be set to '"; R(); print "']^";
!  return;
  @output_stream 3 TheTextVar;
  R.call();
  @output_stream -3;
!  print "[Textvar now set to '"; PrintTextVar(); print "']^";
];

[ TextVarIsName c;
  if (TheTextVar-->0 > 2) {
    ! Make the first character upper case
    c = TheTextVar->2;
    switch (c) {
     'a' to 'z': c = c - 32;
    }
    TheTextVar->2 = c;
  }
!  print "[Textvar now set to '"; PrintTextVar(); print "']^";
];

! -----------------------------------------------------------------------------
! The DESCRIBE and DESCRET instructions
! -----------------------------------------------------------------------------

[ DescribeWith ref;
  DescribeWithout(ref, true);
];

[ DescribeWithout ref withflag o sv;
  if (MiscTest_LIGHT() == false) { print "It is pitch dark.^"; return; }
  if (ref == 0) ref = Resolve(PLAYER);
  if (ref && ref provides state) sv = ref.state;
  if (ref && ref ofclass Room) {
      if (ref has attribute_1) ref.message__2(sv); ! Visited
      else ref.message__1(sv);
      if (withflag)
          objectloop (o in ref && o hasnt attribute_1 && o ~= PLAYER) ! Visible
              DescribeWithout(o, true);
      return;
  }
  if (ref && ref ofclass Item) {
      if (ref has attribute_1) return; ! Hidden
      if (parent(ref) == PLAYER) ref.message__2(sv);
      else if (parent(ref) == 0 || parent(ref) ofclass Room) ref.message__1(sv);
      else ref.message__3(sv);
      if (withflag && ref hasnt attribute_2)   ! Non-opaque
          objectloop (o in ref)
              DescribeWithout(o, true);
      return;
  }
  "*** Problem: can't describe ref ", ref, " ***";
];

! -----------------------------------------------------------------------------
! Move the player via the given direction property, running an
! exit program if necessary
! -----------------------------------------------------------------------------

[ MoveDir dproperty R;
  R = Resolve(PLAYER); ! That is, R = (PLAYER)R
  if ((R == 0) || (~~(R provides dproperty))) {
      Pass_State = 0;
      print "You can't go in that direction!^"; rfalse;
  }
  if (R.#dproperty == 2) {
      move PLAYER to R.dproperty;
      Pass_State = 0;
  } else {
      Pass_State = 0;
      BeginSubroutineNest(R.&dproperty-->1);
      Pass_State = Return_State;
      Return_State = 0;
      switch(Pass_State & $7000) {
          DEST__RV:
              move PLAYER to (Pass_State & $fff);
          NEXTCOMM__RV, ABORT__RV: ;
          default: move PLAYER to R.&dproperty-->0;
      }
  }
];

! -----------------------------------------------------------------------------
! The MOVE instruction as a routine.  ref1 is the reference of what
! is to be moved; withflag is true for WITH, false for WITHOUT;
! movetype is the type of MOVE, and parameter has different meanings
! for different move types
! -----------------------------------------------------------------------------

[ Move__I ref1 parameter withflag movetype dest destdir rm x c d;
  ref1 = Resolve(ref1);
  if (ref1 == 0) "You can't do that!";
  switch(movetype) {
      TO__M:
          ! The parameter is the destination's reference
          dest = Resolve(parameter);
          if (dest == 0) "You can't do that!";
      DESTROY__M:
          ! The parameter is blank
          dest = 0;
      VIAEXIT__M:
          ! 
          "*** MOVE VIAEXIT not yet implemented ***";
      DIR__M:
          ! The parameter is a direction property
          destdir = parameter;
      RANDOM__M:
          ! The parameter is an attribute which cannot be held
          ! by the room being moved to, which is otherwise random
!          print "Doing MOVE ", (name) ref1, " with RANDOM^";
          dest = least__room + PHX_random(number__rooms) - 1;
!          print "Choosing room ", (name) dest, "^";
          if (dest has parameter) dest = 0;
!          if (dest == 0) print "Rejecting as having attribute^";
      RANDADJ__M:
          ! The parameter is blank
!          print "Doing MOVE ", (name) ref1, " with RANDADJ^";
          rm = Resolve(ref1); ! This applies the ()R operator
!          print "Initially in the room ", (name) rm, "^";
          for (x=1:x<=DirectionLookup-->0:x++)
              if (rm provides DirectionLookup-->x) c++;
          if (c == 0) return;
          d = PHX_random(c);
          for (c=0,x=1:x<=DirectionLookup-->0:x++)
              if (rm provides DirectionLookup-->x) {
                  c++;
!                  print (property) DirectionLookup-->x, "^";
                  if (c == d) destdir = DirectionLookup-->x;
              }
!          print "Decided to go ", (property) destdir, "^";
      default: "*** Illegal MOVE type ***";
  }

  if ((~~withflag) && parent(ref1)) {
      objectloop (x ofclass Object) give x ~held_at_start;
      while ((x = child(ref1))) {
          move x to parent(ref1);
          give x held_at_start;
      }
  }

  if (destdir) {
      if (ref1 == PLAYER) {
          MoveDir(destdir);
          if (Pass_State == ABORT__RV) {
              ! Undoing a MOVE WITHOUT due to an exit abort...
              objectloop (x has held_at_start) move x to PLAYER;
          }
      }
      else {
          rm = Resolve(ref1); ! This applies the ()R operator
          if (rm == 0) {
              "*** Error: ()R inapplicable to object moved via DIR ***";
          }
          if (rm.&destdir ~= 0) {
              move ref1 to (rm.&destdir)-->0;
          }
      }
  } else {
      if (dest) move ref1 to dest; else remove ref1;
  }
];  

! -----------------------------------------------------------------------------
! Word lookups
! -----------------------------------------------------------------------------

[ WordArraySlot dword x;
  if (dword == 0) return 0;
!  print "Trying WAS on ", (address) dword, "^";
  for (x = LexiconLookup:x-->0:x = x + 4)
      if (x-->0 == dword) {
!          print "Word ", (address) dword, " found at record ", x-->1, "^";
          return Lexicon + (x-->1)*14;
      }
!  print "To no avail^";
  return 0;
];

! -----------------------------------------------------------------------------
! Banners and tassels
! -----------------------------------------------------------------------------

[ Game_Banner i;
  style bold;
  print (string) GAME_NAME;
  style roman;
  print "^An adventure game by ", (string) GAME_AUTHOR,
      " (Cambridge University, ", (string) GAME_DATE, ")^";
  print "[This translation: version ", (0-->1) & $03ff;
  print "."; for (i=18:i<24:i++) print (char) 0->i;
  print " / Phoenix v", (string) phx_version, " / Inform v";
  inversion;
  #Ifdef DEBUGV; print " ## DEBUG VERSION ##";
  #Endif;
  print "^Please type ~inform~ for further details.]^^";
];

[ Game_Info;
!  Game_Banner();
  print "[Translators' note:^^";
  style bold;
  print (string) GAME_NAME;
  style roman;

  print " is one of about fifteen classic adventure games
         devised in the 1980s as recreations on ~Phoenix~, the
         IBM mainframe computer of Cambridge University, England.
         All academics in every subject area, from undergraduates
         to professors, shared this one central computer, and
         regular users knew each other well, both as familiar faces
         in the User Area and the Mond Room and by their initials-based
         usernames (for instance, JGT1 = Jonathan Thackray).
         Particularly at nights, Phoenix had something of the feel
         of a gypsy camp-fire: while each user had his own individual
         serious projects, entertainments tended to be shared,
         from frivolous command libraries to an irksomely strong
         Scrabble program by Mark Owen (MO101). Adventure
         games like this one were a traditional part of that shared
         culture, to which the Computing Service (or CS) turned a
         blind eye. Adventure had come to Cambridge early, in 1978, with
         both ~Dungeon~ (the early form of ~Zork~) and the original
         Crowther and Woods game ~Colossal Cave~ (also called ~Advent~)
         open to the public.^^";
  print "Most of the native games were designed by mathematicians
         (computing was, in early days in Cambridge, considered a branch
         of mathematics), using what was probably the world's first
         ~adventure design system~ open to public use: the
         c.1978-80 game assembler of Jonathan Thackray (JGT1)
         and David Seal (DJS6). Their elegant if sometimes demanding
         design language was abstract enough that it became possible
         to port some of the games to home microcomputers in the 1980s:
         some were sold by Acornsoft, for the BBC Micro
         (very much the local machine, manufactured by Acorn, a
         company almost wholly staffed by university computing people)
         and some subsequently by Topologika, for a variety of later
         1980s machines.^^";
  print "Phoenix closed for the last time in 1994.  The survival of the
         original source code for many of the games is owed to Jonathan
         Partington (JRP1),
         though we should also like to thank Charles Jardine (CJ10) of
         the present-day Computing Service, Brian Kerslake of Topologika
         and two keen historians of interactive fiction, Gunther Schmidl
         and Paul David Doherty.^^";
  print "The present game was mechanically translated from its original
         source code to Inform using a Perl script, also called ~Phoenix~,
         written by Graham Nelson (GAN10), who was greatly assisted by Adam Atkinson
         (AJFA1) for exhaustive testing and for tidying up small areas
         of damage to the original source code. The Perl script has been
         updated by David Kinder, who has been helped by advice and
         testing from Adam, and also by Richard Bos, who wrote detailed solutions
         to Acheton and BrandX (It was Richard's solution to Acheton
         which triggered the restarting of this project.), and by Craig Hudson,
         who solved Parc and Xeno.^^
         Our aim has been to restore and not to modernise or ~improve~
         the work: the original parser has been recreated and all textual
         responses are authentic.  Our only additions have been the
         following commands: ~inform~, producing this text; ~restore~,
         which allows saved games to be restored (the Phoenix originals
         instead asked about this at the start of each session of play);
         and ~script~, which allows the transcript of play to be written
         to a file.^^";
  print "Please report errors to Adam at "; style bold;
         print "ghira@@64mistral.co.uk"; style roman; print ", or by posting
         to the Usenet group "; style bold; print "rec.games.int-fiction";
         style roman; print ". Please do not report them to the original
         author of the game! We expect that a few glitches might remain.^^";
  print  "In the original games, words over five letters were truncated internally
         to the game, so if you find that for some reason the program seems
         unconvinced by, for example, 'mainbrace', try typing 'main brace' instead.
         This problem arises on only two occasions that we are currently aware of
         over all the Phoenix games put together, but this note appears in all games
         to avoid giving away which games have it.^^";
  print "Copyright in this game resides with the original author, who
         has kindly granted permission for this translation to circulate
         freely and be distributed on a non-profit-making basis.^^";
  print "--- AJFA1 and GAN10 (August 1999), and David Kinder (March 2011)]^^";
];

! -----------------------------------------------------------------------------
! Main loop
! -----------------------------------------------------------------------------

[ Main R R2 lastplace dp ws i forcelook previous_room move_fail run_pre x;
  print "^^Welcome to Adventure!^^";

#Ifdef DEBUGV;
  PHX_random(-100);  
#Endif;

  Game_Banner();

  InitialiseTree();
  BeginSubroutineNest(Welcome);
  lastplace = -1;
  do {
     .CycleStarts;

      R = Resolve(PLAYER); ! I.e., resolve (PLAYER)R
      start_of_command_room = R;
      if (forcelook || lastplace ~= R) {
          DescribeWith(R);
          if (lastplace ~= R) previous_room = lastplace;
          lastplace = R; forcelook = false;
      }

      if (R) give R attribute_1; ! I.e., visited

      for (::) {
          print "> ";
          buffer->0 = 120;
          parse->0 = 15;  ! Allow to split input into this many words
          ReadLine(buffer, parse);
          if (parse->1 == 0) jump IDUT;

          if (parse-->1 == 'restore') {
              @restore -> i;
              print "Restore attempt failed.^"; continue;
          }
          if (parse-->1 == 'inform') {
              Game_Info();
              continue;
          }
          if (parse-->1 == 'script') {
              @output_stream 2;
              print "Here begins a transcript of^"; Game_Banner();
              continue;
          }

#Ifdef DEBUGV;
          if (parse-->1 == '#//') { tr__m = 1 - tr__m; continue; }
          if (parse-->1 == '#vars') {
              Debug_Variables();
              print "TEXTVAR='"; PrintTextVar(); print "'^";
              Debug_Objs(Resolve(PLAYER), 0);
              continue;
          }
          if (parse-->1 == '#rng') {
              tr__rng = true;
              print "[RNG tracing on.]^";
              continue;
          }
          if (parse-->1 == '#switchrng') {
              RNG_TYPE = 3 - RNG_TYPE;
              print "[Switching to RNG model ", RNG_TYPE, ".]^";
              continue;
          }
          if (parse-->1 == '#on') {
              CommandsOnSub();
              continue;
          }
          if (parse-->1 == '#off') {
              CommandsOffSub();
              continue;
          }
          if (parse-->1 == '#play') {
              CommandsReadSub();
              continue;
          }
!          if (parse-->1 == '#go') {
!              for (i=1:i<=Roomnames-->0:i=i+1) {
!                  if (parse-->3 == Roomnames-->i) {
!                      move PLAYER to Roomnames-->(i+1);
!                      jump CycleStarts;
!                  }
!              }
!              print "#go: Can't find any such room!^";
!              continue;
!          }
!          if (parse-->1 == '#get') {
!              for (i=1:i<=Objnames-->0:i=i+1) {
!                  if (parse-->3 == Objnames-->i) {
!                      move Objnames-->(i+1) to PLAYER;
!                      print "#got^";
!                      jump CycleStarts;
!                  }
!              }
!              print "#get: Can't find any such object!^";
!              continue;
!          }

          !  Undo handling

          if ((parse-->1 == '#undo') && (parse->1==1)) {
              if (undo_flag==0) {
                  print "This interpreter is unfortunately unable to provide
                         the ability to ~undo~ commands.^";
                  jump CycleStarts;
              }
              if (undo_flag==1) jump UndoFailed;
              if (just_undone==1) {
                  print "You can't undo twice in a row.^";
                  jump CycleStarts;
              }
              @restore_undo -> i;
              if (i==0) {
                  .UndoFailed;
                      print "Failed.^";
              }
              jump CycleStarts;
          }
          @save_undo -> i;
          just_undone = 0;
          undo_flag = 2;
          if (i==-1) undo_flag = 0;
          if (i==0) undo_flag = 1;
          if (i==2)
          {   just_undone = 1;
              print "The previous command has been undone.^";
              jump CycleStarts;
          }
#Endif;
          
          run_pre = 1;
          if (parse->1 >= 2) SetSecondWordText(buffer, parse, 2);

          .ProcessText;
          for (i=0: i<8: i++) Word1_Slot-->i = 0;
          for (i=0: i<8: i++) Word2_Slot-->i = 0;
          ws = WordArraySlot(parse-->1);
          if (ws) for (i=0: i<8: i++) Word1_Slot-->i = ws-->i;
          if (ws == 0) jump IDUT;
          
          if (parse->1 >= 2) {
              ws = WordArraySlot(parse-->3);
              if (ws) for (i=0: i<8: i++) Word2_Slot-->i = ws-->i;
          }

          .ParseText;
          #Ifdef DEBUGV; if (tr__m) DebugPO(); #Endif;

          switch (Word1_Slot-->Meaning_LX) {
              IGNORE__RV: ;
              OBJECT__RV:
                  print "What do you want to do with the ";
                  print (address) parse-->1, "?^";
                  if (GetMoreInput(1) == 0) jump IDUT;
                  jump ProcessText;
              OBEY__RV: ;
              PRINT__RV: ;
              SAVE__RV: ;
              SAVEND__RV: ;
              RESTART__RV: ;
              FINISH__RV: ;
              MOVE__RV: ;
              NONE__RV: ;
              RETURN__RV: ;
              default: print "*** Invalid Meaning_LX ***^";
          }

          switch (Word1_Slot-->Second_LX) {
              0: ;
              MAY__RV: ;
              MUST__RV: if (parse->1 < 2) jump IDUT;
              CANT__RV: if (parse->1 >= 2) jump IDUT;
              REQUEST__RV:
                  if (parse->1 < 2) {
                      print (address) parse-->1, " ";
                      if (Word1_Slot-->Second2_LX == DIR__RV)
                          print "where?^";
                      else print "what?^";
                      if (GetMoreInput(2) == 0) jump IDUT;
                      jump ProcessText;
                  }
              default: print "*** Invalid second_LX ***^";
          }

          if (parse->1 >= 2) {
              #Ifdef DEBUGV; if (tr__m) DebugPO2(); #Endif;
              switch (Word1_Slot-->Second2_LX) {
                  REC__RV: if (Word2_Slot-->Meaning_LX == 0) jump IDUT;
                  ANY__RV: ;
                  DIR__RV:
                      if (MiscTest_W2DI() == false && MiscTest_W2RM() == false)
                          jump IDUT;
                  OBJ__RV: if (MiscTest_W2OB() == false) jump IDUT;
                  SPECIAL__RV:  if (MiscTest_W2SPX() == false) jump IDUT;
                  default: print "*** Invalid second2_LX ***^";
              }
          }

          if (Word1_Slot-->Meaning_LX == IGNORE__RV) {
              parse-->1 = parse-->3;
              parse-->3 = 0; parse->1 = 1;
              jump ProcessText;
          }

          jump AcceptCommand;

          .IDUT; print "I don't understand that!^";
      }

     .AcceptCommand;
      if (run_pre == 1) {
          BeginSubroutineNest(PreCommand);
          switch (Return_State & $7000) {
              RETRY__RV:
                  Word1_Slot-->Meaning_LX = Return_State & $f00;
                  Word1_Slot-->Second_LX = Return_State & $f0;
                  Word1_Slot-->Second2_LX = Return_State & $f;
                  run_pre = 0;
                  jump ParseText;
              DEST__RV: print "*** DEST occurred from precommand ***^";
              PASS__RV: print "*** Can't do PASS ***^";
              ABORT__RV: print "*** ABORT occurred from precommand ***^";
              LOOK__RV: forcelook = true;
              NEXTCOMM__RV: jump CycleStarts;
              LEAVE__RV: ;
          }
      }

      switch (Word1_Slot-->Meaning_LX) {
          IGNORE__RV:
              print "*** Can't do IGNORE__RV from here ***^";
          OBJECT__RV:
              print "*** Can't do OBJECT__RV from here ***^";
          OBEY__RV, PRINT__RV:
              BeginSubroutineNest(Word1_Slot-->Label_LX);
              switch (Return_State & $7000) {
                  RETRY__RV:
                      Word1_Slot-->Meaning_LX = Return_State & $f00;
                      Word1_Slot-->Second_LX = Return_State & $f0;
                      Word1_Slot-->Second2_LX = Return_State & $f;
                      run_pre = 0;
                      jump ParseText;
                  DEST__RV: print "*** DEST occurred from a non-exit ***^";
                  PASS__RV: print "*** Can't do PASS ***^";
                  LOOK__RV: forcelook = true;
                  NEXTCOMM__RV: jump CycleStarts;
                  ABORT__RV, LEAVE__RV: ;
              }
          SAVE__RV:
              @save -> R;
              switch (R) {
                  0: print "Save attempt failed.^"; jump CycleStarts;
                  1: print "Game saved.^"; jump CycleStarts;
                  2: print "Game restored.^"; jump CycleStarts;
              }
          SAVEND__RV:
              @save -> R;
              switch (R) {
                  0: print "Save attempt failed.^"; jump CycleStarts;
                  1: print "Game saved.^"; @quit;
                  2: print "Game restored.^"; jump CycleStarts;
              }
          RESTART__RV:
              @restart;
          FINISH__RV:
              @quit;
          MOVE__RV:
              if (Word1_Slot-->Direction_LX) {
                  dp = Word1_Slot-->Direction_LX;
                 .MovementMethod;
                  BeginSubroutineNest(MoveDir, dp);
                  switch(Pass_State & $7000) {
                      RETRY__RV:
!         print "Return RETRY resulted in pass state ", Pass_State, "^";
                          Word1_Slot-->Meaning_LX = Pass_State & $f00;
                          Word1_Slot-->Second_LX = Pass_State & $f0;
                          Word1_Slot-->Second2_LX = Pass_State & $f;
                          run_pre = 0;
                          jump ParseText;
                      LOOK__RV: forcelook = true;
                  }
              } else {
                  R2 = Resolve(Word1_Slot-->Reference_LX);
                  jump TryRoomMovement;
              }
          RETURN__RV:
              if (previous_room <= 0) print "You can't do that!^";
              else {
                  R2 = previous_room;
                  .TryRoomMovement;
                  #Ifdef DEBUGV;
                  if (tr__m)
                      print "*** Trying to move to room ", (name) R2, " ***^";
                  #Endif;
                  R = Resolve(PLAYER);
                  if (R2 == R) {
                      print "You're already there!^";
                      jump MovementTried;
                  }
                  move_fail = false;
                  if (R has attribute_2 || R2 hasnt attribute_1)
                      move_fail = true;
                  else {
                      ! Find an exit direction from R to R2
                      move_fail = true;
                      for (x=1:x<=DirectionLookup-->0:x++)
                          if (R provides DirectionLookup-->x
                              && (R.&(DirectionLookup-->x))-->0 == R2) {
                              dp = DirectionLookup-->x;
                              jump MovementMethod;
                          }                      
                  }
                  if (move_fail) {
                      if (Word1_Slot-->Meaning_LX == RETURN__RV)
                      print "I'm afraid I've forgotten how you got here!^";
                      else
                      print "I don't know how to get there!^";
                  }
                 .MovementTried;
              }
          NONE__RV:
              print "You can't do that!^";
          default:
              print "*** Invalid Meaning_LX value at action time ***^";
      }

      BeginSubroutineNest(PostCommand);
      switch (Return_State & $7000) {
          RETRY__RV:
              Word1_Slot-->Meaning_LX = Return_State & $f00;
              Word1_Slot-->Second_LX = Return_State & $f0;
              Word1_Slot-->Second2_LX = Return_State & $f;
              run_pre = 0;
              jump ParseText;
          DEST__RV: print "*** DEST occurred from postcommand ***^";
          PASS__RV: print "*** Can't do PASS ***^";
          ABORT__RV: print "*** ABORT occurred from postcommand ***^";
          LOOK__RV: forcelook = true;
          NEXTCOMM__RV: jump CycleStarts;
          LEAVE__RV: ;
      }


  } until (false);
];

! -----------------------------------------------------------------------------
! The random number generator
! -----------------------------------------------------------------------------

[ RandomNumber R;
  return PHX_random(R+1)-1;
];

[ PHX_random x result;
  if (x<0) { rng_seed = x; @random x -> result; }
  else {
      switch (RNG_TYPE) {
          0: result = random(x);
          1: result = (((rng_seed++)&$7fff)%x)+1;
          2: rng_seed = (rng_seed*7821 + 1) & $7fff;
             result = ((rng_seed/10) % x) + 1;
      }
#Ifdef DEBUGV;
      if (tr__rng) print "[Random [1...", x,"] with seed ", rng_seed,
          " and RNG type ", RNG_TYPE, ": result ",result, "]^";
#Endif;
      return result;
  }
];

! -----------------------------------------------------------------------------
! Debugging routines
! -----------------------------------------------------------------------------

Ifdef DEBUGV;

[ CommandsOnSub i;
  @output_stream 4; xcommsdir=1; i=PHX_random(-100);
  "[Command recording on. Random number generator made predictable.]";
];
[ CommandsOffSub;
  if (xcommsdir==1) @output_stream -4;
  xcommsdir=0;
  "[Command recording off.]"; ];
[ CommandsReadSub i;
  @input_stream 1; xcommsdir=2; i=PHX_random(-100);
  "[Replaying commands. Random number generator made predictable.]";
];

[ DebugPO;
   print "W1: "; DebugWordSlot(Word1_Slot);
];

[ DebugWordSlot X;
   switch (X-->Meaning_LX) {
       NONE__RV:  print "NONE";
       IGNORE__RV: print "IGNORE";
       OBJECT__RV: print "OBJECT";
       OBEY__RV:  print "OBEY";
       PRINT__RV:  print "PRINT";
       SAVE__RV:  print "SAVE";
       SAVEND__RV:  print "SAVEND";
       RESTART__RV:  print "RESTART";
       FINISH__RV:  print "FINISH";
       MOVE__RV:  print "MOVE";
       RETURN__RV:  print "RETURN";
       default: print "*** Invalid Meaning_LX ***^";
   }
   print " ";
          switch (X-->Second_LX) {
              MAY__RV: print "MAY";
              MUST__RV: print "MUST";
              CANT__RV: print "CANT";
              REQUEST__RV: print "REQUEST";
              0: ;
              default: print "*** Invalid second_LX ***^";
          }
   print " ";
          switch (X-->Second2_LX) {
              REC__RV: print "REC";
              ANY__RV: print "ANY";
              DIR__RV: print "DIR";
              OBJ__RV: print "OBJ";
              SPECIAL__RV: print "SPECIAL";
              0: ;
              default: print "*** Invalid second2_LX ***^";
          }
  print " Special:", X-->Special_LX;
  print " Direction:", X-->Direction_LX;
  print " Reference:", X-->Reference_LX;
  print "^";
];

[ DebugPO2;
  print "W2: "; PrintSecondWord();
  print " "; DebugWordSlot(Word2_Slot);  
];

[ Debug_Objs O depth d x flag;
  if (O == 0) return;
  for (d=depth:d>0:d--) print "  ";
  print (name) O;
  if (O.state) print " (state ", O.state, ")";
  for (x=0:x<47:x++) if (O has x) flag = true;
  if (flag) {
      print " (attributes:";
      for (x=0:x<47:x++) if (O has x) print " ", x;
      print ")";
  }
  new_line;
  objectloop (x in O) Debug_Objs(x, depth+1);
];

Endif;
! -----------------------------------------------------------------------------
Attribute workflag;
[ DebugAttribute x; print x;
];