! A minimal parser for use with Inform - doesn't accept multiple objects,
! and uses a different world model.
! If you want to use this file, just change or replace AboutSub
! and Version Sub.  You'll also probably want to change the abbreviations
! see hamhall.inf for how grammar/actions are added to locations.
Constant EQUIV 2;
Constant INCL 3;
Constant NOTURN 0;
Constant TURN 1;
Constant NULL -1; ! end grammar
Constant NOUN -2;
Constant THIS -3;
! to use negatives, z5 file must no exceed 128K, Z3 64K

#ifndef WORDSIZE;
Constant WORDSIZE 2;
#endif;
Constant CANTGO "There is no exit in that direction.";
Constant FAILED "[Failed.]";
Constant MULTIPLE "You can only do one thing at a time.";

system_file;

Property spec; !additive spec NULL;
Property autonomous NULL;
Property value 0;
Property activated;
Property deactivated;
Property properloc;
Attribute listed;
Attribute opaque;
Attribute portable;
Attribute surface;
Attribute handled;
Attribute solved;
Attribute barename;

Global location;            ! first global defined in V3
Global score;                       ! 2nd
Global turns;                       ! 3rd

Global first;  ! objects
Global second;
Global worderr;

Abbreviate ". "; Abbreviate ", "; Abbreviate " the "; Abbreviate "The";
Abbreviate "You"; Abbreviate "ing"; Abbreviate "and"; Abbreviate "you";
Abbreviate "Stoattrouser"; Abbreviate "..."; Abbreviate "This";
Abbreviate "tion"; Abbreviate "ther"; Abbreviate "are"; Abbreviate
"all"; Abbreviate "able"; Abbreviate "con"; Abbreviate "to be";
Abbreviate "house"; Abbreviate "er "; Abbreviate "e o"; Abbreviate "nd ";
Abbreviate "'s "; Abbreviate "is "; Abbreviate "ed "; Abbreviate "'t ";
Abbreviate "theast "; Abbreviate "an "; Abbreviate "ly "; Abbreviate
"to "; Abbreviate "rou"; Abbreviate "with "; Abbreviate "ent ";
Abbreviate "hat "; Abbreviate "es "; Abbreviate "ds "; Abbreviate "It ";
Abbreviate "e in "; Abbreviate "ll "; Abbreviate "entrance"; Abbreviate
"Lord "; Abbreviate "hou"; Abbreviate "ant "; Abbreviate "it ";
Abbreviate "they "; Abbreviate "looks "; Abbreviate "en "; Abbreviate
".~^"; Abbreviate "from"; Abbreviate "e p"; Abbreviate "room";
Abbreviate "al "; Abbreviate "as "; Abbreviate "seem"; Abbreviate " of";
Abbreviate "the"; Abbreviate "ous"; Abbreviate "one"; Abbreviate
"ountain"; Abbreviate "control"; Abbreviate "t i"; Abbreviate "for";
Abbreviate "Duke"; Abbreviate "have";

! abbreviations only save about 2K, never mind:

Array buffer string 66; ! add 2 or 3 extra bytes
Array obuf string 32;
Array parse ->
5 1
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0
0 0 0 0  ! extra line for safety with ZIP
;

Object Finished "Restart, restore, undo, or quit?"
with 
spec
INCL sysgram
NOTURN LookSub;

Object Death "You have ceased to be.^"
with description Finished;

Array sysgram -->
'restore' EQUIV 'load' NOTURN RestoreSub
'restart' NOTURN RestartSub
'undo' NOTURN UndoSub
'about' EQUIV 'info' EQUIV 'amusing' EQUIV 'credits' EQUIV 'disclaimer' NOTURN AboutSub
'hints' EQUIV 'help' NOTURN HintsSub
'version' NOTURN VersionSub
'score' NOTURN ScoreSub
'quit' NOTURN QuitSub
'q//' NOTURN "Type 'quit' to end."
NULL;

[ScoreSub; "Your score is ",score," out of, um... forty?  Yeah, let's say forty.";];

