
uses dos,crt,nanocore,nanostr;
{$M 49152,0,655360}
{$F+}
const progname='RCL - Rancho Nevada Universe Language Compiler';
      version='2.112';
      tmpname='$NCOMP.TMP';
      crlf=#13#10;

      maxverb=56;
      verbs:array[1..maxverb] of string[20]=(
{1  :}  'LANGUAGEFILE',
{2  :}  'SYSMSG',
{3  :}  'END',
{4  :}  'COMMENT',
{5  :}  'RIP_TEXT_WINDOW',
{6  :}  'RIP_VIEWPORT',
{7  :}  'RIP_RESET_WINDOWS',
{8  :}  'RIP_ERASE_WINDOW',
{9  :}  'RIP_ERASE_VIEW',
{10 :}  'RIP_GOTOXY',
{11 :}  'RIP_HOME',
{12 :}  'RIP_ERASE_EOL',
{13 :}  'RIP_COLOR',
{14 :}  'RIP_SET_PALETTE',
{15 :}  'RIP_ONE_PALETTE',
{16 :}  'RIP_WRITE_MODE',
{17 :}  'RIP_MOVE',
{18 :}  'RIP_TEXT',
{19 :}  'RIP_TEXT_XY',
{20 :}  'RIP_FONT_STYLE',
{21 :}  'RIP_PIXEL',
{22 :}  'RIP_LINE',
{23 :}  'RIP_RECTANGLE',
{24 :}  'RIP_BAR',
{25 :}  'RIP_CIRCLE',
{26 :}  'RIP_OVAL',
{27 :}  'RIP_FILLED_OVAL',
{28 :}  'RIP_ARC',
{29 :}  'RIP_OVAL_ARC',
{30 :}  'RIP_PIE_SLICE',
{31 :}  'RIP_OVAL_PIE_SLICE',
{32 :}  'RIP_BEZIER',
{33 :}  'RIP_POLYGON',
{34 :}  'RIP_FILL_POLY',
{35 :}  'RIP_FILL',
{36 :}  'RIP_LINE_STYLE',
{37 :}  'RIP_FILL_STYLE',
{38 :}  'RIP_FILL_PATTERN',
{39 :}  'RIP_MOUSE',
{40 :}  'RIP_KILL_MOUSE_FIELDS',
{41 :}  'RIP_BEGIN_TEXT',
{42 :}  'RIP_REGION_TEXT',
{43 :}  'RIP_END_TEXT',
{44 :}  'RIP_GET_IMAGE',
{45 :}  'RIP_PUT_IMAGE',
{46 :}  'RIP_WRITE_ICON',
{47 :}  'RIP_LOAD_ICON',
{48 :}  'RIP_BUTTON_STYLE',
{49 :}  'RIP_BUTTON',
{50 :}  'RIP_DEFINE',
{51 :}  'RIP_QUERY',
{52 :}  'RIP_COPY_REGION',
{53 :}  'RIP_READ_SCENE',
{54 :}  'RIP_FILE_QUERY',
{55 :}  'RIP_ENTER_BLOCK_MODE',
{56 :}  'RIP_NO_MORE');

type idxarraytype=array[1..2048] of word;
     ttype=array[0..65519] of char;
     msgarray=^ttype;
var msgtext:msgarray;
    infile:text;
    outfile:file;
    infname,outfname:pathstr;
    crap1:dirstr;
    crap2:namestr;
    crap3:extstr;
    tch:char;
    varnum:word;
    constant,
    getwordbracket:boolean;
    linecount:word;
    ercomp:boolean;
    static:boolean;
    indexarray:idxarraytype;
    index:word;
    validsysmsg,
    makelangfile:boolean;
    idxfile:file of idxarraytype;
    idxfname:string;
    tstr:string;
    junk:word;
    junkfile:file;
    maxline:longint;
    buf2,
    buf:array[1..16384] of char;
    rip,parsing,pfirst:boolean;
    offset:word;
    
procedure process_verb(var infile:text); forward;

