unit sys_msg; {Special mods for Rancho - only half as big as NanoBBS}

interface
{$O+,F+}

type idxarraytype=array[1..1500] of word;
     langbuftype=array[0..44000] of char;
var  langbuf:^langbuftype;
     langidx:^idxarraytype;
     langoffset:word;
     parameter:array[1..30] of string[80];


procedure loadlanguage(s:string);
procedure sysmsg(n:word);
function  g_sysmsg(n:word):string; {Gets up to 255 chars from a sysmsg}
procedure srchrepl(var s:string; srch,repl:string);

implementation

uses dos,crt,bbskv,bbskern,engine2,rgoods;

procedure srchrepl(var s:string; srch,repl:string);
var i:integer;
    ss:string;
begin
  ss:=upcasestr(s); srch:=upcasestr(srch);
  if srch=upcasestr(repl) then exit;
  i:=pos(srch,ss);
  while i<>0 do
    begin
      delete(s,i,length(srch));
      insert(repl,s,i);
      delete(ss,i,length(srch));
      insert(repl,ss,i);
      i:=pos(srch,ss);
    end;
end;

procedure sysmsg(n:word);
var v,x,y,z:char;
    offset:word;
    w:byte;
    s:string[12];
    i,j,gsys:word;
begin
(*  abort:=false; nonstop:=false;*)
{  totallines:=0;}
  autowrap:=false; autocol:=70;
  offset:=langidx^[n]; if langbuf^[offset]=null then exit;
  repeat
    x:=langbuf^[offset];
    case x of
      '~',
      '',
      #96: begin
             if
               (offset<44000)
             then
               if
                 (langbuf^[offset+1]<>#0)
               then
                 begin
                   inc(offset); if offset>44000 then exit;
                   y:=langbuf^[offset];
                   case y of
                     #00:exit;
(*                     'm' : begin
                             inc(offset);
                             if (offset>44000) then exit;
                             z:=langbuf^[offset];
                             if z=#00 then exit;
                             process_m(z);
                           end;
                     'U',
                     'u' : begin
                             inc(offset);
                             if (offset>44000) then exit;
                             z:=langbuf^[offset];
                             if z=#00 then exit;
                             process_u(z);
                           end;
                     'Q',
                     'q' : begin
                             inc(offset);
                             if (offset>44000) then exit;
                             z:=langbuf^[offset];
                             if z=#00 then exit;
                             process_q(z);
                           end;   *)
                     'k' : begin {Process recurse to another sysmsg}
                             s:='';
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             dec(offset); {backup over terminating char}
                             gsys:=str2int(s);
                             sysmsg(gsys);
                           end;
                     't' : begin {Process tab to column}
                             s:='';
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             dec(offset);  {Back up over terminating char}
                             gsys:=str2int(s);
                             if wherex<gsys then repeat send(' ') until wherex=gsys;
                           end;
                     'T' : begin {Process tab to column with fill char}
                             s:='';  {e.g. `T.50 fill to col. 50 with '.'}
                             inc(offset); if (offset>44000) then exit;
                             v:=langbuf^[offset]; {The fill char}
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             dec(offset);  {Back up over terminating char}
                             gsys:=str2int(s);
                             if wherex<gsys then repeat send(v) until wherex=gsys;
                           end;
                     'w' : begin {Wait x millieconds}
                             s:='';  {e.g. `w500 wait 1/2 second}
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             dec(offset);  {Back up over terminating char}
                             gsys:=str2int(s);
                             if gsys>0 then delay(gsys);
                             totallines:=0;
                           end;
                     'S' : begin {Right Justify parameter}
                             s:='';  {e.g. `T.2/60 Justify to col. 60 with '.'}
                             inc(offset); if (offset>44000) then exit;
                             v:=langbuf^[offset]; {The fill char}
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             i:=str2int(s); {variable # to pad}
                             s:='';
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if z=#00 then exit;
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (s[0]>#11);
                             j:=str2int(s); {column to goto}
                             dec(offset);  {Back up over terminating char}
                             gsys:=j-length(parameter[i]); if gsys>80 then gsys:=80;
                             if wherex<gsys then repeat send(v) until wherex=gsys;
                             send(parameter[i]);
                           end;
                     '#':com_tx(#7);  {Send a beep out the m0dem}
                     '.':send(int2str(n));
                     ':':begin   {CR ***ONLY***}
                           write(#13);
                           com_tx(#13);
                         end;
                     '&':begin
                           s:='';
                           repeat
                             inc(offset);
                             if (offset>44000) then exit;
                             z:=langbuf^[offset];
                             if z=#00 then exit;
                             if isnum(z) then s:=s+z;
                           until not(isnum(z)) or (s[0]>#11);
                           dec(offset);  {Back up over terminating char}
                           gsys:=str2int(s);
                           if
                             (gsys>20)
                           and
                            (gsys<79)
                           then
                             begin
                               autowrap:=true; autocol:=gsys;
                             end;
                         end;
                     ',':if wherex<>1 then sendln('');
                     ';':begin  {Threecolumn automatic!}
                           if
                             wherex>54
                           then
                             sendln('')
                           else
                             if
                               wherex>27
                             then
                               begin
                                 repeat send(' ') until wherex=54;
                               end
                             else
                               if wherex<>27 then repeat send(' ') until wherex=27;
                         end;
                     '^':if  {Twocolumn automatic!}
                           wherex>=40
                         then
                           sendln('')
                         else
                           repeat send(' ') until wherex=40;
                     '$':send(version);
                     'R':anykey;
                     '*':if wherex=1 then quitnow:=true;
                     '~','`','',
                     '/',
                     'þ',
                     '<','>',
                     '(',')',
                     '{','}',
                     '1'..'7',
                     'a'..'h',
                     'A'..'P',
                     'W'..'Z': changecolour(y);
                     'V' : begin {Variables}
                             s:='';
                             repeat
                               inc(offset);
                               if (offset>44000) then exit;
                               z:=langbuf^[offset];
                               if isnum(z) then s:=s+z;
                             until not(isnum(z)) or (z=#0) or (s[0]>#11);
                             dec(offset);  {Back up over terminating char}
                             gsys:=str2int(s);
                             if (gsys>0) and (gsys<31) then send(parameter[gsys]);
                           end;
                   end;
                 end;
           end;
      #32: if
             autowrap and (wherex>=autocol)
           then
             sendln('')
           else
             send(' ');
      #10 :begin end;
      #13: begin
             sendln('');
           end;
    else
      begin
        write(x);
        com_tx(x);
      end;
    end;
    inc(offset);
  until (offset>44000) or (langbuf^[offset]=null) or quitnow;
end;

procedure loadlanguage(s:string);
var idxfile:file of idxarraytype;
    datfile:file of langbuftype;
    crap:word;
    ctmp:char;
    index:longint;
begin
  fillchar(langbuf^,sizeof(langbuf^),#00);
  fillchar(langidx^,sizeof(langidx^),#00);
  filemode:=0;
{$I-}
  assign(idxfile,s+'.LDX');
  reset(idxfile);
  crap:=ioresult;
  read(idxfile,langidx^);
  crap:=ioresult;
  close(idxfile);
  crap:=ioresult;
  assign(datfile,s+'.LNG');
  reset(datfile);
  crap:=ioresult;
  read(datfile,langbuf^);
  crap:=ioresult;
  close(datfile);
  crap:=ioresult;
{$I+}
  filemode:=2;
end;

function  g_sysmsg(n:word):string; {Gets up to 255 chars from a sysmsg}
var offset:word;
    t:string;
    tch:char;
    d:byte absolute t;
begin
  offset:=langidx^[n]; t:='';
  tch:=langbuf^[offset];
  while not ((tch=#00) or (t[0]>#254)) do
    begin
      inc(d); t[d]:=tch;
      inc(offset);
      tch:=langbuf^[offset];
    end;
  srchrepl(t,'`V1',parameter[1]);
  srchrepl(t,'`V2',parameter[2]);
  srchrepl(t,'`V3',parameter[3]);
  srchrepl(t,'`V4',parameter[4]);
  srchrepl(t,'`V5',parameter[5]);
  srchrepl(t,'`V6',parameter[6]);
  srchrepl(t,'`V7',parameter[7]);
  srchrepl(t,'`V8',parameter[8]);
  srchrepl(t,'`V9',parameter[9]);
  g_sysmsg:=t;
end;

begin
  new(langidx);
  new(langbuf);
  loadlanguage('RNGAME');
  totallines:=0;
end.

