! ===========================================================================
!
!   Replacement library routines, entry points and assorted miscellany for the
!
!   Lojban Inform Language Definition File
!
!   Written by Martin Bays
!   Placed into the public domain in 2002 by Martin Bays
!
! ---------------------------------------------------------------------------
 [ DrawStatusLine width posa posb;
   @split_window 1; @set_window 1; @set_cursor 1 1; style reverse;
   width = 0->33; posa = width-34; posb = width-19;
   spaces width;
   @set_cursor 1 2;
   if (location == thedark) print (name) location;
   else
   {   FindVisibilityLevels();
       if (visibility_ceiling == location)
           print (name) location;
       else print (The) visibility_ceiling;
   }
   if ((0->1)&2 == 0)
   {   if (width > 76)
       {   @set_cursor 1 posa; print (string) SCORE__TX, sline1;
           @set_cursor 1 posb; print (string) MOVES__TX, sline2;
       }
       if (width > 63 && width <= 76)
       {   @set_cursor 1 posb; print sline1, "/", sline2;
       }
   }
   else
   {   @set_cursor 1 posa;
       print (string) TIME__TX;
       LanguageTimeOfDay(sline1, sline2);
   }
   @set_cursor 1 1; style roman; @set_window 0;
];

[ PronounsSub x y c d;

  L__M(##Pronouns, 1);

  c = (LanguagePronouns-->0)/3;
  if (player ~= selfobj) c++;

  if (c==0) return L__M(##Pronouns, 4);

  for (x = 1, d = 0 : x <= LanguagePronouns-->0: x = x+3)
  { new_line;  
	if (LanguagePronouns-->x == 'le-go^i' or 'le-se-go^i' or 'le-te-go^i')
	  { 
		if (LanguagePronouns-->x == 'le-go^i') print "lu le go'i le'u"; !Ugly, I know...
		if (LanguagePronouns-->x == 'le-se-go^i') print "lu le se go'i le'u"; 
		if (LanguagePronouns-->x == 'le-te-go^i') print "lu le te go'i le'u";
	  }
      else print "zo ", (address) LanguagePronouns-->x;
      y = LanguagePronouns-->(x+2);
      if (y == NULL) L__M(##Pronouns, 3);
      else { L__M(##Pronouns, 2); print (the) y; }
      d++;
      if (d < c-1) print " gi'e ";
      if (d == c-1) print (string) AND__TX;
  }
  if (player ~= selfobj)
  {   print "zo ", (address_LojSub) ME1__WD; L__M(##Pronouns, 2);
      c = player; player = selfobj;
      print (the) c; player = c;
  }
  ""; !***YEO*** prints new line and returns - is needed.
];
 
 [ DoMenu menu_choices EntryR ChoiceR
          lines main_title main_wid cl i j oldcl pkey;
 
   if (pretty_flag==0)
       return LowKey_Menu(menu_choices,EntryR,ChoiceR);
 
   menu_nesting++;
   menu_item=0;
   lines=indirect(EntryR);
   main_title=item_name; main_wid=item_width;
   cl=7;
 
   .ReDisplay;
       oldcl=0;
       @erase_window $ffff;
       i=lines+7;
       @split_window i;
       i = 0->33;
       if (i==0) i=80;
       @set_window 1;
       @set_cursor 1 1;
       style reverse;
       spaces(i); j=i/2-main_wid;
       @set_cursor 1 j;
       print (string) main_title;
       @set_cursor 2 1; spaces(i);
       @set_cursor 2 2; print (string) NKEY__TX;
       j=i-20; @set_cursor 2 j; print (string) PKEY__TX;
       @set_cursor 3 1; spaces(i);
       @set_cursor 3 2; print (string) RKEY__TX;
       j=i-20; @set_cursor 3 j;
       if (menu_nesting==1) print (string) QKEY1__TX;
                       else print (string) QKEY2__TX;
       style roman;
       @set_cursor 5 2; font off;
 
       if (menu_choices ofclass String) print (string) menu_choices;
       else menu_choices.call();
 
       for (::)
       {   if (cl ~= oldcl)
           {   if (oldcl>0) { @set_cursor oldcl 4; print " "; }
               @set_cursor cl 4; print ">";
           }
           oldcl=cl;
           @read_char 1 -> pkey;
           if (pkey==NKEY1__KY or NKEY2__KY or 130)
           {   cl++; if (cl==7+lines) cl=7; continue;
           }
           if (pkey==PKEY1__KY or PKEY2__KY or 129)
           {   cl--; if (cl==6)  cl=6+lines; continue;
           }
           if (pkey==QKEY1__KY or QKEY2__KY or 27 or 131) break;
           if (pkey==10 or 13 or 132)
           {   @set_window 0; font on;
               new_line; new_line; new_line;
 
               menu_item=cl-6;
               EntryR.call();
 
               @erase_window $ffff;
               @split_window 1;
               i = 0->33; if (i==0) { i=80; }
               @set_window 1; @set_cursor 1 1; style reverse; spaces(i);
               j=i/2-item_width;
               @set_cursor 1 j;
               print (string) item_name;
               style roman; @set_window 0; new_line;
 
               i = ChoiceR.call();
               if (i==2) jump ReDisplay;
               if (i==3) break;
 
               L__M(##Miscellany, 53);
               @read_char 1 -> pkey; jump ReDisplay;
           }
       }
 
       menu_nesting--; if (menu_nesting>0) rfalse;
       font on; @set_cursor 1 1;
       @erase_window $ffff; @set_window 0;
       new_line; new_line; new_line;
       if (deadflag==0) <<Look>>;
 ];

!***MDB*** Substitute back from what LanguageToInformese did:
!	"-" -> " "
!	"_" -> "."
!	"=" -> ","
!Currently used in parserm
Array lojban_printed_text --> 500; !Currently used here, in LTI_Replace and in NumberWord
[ address_LojSub text;
  	lojban_printed_text-->0 = 499; @output_stream 3 lojban_printed_text; 
  	print (address) text; @output_stream -3;
	LojSub();
];
!to use for other printing rules, just copy the above routine replacing "address"
[ LojSub k;
	for (k=2 : k<(lojban_printed_text-->0)+2 : k++)
	{
		if (lojban_printed_text->k == '-')
			lojban_printed_text->k = ' ';
		if (lojban_printed_text->k == '_')
			lojban_printed_text->k = '.';
		if (lojban_printed_text->k == '=')
			lojban_printed_text->k = ',';
		print (char) lojban_printed_text->k;
	}
];

[ SetPronoun dword value x;
	if (dword == 'ri')
	{ !***MDB*** Push pronouns back through series
		SetPronoun('ru', PronounValue('ra'));
		SetPronoun('ra', PronounValue('ri'));
	}
  for (x = 1 : x <= LanguagePronouns-->0: x = x+3)
      if (LanguagePronouns-->x == dword)
      {   LanguagePronouns-->(x+2) = value; return;
      }
  RunTimeError(14);
];

[ PronounNotice obj x bm;

   if (obj == player) return;

   #ifdef EnglishNaturalLanguage;
   PronounOldEnglish();
   #endif;

   bm = PowersOfTwo_TB-->(GetGNAOfObject(obj));

   for (x = 1 : x <= LanguagePronouns-->0: x = x+3)
       if ((bm & (LanguagePronouns-->(x+1)) ~= 0) && ~~(LanguagePronouns-->x == 'ra' or 'ru' or 'le-go^i' or 'le-se-go^i' or 'le-te-go^i')) !***MDB*** ra, ru set when 'ri' is set in SetPronoun, and the "go'i"s are set in TurnPostRoutine
           SetPronoun(LanguagePronouns-->x, obj);

   #ifdef EnglishNaturalLanguage;
   itobj  = PronounValue('it');  old_itobj  = itobj;
   himobj = PronounValue('him'); old_himobj = himobj;
   herobj = PronounValue('her'); old_herobj = herobj;
   #endif;
];

!***MDB*** used to set the "le ?? go'i"s. 
!This is a whole new entry point routine, which the parser now calls (in parserm). 
[TurnPostRoutine;
SetPronoun('le-go^i', actor);
if (inp1>1) !Not nothing and not a number
	SetPronoun('le-se-go^i', inp1);
else SetPronoun('le-se-go^i', NULL);
if (inp2>1) !Not nothing and not a number
	SetPronoun('le-te-go^i', inp2);
else SetPronoun('le-te-go^i', NULL);
rfalse;
];

!***MDB*** might as well do proper number parsing
!Handles both "parecivomu" and "pareki'ocivomu"
[ ParseNumber num len   chars pos digit n p;
	chars = len;
	if (chars < 1) return 0;
	pos = chars-1;
	for (p=1:p<=100:p=p*10) {
		if (--chars == 0 || (digit = LojbanNumber(num->(pos--), num->(pos--))) == -1) return 0;	
		n = n + digit*p;
		if (--chars == 0) return n; !Note - can't handle "no" as 0
	}
	if (chars>=4 && num->(pos) == 'o' && num->(pos-1) == ''' && num->(pos-2) == 'i' && num->(pos-3) == 'k') {
		chars = chars-4;
		pos = pos-4;
		if (chars == 0) return 0; !"ki'eparevo", or something similarly nonsensical	 	
	}
	if (--chars == 0 || (digit = LojbanNumber(num->(pos--), num->(pos--))) == -1) return 0;	
	n = n + digit*1000;
	if (--chars == 0) return n; 

	if (--chars == 0 || (digit = LojbanNumber(num->(pos--), num->(pos--))) == -1) return 0;	
	if (digit > 3) return 10000;
	n = n + digit*10000;
	if (n<0) return 10000; !Inform can only handle numbers up to about 32000
	if (--chars == 0) return n; 
	return 0;
];

[LojbanNumber a b; 
if (a == 'n' && b == 'o') return 0;
if (a == 'p' && b == 'a') return 1;
if (a == 'r' && b == 'e') return 2;
if (a == 'c' && b == 'i') return 3;
if (a == 'v' && b == 'o') return 4;
if (a == 'm' && b == 'u') return 5;
if (a == 'x' && b == 'a') return 6;
if (a == 'z' && b == 'e') return 7;
if (a == 'b' && b == 'i') return 8;
if (a == 's' && b == 'o') return 9;
return -1;
];