function riparm(s:String):string;
begin
  s:=upcasestr(s); riparm:=s;
  if isnums(s) then exit;
  if (s='ON') or (s='YES') then begin riparm:='1'; exit; end;
  if (s='OFF') or (s='NO') then begin riparm:='0'; exit; end;
  if s='WRAP' then begin riparm:='0'; exit; end;
  if s='NOWRAP' then begin riparm:='1'; exit; end;
  if (s='8X8') or (s='DEFAULT') then begin riparm:='0'; exit; end;
  if (s='TRIPLEX') then begin riparm:='1'; exit; end;
  if (s='SMALL') then begin riparm:='2'; exit; end;
  if (s='SANS') or (s='SANSSERIF') then begin riparm:='3'; exit; end;
  if (s='GOTHIC') then begin riparm:='4'; exit; end;
  if (s='HORIZONTAL') or (s='HORIZ') then begin riparm:='0'; exit; end;
  if (s='VERTICAL') or (s='VERT') then begin riparm:='1'; exit; end;
  if (s='NORMAL') or (s='SOLID')  then begin riparm:='0'; exit; end;
  if (s='DOTTED') then begin riparm:='1'; exit; end;
  if (s='CENTERED') then begin riparm:='2'; exit; end;
  if (s='DASHED') then begin riparm:='3'; exit; end;
  if (s='CUSTOM') then begin riparm:='4'; exit; end;
  if (s='COPY') then begin riparm:='0'; exit; end;
  if (s='XOR') then begin riparm:='1'; exit; end;
  if (s='OR') then begin riparm:='2'; exit; end;
  if (s='AND') then begin riparm:='3'; exit; end;
  if (s='INVERSE') or (s='NOT') then begin riparm:='4'; exit; end;
  if (s='ABOVE') then begin riparm:='0'; exit; end;
  if (s='LEFT') then begin riparm:='1'; exit; end;
  if (s='CENTER') then begin riparm:='2'; exit; end;
  if (s='RIGHT') then begin riparm:='3'; exit; end;
  if (s='BENEATH') then begin riparm:='4'; exit; end;
end;

procedure str2text(s:string);
var i:word;
begin
  for i:=1 to length(s) do
  begin
    msgtext^[offset-1]:=s[i];
    inc(offset);
  end;
end;

procedure char2text(c:char);
begin
  msgtext^[offset]:=c;
  inc(offset);
end;

procedure beebeebeep;
var index:word;
begin
  for index:=1 to 3 do
  begin
    sound(1666);
    delay(50);
    nosound;
    delay(30);
  end;
end;

function int2str(inint:longint):string;
var tmp:string[11];
begin
  tmp:='0';
  str(inint,tmp);
  int2str:=tmp
end;

function str2int(s:string):longint;
var param:longint;
    ercode:integer;
begin
  val(s,param,ercode);
  str2int:=param;
end;

function zeropad(s:string):string;
var tmp3:string;
begin
  tmp3:='00'+s;
  tmp3:=copy(tmp3,length(tmp3)-1,2);
  zeropad:=tmp3;
end;

function upcasestr(lstring:string):string;
var tmp:string;
    i:byte;
begin
  for i:=1 to length(lstring) do
  lstring[i]:=upcase(lstring[i]);
  upcasestr:=lstring;
end;

Function Exist(F:String):Boolean;
Var XF:Text;
begin
  Assign(XF,F);
  {$I-}
  Reset(XF);
  If (IOResult = 0) then begin Exist := True; Close(XF); end
        Else Exist := False;
  {$I+}
end;

function percent(lineno:longint):string;
var t:longint;
const n100:longint=100;
begin
  if maxline=0 then begin percent:='%00'; exit; end;
  t:=(lineno*n100) div maxline;
  percent:='%'+int2str(t);
end;

function linecount2(filename:string):longint;
var tmp:longint;
    f:text;
    s:string[2];
begin
  if not exist(filename) then exit;
  assign(f,filename);
  reset(f);
  tmp:=0;
  repeat
    readln(f,s);
    inc(tmp);
  until eof(f);
  close(f);
  linecount2:=tmp;
end;

function fsize(var f:string):longint;
var s:file of byte;
    result:longint;
begin
  result:=0;
  if
    exist(f)
  then
    begin
{$I-}
      assign(s,f);
      reset(s);
      result:=filesize(s);
      close(s);
{$I+}
      fsize:=result;
      exit;
    end;
  fsize:=result;
end;

procedure fatalerror(s:string);
begin
  textattr:=lightred;
  write(' žžž ERROR! ');
  textattr:=white;
  write(s);
  if ercomp then writeln(' in line ',linecount) else writeln;
  beebeebeep;
  halt;
end;

procedure comperror(s:string);
begin
  close(infile);
  fatalerror(s);
end;