Array synonyms table
'w//' 'west' 
'e//' 'east' 
'n//' 'north' 
's//' 'south' 
'u//' 'up' 
'd//' 'down' 
'l//' 'look' 
'x//' 'examine'
'nw' 'northwest' 
'sw' 'southwest' 
'ne' 'northeast' 
'se' 'southeast'
'exit' 'out'
'outside' 'out'
'inside' 'in'
'get' 'take'
'pick' 'take'
'insert' 'drop'
'put' 'drop'
'kill' 'attack'
'hit' 'attack'
'enter' 'go'  
'read' 'examine'
'check' 'examine'
'for' 'about'
'off' 'from'
'on' 'in'
'onto' 'in'
'into' 'in'
'set' 'move'
'turn' 'move'
'call' 'dial'
'tell' 'ask'
'switch' 'move'
'script' 'transcript'
;

Array basegram -->
'west' NOTURN CANTGO
'east' NOTURN CANTGO
'north' NOTURN CANTGO
'south' NOTURN CANTGO
'northwest' NOTURN CANTGO
'southwest' NOTURN CANTGO
'northeast' NOTURN CANTGO
'southeast' NOTURN CANTGO
'up' NOTURN CANTGO
'down' NOTURN CANTGO
'in' NOTURN CANTGO
'out' NOTURN CANTGO
'xyzzy' TURN "Nothing happens."
'drop' NOUN 'in' NOUN TURN DropSub
'drop' NOUN TURN DropSub
'take' 'all' NOTURN MULTIPLE
'take' NOUN 'and' NOUN NOTURN MULTIPLE
'take' 'up' EQUIV 'take' NOUN TURN TakeSub

'open' EQUIV 'close' EQUIV 'kiss' EQUIV 'move'
     EQUIV 'push' EQUIV 'climb' EQUIV 'throw' NOUN NOTURN Nopoint1Sub
'eat' EQUIV 'sing' EQUIV 'swim' NOTURN "You don't know how."
'hit' EQUIV 'attack' EQUIV 'kill' NOUN NOTURN "Violence is not the answer."
'use' NOTURN "Please be more specific."
!"You are too small compared to the forces that make up this world."
'look' 'under' EQUIV 'look' 'behind' EQUIV 'touch' NOUN EQUIV 'smell' TURN "Nothing unusual."
NOUN ',//' EQUIV 'talk' NOTURN "Ask someone about something instead."
'stand' EQUIV 'sit' EQUIV 'lie' NOTURN "All right where you are, I think."
'look' 'at' EQUIV 'examine' EQUIV 'search' NOUN TURN ExamineSub
'look' 'in' NOUN TURN ExamineSub
'think' 'about' NOUN TURN ExamineSub
'listen' TURN "There is no sound of birdsong, and no wind.  It is completely, strangely, silent."
'fuck' EQUIV 'shit' EQUIV 'damn' EQUIV 'bugger' NOTURN
"DamnbuggerfrigshitsodfuckfuckFUCK FUCK!!^^I feel better, don't know about you."

'play' 'back' EQUIV 'playback' EQUIV 'replay' NOTURN ReplaySub
'transcript' 'from' NOTURN TranscriptOffSub
'transcript' NOTURN TranscriptOnSub
'save' NOTURN SaveSub
NULL;

