! QPrint
! Mid-string rule printing system.
!  Dave Robinson
!  khelwood at hotmail dot com
! version 1: 17-03-2005

! Rules are inserted into strings using % as an escape character.
!  For instance,
!   QPrint("You take %the 1% and put %it 1% into %the 2%.",obj1,obj2);
!   is equivalent to
!   print "You take ",(the) obj1," and put ", (itorthem) obj1,
!      " into ",(the) obj2,".";
!  The number 1 to 6 indicated which argument to use.
!  For instance,
!   QPrint("%The 1%,x,y,z);
!  translates to print (The) x;
!   whereas
!   QPrint("%The 3%",x,y,z);
!  translates to print (The) z;
! You can also use "noun" and "second" as argument indicators.
!  For instance
!   QPrint("You cannot take %the noun%.");
!   or
!   QPrint("You put %the n% into %the s%.");
!  n is short for "noun"
!  s is short for "second"
!  a is short for "actor"

! Use examples:
!  QPrint("You take %t n% and put %it n% in your pocket.");
!  QPrint("%T n% %is n% too large to carry.");
!  QPrint("You put %t 1% into %t 2%.", obj1, obj2);
!  QPrint("There %is 1% %a 1% here.", x);

! Command list:
!  ROUTINE:
!   QPrint(" ... %f 1 2% ... ", rout, arg);
!   This command calls function rout with argument arg.
!  ADDRESS: goes like print (address) ...
!   QPrint("The verb_word is '%addr 1%'.", verb_word);
!   The figure 1 in the command means "first argument",
!   in this case, verb_word.
!  STRING: goes like print (string) ...
!   QPrint("The string says ~%str 1%~.", "Hello there");
!  CHAR: goes like print (char) ...
!   QPrint("The character is %ch 1%.", 'X');
!  NUMBER: goes like print n;
!   QPrint("The number is %num 1%.", n);
!  OBJECT: goes like print (object) ...
!   QPrint("The object's object-name is %obj 1%.", obj);
!  NAME: goes like print (name) ...
!   QPrint("The object's short name is %name 1%.", obj);
!  THE: goes like print (the) ... or print (The) ...
!   QPrint("You open %the 1%.", noun);
!   or equivalently
!   QPrint("You open %the noun%.");
!   or
!   QPrint("You open %t n%.");
!   t is short for "the" and n is short for "noun".
!   If the t is capitalised, then the printing rule (The) is used.
!   e.g. QPrint("%The 1% is open.",noun);
!   or   QPrint("%T n% is open.");
!  A: goes like print (a) noun
!   QPrint("You can see %a 1% here.", obj);
!  GEN: goes like print (the) x, "'s";
!   QPrint("%Gen 1% eyes are open.", person);
!   Basically, this prints
!    "Your" (or "your") if person==player
!    (The) person,"'s"  otherwise
!  HE: Nominative pronoun
!   QPrint("%He 1% explodes.", obj);
!   prints "You" or "He" or "They" &c.
!   If the h in %he is lower case, then
!   prints "you" or "he" or "they" &c.
!  HIM: Accusative pronoun
!   QPrint("You hug %him 1%.", obj);
!   prints "you" or "her" or "them" &c.
!  HIS: Genitive pronoun
!   QPrint("You take %his 1% pulse.", obj);
!   prints "your" or "his" or "their" &c.
!   if the h in %his is upper case then
!   prints "Your" or "His" or "Their" &c.
!  HERS:
!   QPrint("That isn't %hers 1%.", obj);
!   prints "yours" or "hers" or "theirs" &c.
!  SELF:
!   %self 1%
!   prints "yourself" or "herself" or "themselves" &c.
!  THAT:
!   %That 1%
!   prints "You" or "He" or "That" or "Those" &c.
!   %that 1%
!   prints "you" or "he" or "that" or "those" &c.
!  THATS:
!   %Thats 1%
!   prints "You're" or "She's" or "That's" or "Those are"
!   also works with lower case
!  THATSNOT:
!   %Thatsnot 1%
!   prints "You're not" or "Those aren't" &c.
!   also works with lower case
!  HES:
!   %Hes 1%
!   prints "You're" or "He's" or "They're" &c.
!   also works with lower case
!  IS:
!   QPrint("%The 1% %is 1% here.", obj);
!   prints "are" if obj is player or plural
!   prints "is" otherwise
!  HAS:
!   QPrint("The 1% %has 1% no windows.", obj);
!   prints "have" if obj is player or plural
!   prints "has" otherwise
!  DOES:
!   QPrint("%The 1% %do 1%n't reply.", obj);
!   prints "does" or "do"
!  S:
!   QPrint("%The 1% look%s 1% around.", obj);
!   prints "s" or nothing.
!   The command above may print
!   "You look around" or "Bob looks around" &c.
!  ES:
!   QPrint("The 1% focus%es 1% the telescope.", obj);
!   prints "es" or nothing.
!   The command above may print
!   "You focus the telescope" or "Bob focuses the telescope" &c.
!  INORON:
!   %in 1% or %on 1% or %In 1% or %On 1%
!   if the argument is a supporter, prints "on" or "On"
!   otherwise prints "in" or "In"
!  INORONTHE:
!   Equivalent to %in followed by %the.
!  OFFOROUTOF:
!   %off 1%
!   if the argument is a supporter prints "off"
!   otherwise prints "out of"
!  IF:
!   %if X rule Y%
!   where X indicates an argument that is considered as
!    a boolean,
!   rule indicates any rule listed here,
!   Y indicates the arguments for the rule.
!   So, for instance,
!   QPrint("%if 1 the 2%", fl, obj);
!   is equivalent to
!   if (fl) print (the) obj;
!  IFNOT:
!   %if~ X rule Y%
!   this works as above but "not"s the boolean argument.
!  QUESTION:
!   %? 1 txt1#txt2%
!   If the boolean is true, prints txt1, otherwise
!   prints txt2.
!   For instance
!  QPrint("The apple is %? 1 rotten#ripe%.", fl);
!   will print "The apple is rotten."
!   or "The apple is ripe."
!   depending on fl.
!  EMPH:
!   %emph%, e.g. QPrint("%emph%This sentence in italics.%roman%.");
!   or
!   %emph txt%, e.g. QPrint("One word is in %emph italics%.");
!  BOLD:
!   As emph but with bold instead of italics.
!  ROMAN:
!   Switches style to roman.
!  THEIS:
!   Equivalent to %the followed by %is.
!   e.g.
!   QPrint("%Theis 1% open.", obj);
!   or
!   QPrint("%Tis 1% open.", obj);
!   (where T is short for The).
!   This also works with lower case.
!  HEIS:
!   %Heis 1%
!   Equivalent to %He followed by %is.
!   Also works with lower case.
!  WAS:
!   %was 1%
!   prints "was" or "were"
!  THEWAS:
!   %Twas 1%
!   equivalent to %The followed by %was
!   Also works with lower case.
!  THATWAS
!   %Thatwas 1%
!   equivalent to %That followed by %was
!   Also works with lower case.
!  OFFTHE:
!   %offthe 1%
!   equivalent to %off followed by %the
!  HEWAS:
!   %hewas 1%
!   equivalent to %he followed by %was
!  IFSPACE:
!   %if_ 1 rule 2%
!   if followed by a space if argument 1 is true.
!  SPACEIF:
!   %_if 1 rule 2%
!   if preceded by a space if argument 1 is true.

! The routine QPR works the same as QPrint but prints
!  a new-line at the end.

System_file;

#IfNDef QPrint;

Array QPArg --> 6;
Constant MAX_QPRINT_LENGTH = 253;
#IfDef TARGET_GLULX;
Constant QP_POS_INDEX = MAX_QPRINT_LENGTH;
Array QPchar -> (MAX_QPRINT_LENGTH+1);
#IfNot;
Constant QP_POS_INDEX = MAX_QPRINT_LENGTH+2;
Array QPchar string (MAX_QPRINT_LENGTH+2);
#EndIf;
Constant QP_esc_ch = '%';
Constant QP_sep_ch = '#';

Constant QP_CAPS     = $8000; ! (-32768 - largest bit in ZCode)
Constant QP_ROUTINE  =  1; ! up to 4 parameters
Constant QP_ADDRESS  =  2; ! 1 parameter
Constant QP_STRING   =  3; ! 1
Constant QP_CHAR     =  4; ! 1
Constant QP_NUMBER   =  5; ! 1
Constant QP_OBJECT   =  6; ! 1
Constant QP_NAME     =  7; ! 2
Constant QP_THE      =  8; ! 2
Constant QP_THEACC   =  9; ! 2
Constant QP_A        = 10; ! 2
Constant QP_GEN      = 11; ! 2
Constant QP_HE       = 12; ! 1
Constant QP_HIM      = 13; ! 1
Constant QP_HIS      = 14; ! 1
Constant QP_HERS     = 15;
Constant QP_SELF     = 16; ! 1
Constant QP_THAT     = 17; ! 1
Constant QP_THATACC  = 18; ! 1
Constant QP_THATS    = 19; ! 1
Constant QP_THATSNOT = 20; ! 1
Constant QP_HES      = 21;
Constant QP_IS       = 22; ! 1
Constant QP_HAS      = 23; ! 1
Constant QP_DOES     = 24; ! 1
Constant QP_S        = 25; ! 1
Constant QP_ES       = 26; ! 1
Constant QP_INORON   = 27; ! 1
Constant QP_OFFOROUTOF = 28;
Constant QP_INORONTHE= 29; ! 1
Constant QP_IF       = 30;
Constant QP_IFNOT    = 31;
Constant QP_IFSTRING = 32;
Constant QP_QUESTION = 33;
Constant QP_EMPH     = 34;
Constant QP_BOLD     = 35;
Constant QP_ROMAN    = 36;
Constant QP_THEIS    = 37;
Constant QP_HEIS     = 38;
Constant QP_WAS      = 39;
Constant QP_THEWAS   = 40;
Constant QP_THATWAS  = 41;
Constant QP_OFFTHE   = 42;
Constant QP_HEWAS    = 43;
Constant QP_IFSPACE  = 44;
Constant QP_SPACEIF  = 45;

[ QPrint txt p1 p2 p3 f l i  t m bfl;
   QPArg-->0 = p1;
   QPArg-->1 = p2;
   QPArg-->2 = p3;
   QPArg-->3 = f;
   QPArg-->4 = l;
   QPArg-->5 = i;
   t = MAX_QPRINT_LENGTH;
#ifdef TARGET_GLULX;
   l = PrintAnyToArray(QPchar,MAX_QPRINT_LENGTH,txt);
#ifnot; ! TARGET_ZCODE
   @storew QPchar 0 t;
   @output_stream 3 QPchar;
   if (txt ofclass String)
      print (string) txt;
   else if (txt ofclass Routine)
      txt.call();
   else txt();
   @output_stream -3;
   l = QPchar-->0; ! l == length of txt
#endif; ! TARGET_
   if (l>MAX_QPRINT_LENGTH)
   {
      print "^[Exceeded size for QPrint text on^ ~";
      switch (metaclass(txt))
      {
	String: print (string) txt;
	Routine: txt();
      }
      "~^ which is ",l," characters long.]^";
   }
#IfDef TARGET_GLULX;
   i = 0;
#IfNot; ! TARGET_ZCODE
   i = 2; l = l + 2;
#EndIf; ! TARGET_

!   print "[qprinting ~",(string)txt,"~^~";
!   for (: i<l: i++)
!   {
!      print (char) (QPchar->i);
!   }
!   if (WORDSIZE==2) i = 2; else i = 0;
!   print "~^]";

   for (: i < l: i++) if (QPchar->i==QP_esc_ch)
   {
      i++;
      if (QPchar->i==QP_esc_ch) { print (char) QP_esc_ch;  continue; }
!      print (char)'<';
      QPchar->QP_POS_INDEX = i; ! store pos at end of array
      bfl = 0;
      t = QPType();
      !print "[pos is ",QPchar->MAX_QPRINT_LENGTH," ('",
!	  (char) (QPchar->(QPchar->MAX_QPRINT_LENGTH)),"')]";
      f = (t&QP_CAPS);
      t = (t &~QP_CAPS);
      if (t==QP_IF) bfl = 1;
      if (t==QP_IFNOT) bfl = 2;
      if (t==QP_IFSPACE) bfl = 3;
      if (t==QP_SPACEIF) bfl = 4;
      if (bfl)
      {
	 i = QPParam();
	 (QPchar->QP_POS_INDEX)++;
	 t = QPType();
	 f = (t&QP_CAPS);
	 t = (t&~QP_CAPS);
	 switch (bfl)
	 {
	   1: if (i==0) bfl = 1; else bfl = 0;
	   2: if (i) bfl = 1;    else bfl = 0;
	   3: if (i==0) bfl = 1; else bfl = 2; !print with space
	   4: if (i==0) bfl = 1;
	      else { print (char)' '; bfl = 0; }
	 }
 	 !bfl==1 means "do not print"
      }
      if (t==0)
      {
	 i = QPchar->QP_POS_INDEX;
	 print "[ QPrint failed at index ",i,": '",
 	     (char) (QPchar->i),"']^";
	 while (i<l && QPchar->i~=QP_esc_ch) i++;
	 continue;
      }

      p1 = 0; p2 = 0; p3 = 0; i = 0;
      ! Set m to number of args required
      m = 1;
      if (t==QP_ROUTINE) m = 4;
      if (t==QP_EMPH or QP_BOLD or QP_ROMAN) m = 0;
      if (t==QP_NAME or QP_THE or QP_THEACC or QP_A or QP_GEN
	  or QP_THEIS or QP_THATACC or QP_THEWAS) m = 2;
      if (t==QP_IFSTRING) m = 3;
      
      if (m>0) p1 = QPParam(); !(1+QPchar->MAX_QPRINT_LENGTH);
!      print "[pos is ",QPchar->MAX_QPRINT_LENGTH," ('",
!	  (char) (QPchar->(QPchar->MAX_QPRINT_LENGTH)),"')]";
      if (m>1) p2 = QPParam(); !(1+QPchar->MAX_QPRINT_LENGTH);
      if (m>2) p3 = QPParam(); !(1+QPchar->MAX_QPRINT_LENGTH);
      if (m>3) i  = QPParam(); !(1+QPchar->MAX_QPRINT_LENGTH);
      
      if (p1==p2) switch (t)
      {
	QP_NAME, QP_THE: t = QP_HE;
	QP_THEACC, QP_A, QP_THATACC: t = QP_SELF;
	QP_GEN:          t = QP_HIS;
	QP_THEIS:        t = QP_HEIS;
	QP_THEWAS:       t = QP_HEWAS;
      }

      if (bfl~=1) QPrintType(t,p1,p2,p3,i,f);
      if (bfl==2) print (char)' ';

      i = QPchar->QP_POS_INDEX;

    }
    else print (char) (QPchar->i);
];

[ QPrintType t p1 p2 p3 p4 f sp;
   sp = 0;

#IfDef USE_PERSON1;
  #IfDef Person1;
   sp = Person1;
  #IfNot;
   sp = player;
  #EndIf;
   if (sp~=p1) sp = 0;
   if (sp && t==QP_A && f) t = QP_THE;
   if (sp) switch (t)
   {
     QP_NAME, QP_THE, QP_HE, QP_THAT: print (char) 'I';
     QP_THEACC, QP_A, QP_HIM, QP_THATACC:
        if (f) print "Me"; else print "me";
     QP_GEN, QP_HIS: if (f) print "My"; else print "my";
     QP_HERS: print "mine";
     QP_SELF: print "myself";
     QP_THATS, QP_HES: print "I'm";
     QP_THATSNOT: print "I'm not";
     QP_IS: print "am";
     QP_HAS: print "have";
     QP_DOES: print "do";
     QP_S,QP_ES:
     QP_THEIS, QP_HEIS: print "I am";
     QP_WAS: if (f) print "Was"; else print "was";
     QP_THEWAS, QP_THATWAS, QP_HEWAS: print "I was";
     default: sp = 0;
   }
   if (sp) return;
#EndIf;

#IfDef Person2;
   sp = person2;
#ifnot;
   sp = player;
#endif;
   if (sp && sp==p1) sp = true;
   else sp = false;

   if (sp) switch (t)
   {
     QP_NAME, QP_THE, QP_HE, QP_THAT, QP_THEACC, QP_A, QP_HIM, QP_THATACC:
      if (f) print "You"; else  print "you";
     QP_GEN, QP_HIS: if (f) print "Your"; else print "your";
     QP_HERS: print "mine";
     QP_SELF: print "yourself";
     QP_THATS, QP_HES: if (f) print "You're"; else print "you're";
     QP_THATSNOT: if (f) print "You're not"; else print "you're not";
     QP_IS: print "are";
     QP_HAS: print "have";
     QP_DOES: print "do";
     QP_S, QP_ES:
     QP_THEIS, QP_HEIS: if (f) print "You are"; else print "you are";
     QP_WAS: if (f) print "Were"; else print "were";
     QP_THEWAS, QP_THATWAS, QP_HEWAS:
      if (f) print "You were"; else print "you were";
     default: sp = false;
   }
   if (sp) return;

   switch (t)
   {
     QP_ROUTINE: p1.call(p2,p3,p4);
     QP_ADDRESS: print (address) p1;
     QP_STRING:  print (string) p1;
     QP_CHAR:    print (char) p1;
     QP_NUMBER:  print p1;
      
     QP_NAME: print (name) p1;
     QP_THE, QP_THEACC: if (f) print (The) p1; else print (the) p1;
     QP_A: if (f) print (A) p1; else print (a) p1;
     QP_GEN:
      if (f) print (The) p1;
      else print (the) p1;
      ! slightly dodgy, this
      print (char)''';
      if (p1 hasnt pluralname) print (char)'s';
     QP_HE:
      if (f)
      {  if (p1 has pluralname) print "They";
         else if (p1 has female) print "She";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "He";
	 else print "It";
      } else {
	 if (p1 has pluralname) print "they";
	 else if (p1 has female) print "she";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "he";
	 else print "it";
      }
     QP_HIM: if (p1 has pluralname) print "them";
	 else if (p1 has female) print "her";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "him";
	 else print "it";
     QP_HIS: if (f)
      {  if (p1 has pluralname) print "Their";
          else if (p1 has female) print "Her";
	  else if (p1 has male || p1 has animate && p1 hasnt neuter)
	     print "His";
	  else print "Its";
      } else {
	 if (p1 has pluralname) print "their";
	  else if (p1 has female) print "her";
	  else if (p1 has male || p1 has animate && p1 hasnt neuter)
	     print "his";
	  else print "its";
      }
     QP_HERS: if (p1 has pluralname) print "theirs";
	 else if (p1 has female) print "hers";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "his";
	 else print "its";
     QP_SELF: if (p1 has pluralname) print "themselves";
	 else if (p1 has female) print "herself";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "himself";
	 else print "itself";
     QP_THAT: if (f)
      {  if (p1 has pluralname) print "Those";
	 else if (p1 has female) print "She";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "He";
	 else  print "That";
      } else {
	 if (p1 has pluralname) print "those";
	 else if (p1 has female) print "she";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "he";
	 else  print "that";
      }
     QP_THATACC:
      if (p1 has pluralname) print "those";
      else if (p1 has female) print "her";
      else if (p1 has male || p1 has animate && p1 hasnt neuter)
	 print "him";
      else  print "that";
     QP_THATS: if (f)
      {  if (p1 has pluralname) print "Those are";
         else if (p1 has female) print "She's";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "He's";
	 else  print "That's";
      } else {
	 if (p1 has pluralname) print "those are";
	 else if (p1 has female) print "she's";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "he's";
	 else  print "that's";
      }
     QP_THATSNOT: if (f)
      {  if (p1 has pluralname) print "Those aren't";
	 else if (p1 has female) print "She's not";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "He's not";
	 else  print "That's not";
      } else {
	 if (p1 has pluralname) print "those aren't";
	 else if (p1 has female) print "she's not";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "he's not";
	 else  print "that's not";
      }
     QP_HES: if (f)
      {  if (p1 has pluralname) print "They're";
	 else if (p1 has female) print "She's";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "He's";
	 else  print "It's";
      } else {
	 if (p1 has pluralname) print "they're";
	 else if (p1 has female) print "she's";
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	    print "he's";
	 else  print "it's";
      }
     QP_IS: if (p1 has pluralname) print "are";
       else print "is";
     QP_HAS: if (p1 has pluralname) print "have";
       else print "has";
     QP_DOES: if (p1 has pluralname) print "do";
       else print "does";
     QP_S: if (p1 hasnt pluralname) print (char)'s';
     QP_ES: if (p1 hasnt pluralname) print "es";
     QP_INORON: if (p1 has supporter)
       { if (f) print "On"; else print "on"; }
       else if (f) print "In"; else print "in";
     QP_OFFOROUTOF: if (p1 has supporter) print "off";
       else print "out of";
     QP_INORONTHE: if (p1 has supporter)
       { if (f) print "On "; else print "on "; }
       else if (f) print "In "; else print "in ";
       print (the) p1;
     QP_IFSTRING: if (p1) { if (p2) print (string) p2; }
       else if (p3) print (string) p3;
     QP_QUESTION:
      QPoutnext1(p1);
      QPoutnext(p1);
     QP_EMPH: style underline;
      if (QPoutnext()) style roman;
     QP_BOLD: style bold;
      if (QPoutnext()) style roman;
     QP_ROMAN: style roman;
      QPoutnext();
     QP_THEIS: 
      if (f) print (The) p1; else print (the) p1;
      if (p1 has pluralname) print (string) ARE__TX;
      else print (string) IS__TX;
     QP_HEIS:
      if (p1 has pluralname)
      { if (f) print "They"; else print "they"; }
      else if (p1 has female)
      { if (f) print "She"; else print "she"; }
      else if (p1 has male || p1 has animate && p1 hasnt neuter)
      { if (f) print "He"; else print "he"; }
      else if (f) print "It"; else print "it";
      if (p1 has pluralname) print (string) ARE__TX;
      else print (string) IS__TX;
     QP_WAS:
      if (p1 has pluralname) print "were";
      else print "was";
     QP_THEWAS:
      if (f) print (The) p1; else print (the) p1;
      if (p1 has pluralname) print " were";
      else print " was";
     QP_THATWAS:
      if (p1 has pluralname)
      { if (f) print "Those were"; else print "those were"; }
      else
      { if (p1 has female)
        { if (f) print "She"; else print "she"; }
        else if (p1 has male || p1 has animate && p1 hasnt neuter)
        { if (f) print "He"; else print "he"; }
        else if (f) print "That"; else print "that";
	print " was";
      }
     QP_OFFTHE:
      if (p1 has supporter)
      { if (f) print "Off "; else print "off "; }
      else if (f) print "Out of "; else print "out of ";
      print (the) p1;
     QP_HEWAS:
      if (p1 has pluralname)
      { if (f) print "They were"; else print "they were"; }
      else
      {  if (p1 has female)
         { if (f) print "She"; else print "she"; }
	 else if (p1 has male || p1 has animate && p1 hasnt neuter)
	 { if (f) print "He"; else print "he"; }
	 else if (f) print "It"; else print "it";
	 print " was";
      }
   }
];

[ QPrintRet txt p1 p2 p3 p4 p5 p6;
   QPrint(txt,p1,p2,p3,p4,p5,p6);
   new_line;
   rtrue;
];
! alias for QPrintRet
[ QPR txt p1 p2 p3 p4 p5 p6;
   QPrint(txt,p1,p2,p3,p4,p5,p6);
   new_line;
   rtrue;
];

[ QPType pos tl l c fl;
   pos = QPchar->QP_POS_INDEX; ! pos = cur position
   if (QPchar->pos==QP_esc_ch) rfalse;
   tl = 2 + QPchar-->0; ! tl = total length
   l = pos; ! l starts at cur position
   while (l<tl && QPchar->l~=' ' or QP_esc_ch) l++;
   QPchar->QP_POS_INDEX = l;
   l = l - pos; ! l == length of tag to read
   if (l<1) rfalse;
   pos = pos + QPchar; ! pos == array starting at position
   c = pos->0;
   if (c>='A' && c<='Z')
   {
      fl = QP_CAPS;
      c = c+'a'-'A';
   }
   else fl = 0;
   if (l==1) ! t (the), s (-s), f (function), a (indef art),
      ! ? (quick if construct)
   {
      switch (c)
      {
	'a': return fl|QP_A;
	's': return fl|QP_S;
	'f': return fl|QP_ROUTINE;
	't': return fl|QP_THE;
	'?': return QP_QUESTION;
      }
      rfalse;
   }
   if (l==2) ! an (indef art), ch(ar), do, es (-es),
     ! he (nominative pronoun), is, in / on, It (nom pronoun),
     ! it (acc pronoun), if (if construct)
   {
      switch (c)
      {
	'a': if (pos->1=='n') return fl|QP_A;
	'c': if (pos->1=='h') return fl|QP_CHAR;
	'd': if (pos->1=='o') return fl|QP_DOES;
	'e': if (pos->1=='s') return fl|QP_ES;
	'h': if (pos->1=='e') return fl|QP_HE;
	'i': if (pos->1=='s') return fl|QP_IS;
	 if (pos->1=='n') return fl|QP_INORON;
	 if (pos->1=='t')
	 {
	    if (fl) return QP_CAPS|QP_HE;
	    return QP_HIM; ! note this
	 }
	 if (pos->1=='f') return fl|QP_IF;
	'o': if (pos->1=='n') return fl|QP_INORON;
      }
      rfalse;
   }
   if (l==3)
      ! are, gen(itive), has, him/her (acc pronoun),
      !  his (gen pronoun), hes (he's, she's, it's, they're),
      !  if~ (ifnot), ifs (ifstring), off, obj, num(ber), str(ing),
      !  she, the, was, tis (the is), if_ (if,space)
   {
      switch (c)
      {
	'a': if (pos->1=='r' && pos->2=='e') return fl|QP_IS;
	'g': if (pos->1=='e' && pos->2=='n') return fl|QP_GEN;
	'h': if (pos->1=='a' && pos->2=='s') return fl|QP_HAS;
	 if (pos->1=='i')
	 {
	    if (pos->2=='m') return fl|QP_HIM;
	    if (pos->2=='s') return fl|QP_HIS;
	 }
	 if (pos->1=='e')
	 {
	    if (pos->2=='r') return fl|QP_HIM;
	    if (pos->2=='s') return fl|QP_HES;
	 }
	'i': if (pos->1=='f')
	 {
	   if (pos->2==126 or 33) ! tilde or exclamation
	      return fl|QP_IFNOT;
	   if (pos->2=='s') return fl|QP_IFSTRING;
	   if (pos->2=='_') return fl|QP_IFSPACE;
	 }
	'_': if (pos->1=='i' && pos->2=='f') return QP_SPACEIF;
		 
	'o': if (pos->1=='f' && pos->2=='f') return fl|QP_OFFOROUTOF;
	 if (pos->1=='b' && pos->2=='j') return fl|QP_OBJECT;
	'n': if (pos->1=='u' && pos->2=='m') return fl|QP_NUMBER;
	's': if (pos->1=='t' && pos->2=='r') return fl|QP_STRING;
	 if (pos->1=='h' && pos->3=='e') return fl|QP_HE;
	't': if (pos->1=='h' && pos->2=='e') return fl|QP_THE;
	 if (pos->1=='i' && pos->2=='s') return fl|QP_THEIS;
        'w': if (pos->1=='a' && pos->2=='s') return fl|QP_WAS;
      }
      rfalse;
   }
   if (l==4) ! addr(ess) / word, bold, char, does, emph(asis), have,
             !  have, hers, heis / itis, name, rout(ine),
             !  self (itself &c.), shes, that, were, twas (the was)
             ! thac (that accusative)
   {
      switch (c)
      {
	'a': if (pos->1=='d' && pos->2=='d' && pos->3=='r')
	   return fl|QP_ADDRESS;
	'b': if (pos->1=='o' && pos->2=='l' && pos->3=='d')
	   return fl|QP_BOLD;
	'c': if (pos->1=='h' && pos->2=='a' && pos->3=='r')
	   return fl|QP_CHAR;
	'd': if (pos->1=='o' && pos->2=='e' && pos->3=='s')
	   return fl|QP_DOES;
	'e': if (pos->1=='m' && pos->2=='p' && pos->3=='h')
	   return fl|QP_EMPH;
	'h': if (pos->1=='a' && pos->2=='v' && pos->3=='e')
	   return fl|QP_HAS;
	 if (pos->1=='e' && pos->2=='r' && pos->3=='s')
	    return fl|QP_HERS;
	 if (pos->1=='e' && pos->2=='i' && pos->3=='s')
	    return fl|QP_HEIS;
	'i': if (pos->1=='t' && pos->2=='i' && pos->3=='s')
	    return fl|QP_HEIS;
	'n': if (pos->1=='a' && pos->2=='m' && pos->3=='e')
	   return fl|QP_NAME;
	'r': if (pos->1=='o' && pos->2=='u' && pos->3=='t')
	   return fl|QP_ROUTINE;
	's': if (pos->1=='e' && pos->2=='l' && pos->3=='f')
	   return fl|QP_SELF;
	 if (pos->1=='h' && pos->2=='e' && pos->3=='s')
	    return fl|QP_HES;
	't': if (pos->1=='h' && pos->2=='a' && pos->3=='t')
	   return fl|QP_THAT;
	 if (pos->1=='w' && pos->2=='a' && pos->3=='s')
	    return fl|QP_THEWAS;
	 if (pos->1=='h' && pos->2=='a' && pos->3=='c')
	   return fl|QP_THATACC;
	'w': if (pos->1=='o' && pos->2=='r' && pos->3=='d')
	   return fl|QP_ADDRESS;
          if (pos->1=='e' && pos->2=='r' && pos->3=='e')
           return fl|QP_WAS;
      }
      rfalse;
   }
   if (l==5) ! inthe / onthe, thats, ifnot (if-not contruct),
             ! yours, roman (style), theis, sheis, hewas
   {
      if (c=='i' or 'o' && pos->1=='n' && pos->2=='t'
 	  && pos->3=='h' && pos->4=='e')
	 return fl|QP_INORONTHE;
      if (c=='t' && pos->1=='h' && pos->2=='a'
 	  && pos->3=='t' && pos->4=='s')
	 return fl|QP_THATS;
      if (c=='i' && pos->1=='f' && pos->2=='n'
	  && pos->3=='o' && pos->4=='t')
	 return fl|QP_IFNOT;
      if (c=='y' && pos->1=='o' && pos->2=='u'
	  && pos->3=='r' && pos->4=='s')
	 return fl|QP_HERS;
      if (c=='r' && pos->1=='o' && pos->2=='m'
	  && pos->3=='a' && pos->4=='n')
	 return fl|QP_ROMAN;
      if (c=='t' && pos->1=='h' && pos->2=='e'
	  && pos->3=='i' && pos->4=='s')
	 return fl|QP_THEIS;
      if (c=='s' && pos->1=='h' && pos->2=='e'
	  && pos->3=='i' && pos->4=='s')
	 return fl|QP_HEIS;
      if (c=='h' && pos->1=='e' && pos->2=='w'
	  && pos->3=='a' && pos->4=='s')
	 return fl|QP_HEWAS;
      rfalse;
   }
   if (l==6) ! theacc (the accusative), thewas, string, number,
             ! object, offthe, hisort
   {
      if (c=='t' && pos->1=='h' && pos->2=='e'
	  && pos->3=='a' && pos->4=='c' && pos->5=='c')
	 return fl|QP_THEACC;
      if (c=='t' && pos->1=='h' && pos->2=='e'
          && pos->3=='w' && pos->4=='a' && pos->5=='s')
         return fl|QP_THEWAS;
      if (c=='s' && pos->1=='t' && pos->2=='r'
	  && pos->3=='i' && pos->4=='n' && pos->5=='g')
	 return fl|QP_STRING;
      if (c=='n' && pos->1=='u' && pos->2=='m'
	  && pos->3=='b' && pos->4=='e' && pos->5=='r')
	 return fl|QP_NUMBER;
      if (c=='o' && pos->1=='b' && pos->2=='j'
	  && pos->3=='e' && pos->4=='c' && pos->5=='t')
	 return fl|QP_OBJECT;
      if (c=='o' && pos->1=='f' && pos->2=='f' &&
	  pos->3=='t' && pos->4=='h' && pos->5=='e')
	 return fl|QP_OFFTHE;
      rfalse;
   }
   if (l==7) ! address, routine, thatacc (that accusative),
             ! thatwas
   {
      if (c=='a' && pos->1=='d' && pos->2=='d' && pos->3=='r'
	  && pos->4=='e' && pos->5=='s' && pos->6=='s')
	 return fl|QP_ADDRESS;
      if (c=='r' && pos->1=='o' && pos->2=='u' && pos->3=='t'
	  && pos->4=='i' && pos->5=='n' && pos->6=='e')
	 return fl|QP_ROUTINE;
      if (c=='t' && pos->1=='h' && pos->2=='a' && pos->3=='t'
	  && pos->4=='a' && pos->5=='c' && pos->6=='c')
	 return fl|QP_THATACC;
      if (c=='t' && pos->1=='h' && pos->2=='a' && pos->3=='t'
	  && pos->4=='w' && pos->5=='a' && pos->6=='s')
	 return fl|QP_THATWAS;
      rfalse;
   }
   if (l==8) ! thatsnot (that's not)
   {
      if (c=='t' && pos->1=='h' && pos->2=='a' && pos->3=='t'
 	  && pos->4=='s' && pos->5=='n' && pos->6=='o' && pos->7=='t')
	 return fl|QP_THATSNOT;
!      rfalse;
   }
   rfalse;
];

[ QPoutnext1 fl  pos tl;
   pos = QPchar->QP_POS_INDEX;
   tl = QPchar-->0;
#IfNDef TARGET_GLULX;
   tl = tl + 2; ! tl == total length
#EndIf;
   if (pos>=tl-1 || QPchar->pos==QP_sep_ch or QP_esc_ch) rfalse;
   pos++;

   while (pos<tl && QPchar->pos~=QP_sep_ch or QP_esc_ch)
   {
      if (fl) print (char) (QPchar->pos);
      pos++;
   }
   QPchar->QP_POS_INDEX = pos;
   rtrue;
];

[ QPoutnext fl  pos tl;
   fl = ~~fl;
   pos = QPchar->QP_POS_INDEX;
   tl = QPchar-->0;
#IfNDef TARGET_GLULX;
   tl = tl + 2; ! tl == total length
#EndIf;
   if (pos>=tl-1 || QPchar->pos==QP_esc_ch) rfalse;
   pos++;
   
   while (pos<tl && QPchar->pos~=QP_esc_ch)
   {
      if (fl) print (char) (QPchar->pos);
      pos++;
   }

   QPchar->QP_POS_INDEX = pos;
   rtrue;
];
	  
[ QPParam pos tl l;
   pos = QPchar->QP_POS_INDEX; ! pos == cur position
   tl = 2+QPchar-->0;
#IfNDef TARGET_GLULX;
   tl = tl + 2; ! tl == total length
#EndIf;
   if (pos>=tl-1 || QPchar->pos==QP_esc_ch) rfalse;
   pos++;
   l = pos; ! l starts at cur pos
   while (l<tl && QPchar->l~=' ' or QP_esc_ch) l++;
   QPchar->QP_POS_INDEX = l;
   l = l - pos;
   pos = pos + QPchar;

   ! 1 to 6 (qprint parameters), a(ctor), n(noun), s(econd), p(layer)
   if (l==1) switch (pos->0)
   {
     '1' to '6': return QPArg-->(pos->0 -'1');
     'a','A': return actor;
     'n','N': return noun;
     's','S': return second;
     'p','P': return player;
!     '0': rfalse; ! unnecessary
     default: rfalse;
   }
   ! true, noun, self
   if (l==4)
   {
      if (pos->0=='t' && pos->1=='r' && pos->2=='u' && pos->3=='e')
	 return true;
      if (pos->0=='n' && pos->1=='o' && pos->2=='u' && pos->3=='n')
	 return noun;
      if (pos->0=='s' && pos->1=='e' && pos->2=='l' && pos->3=='f')
	 return self;
      rfalse;
   }
   ! actor, false
   if (l==5)
   {
      if (pos->0=='a' && pos->1=='c' && pos->2=='t'
	  && pos->3=='o' && pos->4=='r')
	 return actor;
!      if (pos->0=='f' && pos->1=='a' && pos->2=='l'
!	  && pos->3=='s' && pos->4=='e')
!         return false; ! unnecessary
      rfalse;
   }
   ! second, player
   if (l==6)
   {
      if (pos->0=='s' && pos->1=='e' && pos->2=='c'
	  && pos->3=='o' && pos->4=='n' && pos->5=='d')
	 return second;
      if (pos->0=='p' && pos->1=='l' && pos->2=='a'
	  && pos->3=='y' && pos->4=='e' && pos->5=='r')
	 return player;
      !rfalse;
   }
   rfalse;
];

#endif; ! QPrint