function ripcolour(s:string):integer;
begin
  ripcolour:=15;
  s:=upcasestr(s);
  if (s='BLACK') or (s='0')         then ripcolour:=0;
  if (s='BLUE')  or (s='1')         then ripcolour:=1;
  IF (S='GREEN') or (s='2')         then ripcolour:=2;
  IF (S='CYAN') or (s='3')          then ripcolour:=3;
  IF (S='RED') or (s='4')           then ripcolour:=4;
  IF (S='MAGENTA') or (s='5')       then ripcolour:=5;
  IF (S='BROWN') or (s='6')         then ripcolour:=6;
  IF (S='LIGHTGRAY') or (s='7')     then ripcolour:=7;
  IF (S='LIGHTGREY')                then ripcolour:=7;
  IF (S='DARKGRAY') or (s='8')      then ripcolour:=8;
  IF (S='DARKGREY')                 then ripcolour:=8;
  IF (S='LIGHTBLUE') or (s='9')     then ripcolour:=9;
  IF (S='LIGHTGREEN') or (s='10')   then ripcolour:=10;
  IF (S='LIGHTCYAN') or (s='11')    then ripcolour:=11;
  IF (S='LIGHTRED') or (s='12')     then ripcolour:=12;
  IF (S='LIGHTMAGENTA') or (s='13') then ripcolour:=13;
  IF (S='YELLOW') or (s='14')       then ripcolour:=14;
  IF (S='WHITE') or (s='15')        then ripcolour:=15;
end;

function iscolour(s:string):boolean;
begin
  iscolour:=false;
  s:=upcasestr(s);
  if (s='BLACK')
  or (s='BLUE')
  or (S='GREEN')
  or (S='CYAN')
  or (S='RED')
  or (S='MAGENTA')
  or (S='BROWN')
  or (S='LIGHTGRAY')
  or (S='LIGHTGREY')
  or (S='DARKGRAY')
  or (S='DARKGREY')
  or (S='LIGHTBLUE')
  or (S='LIGHTGREEN')
  or (S='LIGHTCYAN')
  or (S='LIGHTRED')
  or (S='LIGHTMAGENTA')
  or (S='YELLOW')
  or (S='WHITE') then iscolour:=true;
end;

function meganum(i:longint; w:byte):string;
const megadigits:string[36]='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var h5,h4,h3,h2,h1:longint;
    tstr:string[2];
begin
  case w of
    1: if (i<0) or (i>35) then begin meganum:='0'; exit; end;
    2: if (i<0) or (i>1295) then begin meganum:='00'; exit; end;
    3: if (i<0) or (i>46655) then begin meganum:='000'; exit; end;
    4: if (i<0) or (i>1679615) then begin meganum:='0000'; exit; end;
    5: if (i<0) or (i>60466175) then begin meganum:='00000'; exit; end;
  else
    begin
      meganum:='00';
      exit;
    end;
  end;
  h1:=i mod 36;
  h2:=(i div 36);
  h3:=(h2 div 36); h2:=h2 mod 36;
  h4:=(h3 div 36); h3:=h3 mod 36;
  h5:=(h4 div 36); h4:=h4 mod 36;
  tstr[0]:=chr(w);
  if w>=1 then tstr[w]:=megadigits[h1+1];
  if w>=2 then tstr[w-1]:=megadigits[h2+1];
  if w>=3 then tstr[w-2]:=megadigits[h3+1];
  if w>=4 then tstr[w-3]:=megadigits[h4+1];
  if w>=5 then tstr[w-4]:=megadigits[h5+1];
  meganum:=tstr;
end;

function zpe(s:string; l:integer):string;
begin
  zpe:=meganum(str2int(s),l);
end;

function getword(var infile:text):string;
var
    tstr:string;
    tsl:byte absolute tstr;