[ DoSRA act;
  if (act==NULL) rtrue;
  if (metaclass(act)==String) print_ret (string) act;
  if (metaclass(act)==Routine) return act();
  else
  if (metaclass(act)==Object)
    move player to act;
  !else
  !indirect(#actions_table-->act);
  !new_line;
  ];

[ EndTurn  o;
  o=parent(player); while(parent(o)) o=parent(o);
  while (o) {
    if (o.autonomous ~=NULL) DoSRA(o.autonomous);
    if (child(o))
       o=child(o);
    else {
       while (o && sibling(o)==0) o=parent(o);
       if (o) (o=sibling(o));
       }
    }
  ];

Global itval = player;

[ ParseNoun wp  o wptr nptr len bestn mostw close;
  o=location;
  while (parent(o)) o=parent(o);  ! way of reproducing found_in and enterable
  while (o) {
    if (o==location) close=1;
    wptr=wp;
    len=o.#name/WORDSIZE;
    for (nptr=0: nptr<len && wptr<parse->1: nptr++)  ! could check if wptr<parse->1
       if (parse-->(wptr*2+1) == (o.&name-->nptr) or 'the' or 'a' or 'of'
            || (o==itval && parse-->(wptr*2+1) == 'it' or 'them') )
          wptr++;
    if (wptr>wp+mostw  && (close || o hasnt portable) ) {
       mostw=wptr-wp;
       bestn=o;
       }
    if (child(o) && (o hasnt opaque) )
       o=child(o);
    else 
       while (o) {
          if (o==location) close=0;
          if (sibling(o)) {o=sibling(o); break;}
          o=parent(o);
          }
    }
  if (first) second=bestn;
  else first=bestn;
  if (bestn) itval=bestn; else worderr=wp;
  return mostw;
];

[ Parsed obj wp   len i b m; ! go through grammar table & run
  len=1000; b=obj;
  if (metaclass(obj)==Object) {
    objectloop(i in obj && i ~= player)
      if (Parsed(i)) rtrue;
    if (~~obj provides spec) rfalse;
    b=obj.&spec;
    len=obj.#spec/ WORDSIZE;
    }

    i=0;
  	while (i < len) {
      if (~~wp) {
         first=0;
         second=0;
         }
  	  switch (b-->i) {
  	      EQUIV:
  	             if (wp>0) { ! we're matching already
  	                  i++; ! skip over the thing it's equivalent to
  	                  !parse-->(wp*2+1) =  b-->i; ! and make identical
  	                  }
  	             else wp=0; ! else start again
  	      INCL:
  	         i++; if (wp>=0) {
  	           if (Parsed(b-->i, wp)) rtrue; ! call recursively
  	           }
  	      NULL:
  	         rfalse;
  	      NOUN, THIS:
  	         if (wp>=0) {
  	            m=ParseNoun(wp);
  	            if (m && (b-->i==NOUN || itval==obj ) )
  	               wp=wp+m;
  	            else
  	               wp=-1;  ! nomatch
  	            }
  	      TURN, NOTURN:
  	         if (wp==-1)
  	            {wp=0; i++;} ! start afresh from next command
  	         else { ! a match, more or less
  	            if (b-->i==TURN) {
                   @save_undo m; if (m==2) {LookSub(); rtrue;}
  	               turns++;
  	               EndTurn();
                   }
  	            DoSRA(b-->(i+1));   ! perform the action
  	            rtrue; ! parsed
  	            }
  	      default:
            if (wp>=0 && parse-->(wp*2+1) == b-->i && wp<parse->1) {
  	           wp++;
  	  	       }
  	  	    else ! not matching part of this phrase
  	           wp=-1;
  	  	  } ! switch
  	  i++;
  	  } !while
  rfalse;
];

[ Play  nw i t m;
  ! user interface
  for (::) {
    while (location ~= parent(player)) {
       location=parent(player);
       LookSub();
       }
  	print "^> "; 
  	DrawStatusLine(); worderr=0;
    for (i=2: i<2+buffer->1: i++) ! dealing with multiple commands on one line?
      if (buffer->i == '.' or ',') {
         i--;
         buffer->1=buffer->1-i;
         for (t=2: t<2+buffer->1: t++)  !move buffer down
            buffer->t = buffer->(t+i);

         @tokenise buffer parse;
         print "...^";
         jump NextCommand;
         }
  	KeyboardPrimitive();
    .NextCommand;
 	nw=parse->1; first=0;
    for (i=0: i<nw: i++)
      for (t=1: t<synonyms-->0: t=t+2)
        if (parse-->(i*2+1)==synonyms-->t)
          parse-->(i*2+1) = synonyms-->(t+1);
  	if (~~(Parsed(location) || Parsed(player))) {  ! Parsed() does everything
  	  t=0;
      for (i=0: i<nw: i++)
        if (~~ parse-->(i*2+1)) {
          print "[The word ~";
          t=parse->(i*4+5); m=parse->(i*4+4)+t;

          for (: t<m: t++)
            print (char) buffer->t;
          print "~ is not necessary in this story.]^"; break;
          }
      if (nw && ~~t)
        if (worderr && worderr<nw) print "You can't see that here.^";
        else print "Please check and rephrase that.^"; !You can't do that here / That was not understood
      }
  	}
  ];

[ VersionSub i;
  print "HARRINGTON HALL^";
  print "An Interactive Nano-Epic by CK^";
  print "Release ";
  for (i=18:i<24:i++) print (char) 0->i;
  print " Inform v"; inversion;
  print "^Please read the DISCLAIMER.^";
  ];

[ Main i;
  for (i=12+3*(0->30==6 && 0->31=='F'):i<0->32:i++) new_line;
  VersionSub(); new_line;
  Play();
  ];

[ DrawStatusLine   width posa;
   @split_window 1;
   @set_window 1; @set_cursor 1 1;
   width = 0->33; posa = width-24; 
   style reverse;
   spaces width;
   @set_cursor 1 2;
   print (name) location;
   if (width > 40)
       {   @set_cursor 1 posa; print "Score ", score,
           "   Moves ", turns; 
       }

   style roman; 
   @set_cursor 1 1; @set_window 0;
];

[QuitSub; print "Bye!^"; @quit;];

[SaveSub;
  save OK;
  print_ret (string) FAILED;
  .OK;
  "[OK]";];

[RestoreSub;
  restore OK;
  print_ret (string) FAILED;
  .OK;
  new_line;
  ];

[UndoSub i;
  if (~~turns) rfalse;
  @restore_undo i;
  if (~~i) print_ret (string) FAILED;
  ];

[RestartSub;
  @restart;
  ];

[ReplaySub;
  @input_stream 1;
  ];

[TranscriptOnSub;
  @output_stream 2;
  VersionSub();
  ];

[TranscriptOffSub;
  @output_stream -2;
  ];

[List p all sup   o t i;
   if (~~sup) t = List(p, all, 1);
   objectloop (o in p) if (all || o has listed) {
     if (~~sup) {
        if (i && i+1==t) print " and ";
        else if (i) print ", ";
        print (a) o;
        }
     i++;
     }
   return i;
   ];

[InvSub; print "You are carrying ";
   if (~~List(player, 0)) print "nothing";  !,1 lists invisibles
   ".";
   ];

[LookSub;
  print (name) location,"^";  ! first newline kind of optional, not in Infocom
  if (location hasnt handled && location provides value) score=score+location.value; give location handled;
  if (location provides description) DoSRA (location.description);
  if (List(location,0,1)) {
     print "^You can see ";
     List(location);
     " here.";
     }     
  ];

[ExamineSub n;
  if (first provides description) DoSRA (first.description);
  else print "Just an ordinary ", (name) first,".^";
  n=List(first,0,1);
  if (n && first has surface) {
     print "^On it "; if (n==1) print "is "; else print "are ";
     List(first);
     ".";
     }
  ];

[TakeSub;
  if (first hasnt portable) "You can't take ", (the) first,".";
  if (first hasnt handled && first provides value) score=score+first.value; give first handled; give first listed;
  print "You take ",(the) first;
  if (parent(first)~=location or player) print " from ", (the) parent(first);
  move first to player;
  ".";
  ];

[DropSub;
  if (first notin player) "You don't have it.";
  if (~~(second && second has surface)) second=location;
  move first to second;
  print "Deposited";if (second==location) print " on floor";".";
  ];

[AboutSub;
  "This is an entry in Ben Caplan's Minigames minicomp.  Coding was begun properly
  two days before the deadline, and is mostly untested.  The unusual transcript-related functions may
  result in interpreter crashes or a high processor load.  I accept no liability for anything this file might to do
  your system; it is supplied as freeware without warranty.  Thanks to Graham Nelson for the much-abused Inform.^^
  Further disclaimer: this version is not as bad as that of 1 June, thanks to beta testing by Harry Hol and J. D. Berry,
  but it being Not Much Fun and Very Confusing is down to me.";
  ];

[Nopoint1Sub; "You don't need to do that to ",(the) first,".";];

[HintsSub;
  "Some characters will give hints under the right conditions.  A walkthrough is available in a separate file.  For program information
  type INFO.";
  ];

[ Indefart o; 
  @output_stream 3 obuf;
  PrintShortName (o);
  @output_stream -3;
  if ((obuf->2 | 32) == 'a' or 'e' or 'i' or 'o' or 'u') print "an "; else
  if (o hasnt barename) print "a ";
  PrintShortName (o);
];

[ Capitalize s  i; 
  @output_stream 3 obuf;
  print (string) s;
  @output_stream -3;
  if (obuf->2<'A') print (char) obuf->2; else print (char) obuf->2 &$5F;
  for (i=3: i<2+obuf-->0: i++) print (char) obuf->i;
];

[ NString s; 
  @output_stream 3 obuf;
  print (string) s;
  @output_stream -3;
  if ((obuf->2 | 32) == 'a' or 'e' or 'i' or 'o' or 'u') print "n"; print " ";
  print (string) s;
];

[ Defart o;
  if (o hasnt barename) print "the ";
  PrintShortName (o);
];

[ PrintShortName o;
  if (o provides shortname && DoSRA(o.shortname));
    else
  @print_obj o;
];