begin
  pfirst:=false;
  if not parsing then begin getword:=''; exit; end;
  getwordbracket:=false;
  tstr[0]:=#00;
  read(infile,tch);
  if tch=#13 then inc(linecount);
  if
    (tch=#32) or (tch=#13) or (tch=#10)
  then
    while
      ((tch=#32) or (tch=#13) or (tch=#10))
    do
      begin
        read(infile,tch); {skip leading whitespace and wrap around cr's}
        if tch=#13 then inc(linecount);
      end;
  if
    tch='['
  then
    begin
      getword:='[';
      parsing:=false;
      exit;
    end; {in case of [[}
  if
    tch=']'
  then
    begin
      rip:=false;
      getword:=']';
      parsing:=false;
      exit;
    end; {in case of []}
  if
    tch='"'
  then
    begin {The char was a " so this is a constant noun}
      constant:=true;
      read(infile,tch);
      if tch=#13 then inc(linecount);
      if
        tch<>'"'
      then
        while
          ((tch<>'"') and not(eof(infile)))
        do
          begin
            if tch=']' then begin rip:=false; parsing:=false; getword:=tstr; exit; end;
            tstr:=tstr+tch;
            read(infile,tch);
            if tch=#13 then inc(linecount);
          end;
      if
        (tch=#13) or (tch=#10)
      then
        comperror('" Expected');
{      writeln('Getword: "',tstr,'" (Constant)');}
      getword:=tstr;
      exit;
    end
  else
    constant:=false;
  tstr:=tch;
  repeat
    if eof(infile) then comperror('Unexpected End-Of-File');
    read(infile,tch); {read until space or eoln}
    if tch=']' then begin rip:=false; parsing:=false;  getword:=tstr; exit; end;
    if tch=#13 then inc(linecount);
    tstr:=tstr+tch;
  until ((tch=#32) or (tch=#13) or (tch=#10) or (tch=']'));
  dec(tsl); {cut off the terminal character}
  if tch=']' then begin getwordbracket:=true; rip:=false; end;
{  writeln;   }
{  writeln('Getword: "',tstr,'"');  }
  getword:=tstr;
end;


procedure getbracket(var infile:text);
var tstr:string[20];
begin
  if getwordbracket then begin getwordbracket:=false; exit; end;
  read(infile,tch);
  if tch=#13 then inc(linecount);
  while (tch<>']') and not(eof(infile)) do
  begin
    read(infile,tch);
    if tch=#13 then inc(linecount);
  end;
  if eof(infile) then comperror('Unexpected End Of File');
end;

function checkverb(s:string):word;
var tmp:word;
    tstr:string[20];
    found:boolean;
begin
  s:=upcasestr(s);
  tmp:=0; tstr:=''; found:=false;
  while (s<>tstr) and (tmp<=maxverb) do
  begin
    inc(tmp);
    tstr:=verbs[tmp];
    if s=tstr then found:=true;
  end;
  if not(found) or (tmp>maxverb) then tmp:=0;
  checkverb:=tmp;
end;

function getparm(var infile:text):string;
var tstr:String;
begin
  tstr:=getword(infile);
  if
    (not constant) and (tstr=']')
  then
    comperror('Unexpected ]');
  getparm:=tstr;
end;

procedure process_verb;
var tmpverb:string;
    tstr1,tstr2,tstr3,tstr4,tstr5,tstr6,tstr7,tstr8,tstr9,tstr10:string[80];
    tstr:string;
    tch:char;
    i,j:word;
begin
  tmpverb:=upcasestr(getword(infile));
  if tmpverb='[' then begin char2text('['); exit; end;
  case checkverb(tmpverb) of
     1: begin {Languagefile}
          tstr1:=getparm(infile);
          if
            not makelangfile
          then
            begin
              fillchar(indexarray,sizeof(indexarray),#00);
              makelangfile:=true;
            end;
{          getbracket(infile);}
        end;
     2: begin {sysmsg}
          if not(makelangfile) then fatalerror('Illegal SYSMSG directive - not a language file');
          tstr1:=getparm(infile);
          index:=str2int(tstr1);
          if (index<1) or (index>2048) then fatalerror('Illegal SYSMSG number '+tstr1+' - must be 1..2048');
          tstr:=tmpname;
          indexarray[index]:=offset;
          validsysmsg:=true;
        end;
     3: begin {end}
          if not(makelangfile) then fatalerror('Illegal END directive - not a language file');
          char2text(#00);
          validsysmsg:=false;
        end;
     4: begin {comment}
          repeat
            read(infile,tch);
            if tch=#13 then inc(linecount);
          until (eof(infile)) or (tch=']');
          parsing:=false;
        end;
{*}  5: begin                                   {RIP_TEXT_WINDOW}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|w');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x0}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y0}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x1}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y1}
          tstr5:=zpe(riparm(getparm(infile)),1);  {wrap "WRAP" or "NOWRAP"}
          tstr6:=meganum(str2int(getparm(infile)),1);  {size}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6);
        end;
{*}  6: begin                                   {RIP_VIEWPORT}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|v');
          tstr1:=meganum(str2int(getparm(infile)),2);   {x0}
          tstr2:=meganum(str2int(getparm(infile)),2);   {y0}
          tstr3:=meganum(str2int(getparm(infile)),2);   {x1}
          tstr4:=meganum(str2int(getparm(infile)),2);   {y1}
          str2text(tstr1+tstr2+tstr3+tstr4);
        end;
{*}  7: begin                                   {RIP_RESET_WINDOWS}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|*'); {no parms}
        end;
{*}  8: begin                                   {RIP_ERASE_WINDOW}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|e');
        end;
{*}  9: begin                                   {RIP_ERASE_VIEW}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|E');
        end;
{*} 10: begin                                   {RIP_GOTOXY}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|g');
          tstr1:=meganum(str2int(getparm(infile)),2);   {x}
          tstr2:=meganum(str2int(getparm(infile)),2);   {y}
          str2text(tstr1+tstr2);
        end;
{*} 11: begin                                   {RIP_HOME}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|H');
        end;
{*} 12: begin                                   {RIP_ERASE_EOL}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|>');
        end;
{*} 13: begin                                   {RIP_COLOR}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|c');
          tstr1:=(getparm(infile));   {colour}
          if iscolour(tstr1) then tstr1:=meganum(ripcolour(tstr1),2) else tstr1:=meganum(str2int(tstr1),2);
          str2text(tstr1);
        end;
{*} 14: begin                                   {RIP_SET_PALETTE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|Q');
          i:=1;
          repeat
            tstr2:=getparm(infile); {Palette colour #i}
            if not isnums(tstr2) then comperror('Insufficient colours supplied to RIP_SET_PALETTE');
            str2text(meganum(str2int(tstr1),2));
            inc(i);
          until (i>16);
        end;
{*} 15: begin                                   {RIP_ONE_PALETTE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|a');
          tstr1:=meganum(str2int(getparm(infile)),2); {colour}
          tstr2:=meganum(str2int(getparm(infile)),2); {value}
          str2text(tstr1+tstr2);
        end;
{*} 16: begin                                   {RIP_WRITE_MODE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|W');
          tstr1:=meganum(str2int(getparm(infile)),2);  {mode}
          str2text(tstr1);
        end;
{*} 17: begin                                   {RIP_MOVE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|m');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          str2text(tstr1+tstr2);
        end;
{*} 18: begin                                   {RIP_TEXT}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|T');
          tstr:=getparm(infile);   {text}
          str2text(tstr);
        end;
{*} 19: begin                                   {RIP_TEXT_XY}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|@');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr:=getparm(infile);  {text}
          str2text(tstr1+tstr2+tstr);
        end;
{*} 20: begin                                   {RIP_FONT_STYLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|Y');
          tstr1:=zpe(riparm(getparm(infile)),2);  {font}
          tstr2:=zpe(riparm(getparm(infile)),2);  {direction}
          tstr3:=meganum(str2int(getparm(infile)),2);  {size}
          str2text(tstr1+tstr2+tstr3+'00');
        end;
{*} 21: begin                                   {RIP_PIXEL}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|X');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          str2text(tstr1+tstr2);
        end;
{*} 22: begin                                   {RIP_LINE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|L');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x0}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y0}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x1}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y1}
          str2text(tstr1+tstr2+tstr3+tstr4);
        end;
{*} 23: begin                                   {RIP_RECTANGLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|R');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x0}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y0}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x1}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y1}
          str2text(tstr1+tstr2+tstr3+tstr4);
        end;
{*} 24: begin                                   {RIP_BAR}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|B');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x0}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y0}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x1}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y1}
          str2text(tstr1+tstr2+tstr3+tstr4);
        end;
{*} 25: begin                                   {RIP_CIRCLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|C');
          tstr1:=meganum(str2int(getparm(infile)),2);
          tstr2:=meganum(str2int(getparm(infile)),2);
          tstr3:=meganum(str2int(getparm(infile)),2);
          str2text(tstr1+tstr2+tstr3);
        end;
{*} 26: begin                                   {RIP_OVAL}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|O');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {st_ang}
          tstr4:=meganum(str2int(getparm(infile)),2);  {end_ang}
          tstr5:=meganum(str2int(getparm(infile)),2);  {x_rad}
          tstr6:=meganum(str2int(getparm(infile)),2);  {y_rad}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6);
        end;
{*} 27: begin                                   {RIP_FILLED_OVAL}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|o');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x_center}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y_center}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x_rad}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y_rad}
          str2text(tstr1+tstr2+tstr3+tstr4);
        end;
{*} 28: begin                                   {RIP_ARC}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|A');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {start_ang}
          tstr4:=meganum(str2int(getparm(infile)),2);  {end_ang}
          tstr5:=meganum(str2int(getparm(infile)),2);  {radius}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5);
        end;
{*} 29: begin                                   {RIP_OVAL_ARC}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|V');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {st_ang}
          tstr4:=meganum(str2int(getparm(infile)),2);  {e_ang}
          tstr5:=meganum(str2int(getparm(infile)),2);  {radx}
          tstr6:=meganum(str2int(getparm(infile)),2);  {rady}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6);
        end;
{*} 30: begin                                   {RIP_PIE_SLICE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|I');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {start_ang}
          tstr4:=meganum(str2int(getparm(infile)),2);  {end_ang}
          tstr5:=meganum(str2int(getparm(infile)),2);  {radius}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5);
        end;
{*} 31: begin                                   {RIP_OVAL_PIE_SLICE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|i');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {st_ang}
          tstr4:=meganum(str2int(getparm(infile)),2);  {e_ang}
          tstr5:=meganum(str2int(getparm(infile)),2);  {radx}
          tstr6:=meganum(str2int(getparm(infile)),2);  {rady}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6);
        end;
{*} 32: begin                                   {RIP_BEZIER}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|Z');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x1}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y1}
          tstr3:=meganum(str2int(getparm(infile)),2);  {x2}
          tstr4:=meganum(str2int(getparm(infile)),2);  {y2}
          tstr5:=meganum(str2int(getparm(infile)),2);  {x3}
          tstr6:=meganum(str2int(getparm(infile)),2);  {y3}
          tstr7:=meganum(str2int(getparm(infile)),2);  {x4}
          tstr8:=meganum(str2int(getparm(infile)),2);  {y4}
          tstr9:=meganum(str2int(getparm(infile)),2);  {cnt}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6+tstr7+tstr8+tstr9);
        end;
{*} 33: begin                                   {RIP_POLYGON}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|P');
          tstr1:=meganum(str2int(getparm(infile)),2); j:=str2int(tstr1);
          if (j<2) or (j>512) then comperror('Invalid number of RIP_POLYGON vertices');
          str2text(tstr1);
          for i:=1 to j do
            begin
              tstr3:=meganum(str2int(getparm(infile)),2);
              tstr5:=meganum(str2int(getparm(infile)),2);
              str2text(tstr3+tstr5);
            end;
        end;
{*} 34: begin                                   {RIP_FILL_POLY}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|p');
          tstr1:=meganum(str2int(getparm(infile)),2); j:=str2int(tstr1);
          if (j<2) or (j>512) then comperror('Invalid number of RIP_POLYGON vertices');
          str2text(tstr1);
          for i:=1 to j do
            begin
              tstr3:=meganum(str2int(getparm(infile)),2);
              tstr5:=meganum(str2int(getparm(infile)),2);
              str2text(tstr3+tstr5);
            end;
        end;
{*} 35: begin                                   {RIP_FILL}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|F');
          tstr1:=meganum(str2int(getparm(infile)),2);  {x}
          tstr2:=meganum(str2int(getparm(infile)),2);  {y}
          tstr3:=meganum(str2int(getparm(infile)),2);  {border}
          if iscolour(tstr1) then tstr3:='IM'+int2str(ripcolour(tstr3))+'';
          str2text(tstr1+tstr2+tstr3);
        end;
{*} 36: begin                                   {RIP_LINE_STYLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|=');                       {Note: if style is not 4, we}
          tstr1:=meganum(str2int(getparm(infile)),2);  {style}      {don't bother with user_pat}
          if not isnums(tstr) then tstr1:=zpe(riparm(tstr1),2);
          j:=str2int(tstr);
          if j=4 then tstr2:=meganum(str2int(getparm(infile)),4);  {user_pat}
          tstr3:=meganum(str2int(getparm(infile)),2);  {thick}
          if j=4 then str2text(tstr1+tstr2+tstr3) else str2text(tstr1+'0000'+tstr3);
        end;
{*} 37: begin                                   {RIP_FILL_STYLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|S');
          tstr1:=meganum(str2int(getparm(infile)),2); {pattern}
          tstr2:=meganum(ripcolour(getparm(infile)),2); {colour}
          str2text(tstr1+tstr2);
        end;
{*} 38: begin                                   {RIP_FILL_PATTERN}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|s');
          tstr1:=meganum(str2int(getparm(infile)),2);   {c1}
          tstr2:=meganum(str2int(getparm(infile)),2);   {c2}
          tstr3:=meganum(str2int(getparm(infile)),2);   {c3}
          tstr4:=meganum(str2int(getparm(infile)),2);   {c4}
          tstr5:=meganum(str2int(getparm(infile)),2);   {c5}
          tstr6:=meganum(str2int(getparm(infile)),2);   {c6}
          tstr7:=meganum(str2int(getparm(infile)),2);   {c7}
          tstr8:=meganum(str2int(getparm(infile)),2);   {c8}
          tstr9:=meganum(str2int(getparm(infile)),2);   {color}
          if iscolour(tstr9) then tstr9:=meganum(ripcolour(tstr9),2) else tstr9:=meganum(str2int(tstr9),2);
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6+tstr7+tstr8+tstr9);
        end;
{*} 39: begin                                   {RIP_MOUSE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1M');
          tstr1:=meganum(str2int(getparm(infile)),2); {num}
          tstr2:=meganum(str2int(getparm(infile)),2); {x0}
          tstr3:=meganum(str2int(getparm(infile)),2); {y0}
          tstr4:=meganum(str2int(getparm(infile)),2); {x1}
          tstr5:=meganum(str2int(getparm(infile)),2); {y1}
          tstr6:=zpe(riparm(getparm(infile)),1); {clk}
          tstr7:=zpe(riparm(getparm(infile)),1); {clr}
          tstr:=getparm(infile); {mouse return text}
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6+tstr7+'00000');
          str2text(tstr);
        end;
{*} 40: begin                                   {RIP_KILL_MOUSE_FIELDS}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1K');
        end;
{*} 41: begin                                   {RIP_BEGIN_TEXT}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1T');
          tstr1:=meganum(str2int(getparm(infile)),2); {x1}
          tstr2:=meganum(str2int(getparm(infile)),2); {y1}
          tstr3:=meganum(str2int(getparm(infile)),2); {x2}
          tstr4:=meganum(str2int(getparm(infile)),2); {y2}
          str2text(tstr1+tstr2+tstr3+tstr4+'00');
        end;
{*} 42: begin                                   {RIP_REGION_TEXT}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1t');
          tstr1:=zpe(riparm(getparm(infile)),1);
          tstr:=getparm(infile);  {text}
          str2text(tstr1+tstr);
        end;
{*} 43: begin                                   {RIP_END_TEXT}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1E');
        end;
{*} 44: begin                                   {RIP_GET_IMAGE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1C');
          tstr1:=meganum(str2int(getparm(infile)),2); {x0}
          tstr2:=meganum(str2int(getparm(infile)),2); {y0}
          tstr3:=meganum(str2int(getparm(infile)),2); {x1}
          tstr4:=meganum(str2int(getparm(infile)),2); {y1}
          str2text(tstr1+tstr2+tstr3+tstr4+'0');
        end;
{*} 45: begin                                   {RIP_PUT_IMAGE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1P');
          tstr1:=meganum(str2int(getparm(infile)),2); {x}
          tstr2:=meganum(str2int(getparm(infile)),2); {y}
          tstr3:=zpe(riparm(getparm(infile)),2); {mode}
          str2text(tstr1+tstr2+tstr3+'0');
        end;
{*} 46: begin                                   {RIP_WRITE_ICON}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1W0');
          tstr:=getparm(infile);  {filename}
          str2text(tstr);
        end;
{*} 47: begin                                   {RIP_LOAD_ICON}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1I');
          tstr1:=meganum(str2int(getparm(infile)),2); {x}
          tstr2:=meganum(str2int(getparm(infile)),2); {y}
          tstr3:=zpe(riparm(getparm(infile)),2); {mode}
          tstr4:=zpe(riparm(getparm(infile)),1); {clipboard}
          tstr:=getparm(infile);  {filename}
          str2text(tstr1+tstr2+tstr3+tstr4+'10'+tstr);
        end;
{*} 48: begin                                   {RIP_BUTTON_STYLE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1B');
          tstr1:=meganum(str2int(getparm(infile)),2); {wid}
          tstr2:=meganum(str2int(getparm(infile)),2); {hgt}
          tstr3:=zpe(riparm(getparm(infile)),2); {orient}
          tstr4:=meganum(str2int(getparm(infile)),4); {flags}
          tstr5:=meganum(str2int(getparm(infile)),2); {bevsize}
          tstr6:=meganum(str2int(getparm(infile)),2); {dfore}
          if iscolour(tstr6) then tstr6:=meganum(ripcolour(tstr6),2) else tstr6:=meganum(str2int(tstr6),2);
          tstr7:=meganum(str2int(getparm(infile)),2); {dback}
          if iscolour(tstr7) then tstr7:=meganum(ripcolour(tstr7),2) else tstr7:=meganum(str2int(tstr7),2);
          tstr8:=meganum(str2int(getparm(infile)),2); {bright}
          if iscolour(tstr8) then tstr8:=meganum(ripcolour(tstr8),2) else tstr8:=meganum(str2int(tstr8),2);
          tstr9:=meganum(str2int(getparm(infile)),2); {dark}
          if iscolour(tstr9) then tstr9:=meganum(ripcolour(tstr9),2) else tstr9:=meganum(str2int(tstr9),2);
         tstr10:=meganum(str2int(getparm(infile)),2); {surface}
          if iscolour(tstr10) then tstr10:=meganum(ripcolour(tstr10),2) else tstr10:=meganum(str2int(tstr10),2);
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6+tstr7+tstr8+tstr9+tstr10);
          tstr1:=meganum(str2int(getparm(infile)),2); {grp_no}
          tstr2:=meganum(str2int(getparm(infile)),2); {flags2}
          tstr3:=meganum(str2int(getparm(infile)),2); {uline_col}
          if iscolour(tstr3) then tstr3:=meganum(ripcolour(tstr3),2) else tstr3:=meganum(str2int(tstr3),2);
          tstr4:=meganum(str2int(getparm(infile)),2); {corner_col}
          if iscolour(tstr4) then tstr4:=meganum(ripcolour(tstr4),2) else tstr4:=meganum(str2int(tstr4),2);
          str2text(tstr1+tstr2+tstr3+tstr4+'000000');
        end;
{*} 49: begin                                   {RIP_BUTTON}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1U');
          tstr1:=meganum(str2int(getparm(infile)),2); {x0}
          tstr2:=meganum(str2int(getparm(infile)),2); {y0}
          tstr3:=meganum(str2int(getparm(infile)),2); {x1}
          tstr4:=meganum(str2int(getparm(infile)),2); {y1}
          tstr5:=meganum(str2int(getparm(infile)),2); {hotkey}
          tstr6:=meganum(str2int(getparm(infile)),1); {flags}
          tstr8:=getparm(infile);
          tstr9:='<>'+getparm(infile);
          tstr10:='<>'+getparm(infile);
          str2text(tstr1+tstr2+tstr3+tstr4+tstr5+tstr6+'0');
          str2text(tstr8);
          str2text(tstr9);
          str2text(tstr10);
        end;
{*} 52: begin  {RIP_COPY_REGION}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|1G');
          tstr1:=meganum(str2int(getparm(infile)),2); {x0}
          tstr2:=meganum(str2int(getparm(infile)),2); {y0}
          tstr3:=meganum(str2int(getparm(infile)),2); {x1}
          tstr4:=meganum(str2int(getparm(infile)),2); {y1}
          tstr5:=getparm(infile); {dest_line}
          str2text(tstr1+tstr2+tstr3+tstr4+'00'+tstr5);
        end;

(*
{ 50:}  'RIP_DEFINE',
{ 51:}  'RIP_QUERY',
{ 52:}  'RIP_COPY_REGION',
{ 53:}  'RIP_READ_SCENE',
{ 54:}  'RIP_FILE_QUERY',
{ 55:}  'RIP_ENTER_BLOCK_MODE',
*)
{*} 56: begin                                   {RIP_NO_MORE}
          if not rip then str2text(crlf+'!');
          rip:=true;
          str2text('|#');
        end;

  end;
end;

begin
  new(msgtext); offset:=0;
  validsysmsg:=false;
  makelangfile:=false;
  ercomp:=false;
  linecount:=1; writeln;
  textattr:=yellow; writeln(progname,' ',version);
  textattr:=lightmagenta; writeln('Copyright 1995 Whirlwind Software     All Rights Reserved');
  textattr:=cyan; writeln;
  if paramcount=0 then fatalerror('Required Filename Missing');
  textattr:=lightblue;
  writeln('ASCII/ANSI Language File...');
  textattr:=blue;
  writeln('ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ');

  infname:=paramstr(1);
  fsplit(infname,crap1,crap2,crap3);
  if
    crap3=''
  then
    infname:=crap1+crap2+'.TXL'
  else
    infname:=crap1+crap2+crap3;
  outfname:=crap1+crap2+'.LNG';
  infname:=upcasestr(infname);
  outfname:=upcasestr(outfname);
  if exist(outfname) then begin assign(junkfile,outfname); erase(junkfile); end;
  if outfname=tmpname then fatalerror('Cannot Compile to Temporary File Only');
  if infname=outfname then fatalerror('Cannot Compile Source to Itself');
  if not exist(infname) then fatalerror('Input file '+infname+' does not exist');
  maxline:=linecount2(infname);
  ercomp:=true;
  textattr:=lightcyan;

  assign(infile,infname);
  settextbuf(infile,buf);
  linecount:=1;
  reset(infile);

  textattr:=cyan;
  write(' žžž Compiling Language File ');
  textattr:=yellow;
  write(infname);
  textattr:=cyan;
  writeln('...');
  textattr:=lightcyan;

  idxfname:=crap1+crap2+'.LDX';

  ercomp:=true; parsing:=false; pfirst:=false;

  repeat
    if not(parsing and not(pfirst)) then read(infile,tch);
    case tch of
      '[':begin rip:=false; parsing:=true; pfirst:=true; process_verb(infile); end;
      ']':begin rip:=false; if parsing then parsing:=false else char2text(']'); end;
      #13:begin
            gotoxy(1,wherey);
            inc(linecount);
            textattr:=cyan;
            write(' žžž Complete: ');
            textattr:=lightcyan;
            write(percent(linecount));
            if validsysmsg and (not parsing) then char2text(#13);
          end;
    else
      if
        parsing
      then
        begin
          process_VERB(infile)
        end
      else
        begin
          if validsysmsg then char2text(tch);
        end
    end;
  until eof(infile);
  close(infile);
  writeln;
  textattr:=lightcyan;
  if
    makelangfile
  then
    begin
      textattr:=cyan;
      write(' žžž Writing Language Index File ');
      textattr:=lightcyan;
      writeln(upcasestr(idxfname));
      assign(idxfile,idxfname);
      rewrite(idxfile);
      write(idxfile,indexarray);
      close(idxfile);
    end;
  assign(outfile,outfname);
  rewrite(outfile,1);
  blockwrite(outfile,msgtext^,offset+1);
  close(outfile);
  textattr:=cyan;
  writeln(' žžž Done!  RNU language file ',infname,' compiled to ',outfname);

  textattr:=lightgray;
end.
