unit bbskern;
{$M 65520,0,72000}
{$N-}
{$V-}
{$A-}
{$F+}
interface
uses dos,crt,bbskv,protcomm;
var xzvar:byte;
    lastattr:byte;


procedure csend(c:char);
procedure nocarrier;
function  lostcarrier:boolean;
procedure sendansi(code:string);
procedure changecolour(c1:char);
function  secondstoday:longint;
function  sec70:longint;
function  charwaiting:boolean;
function  d70(year,month,day:word):longint; {Returns a day count since 70/01/01}
                                            {Called by function DS1970}
function  ds1970:longint; {Returns the current day since 70/01/01}
function  IsStrNumber(s:string):boolean;
function  zeropad(s:string):string;
function  sec2hms(s:longint):string;
function  inevent(start,finish:longint):boolean;
function  converttime(secondnumber:longint; ttype:integer):string; {returns the time of day}
function  convertdate(daynumber:longint; dtype:integer):string;
function  secondsonline:longint; {Returns the number of seconds since connection}
procedure n1;
procedure delayX(ms:word);
procedure timeslice;
function  dcd:boolean;
function  charinbuffer:boolean;
function  outbufnotfull:boolean;
function  addslash(idir:string):string;
function  stripslash(idir:string):string;
(*procedure smartwrap(teststr:string);*)
Procedure Dtr (PortNumber : Integer; State : boolean);
procedure send(txt:string);
procedure sendln(txt:string);
function  upcasestr(lstring:string):string;
function  int2str(inint:longint):string;
function  str2int(s:string):longint;
procedure com_TX(character:char);
function  com_RX:char;
function  scond:longint;
procedure setattr(c:byte); {Performs changecolour necessary to achieve a given textattr}
function  more:boolean;
procedure swallowbuffer;
procedure sendlnlocal(txt:string);
procedure sendlocal(txt:string);
function  locasestr(lstring:string):string;
function  locase(c:char):char;
function  exist(filename:dos.pathstr):boolean;
procedure w(s:String);
procedure wln(s:String);
procedure eswap(cmd,prm:string);

implementation

uses engine2,rgoods,sys_msg,execswap;

procedure eswap(cmd,prm:string);
type screenbuf=array[1..2000] of word;
var btmp:boolean;
    res:word;
    swapname:string[80];
    s2:^screenbuf;
    screen:screenbuf absolute $B800:0000;
    sx,sy,sa:byte;
begin
  swapname:='SWAP0000.TMP';
  execswap.useemsifavailable:=false;
  sa:=textattr; sx:=wherex; sy:=wherey;
  if sy=25 then begin writeln; sy:=24; end;
  new(s2);
  s2^:=screen;
  textattr:=black;
  btmp:=execswap.InitExecSwap(heapptr,swapname);
  swapvectors;
  res:=execswap.ExecWithSwap(cmd,prm);
  swapvectors;
  execswap.ShutdownExecSwap;
  screen:=s2^;
  dispose(s2);
  textattr:=sa;
  gotoxy(sx,sy);
  if res<>0 then sendln('`,'+crlf+'`JWarning: Error Code '+int2str(res));
end;

procedure nocarrier;
begin
  textattr:=yellow;
  ignorecarrier:=true;
  localmode:=true;
  sendlnlocal('');
  sendlnlocal('`L`b`6ÛßßßßßßßßßßßßßßßßßßßßßßÛ`7');
  sendlnlocal('`L`b`6Û `7`L`bCARRIER LOST ON COM'+int2str(comport)+' `L`b`6Û`7');
  sendlnlocal('`L`b`6ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ`7');
  delay(2500);
  quitnow:=true;
  halt;
end;

procedure csend(c:char);
begin
  if not (noecho or directmode) then write(c);
  com_tx(c);
end;

function lostcarrier:boolean;
begin
  if ignorecarrier then lostcarrier:=false else lostcarrier:=not dcd;
end;

function charwaiting:boolean;
begin
  if
    (dcd and charinbuffer and not(consoleonly))
  or
    keypressed
  then
    charwaiting:=true
  else
    charwaiting:=false
end;

function IsStrNumber(s:string):boolean;
const nums=['0'..'9','-','+','E',' '];
var tmp:boolean;
    index:integer;
    x:char;
begin
  tmp:=true;
  for index:=one to length(s) do
    begin
      x:=s[index];
      if not (x in nums) then tmp:=false;
    end;
  IsStrNumber:=tmp;
end;

procedure setmonth;
var crap,year:word;
begin
  getdate(year,crap,crap,crap);
  mon[1]:=31;  mon[2]:=28;  mon[3]:=31;  mon[4]:=30;
  mon[5]:=31;  mon[6]:=30;  mon[7]:=31;  mon[8]:=31;
  mon[9]:=30; mon[10]:=31; mon[11]:=30; mon[12]:=31;
  if (year mod 4)=0 then mon[2]:=29;
end;

function secondstoday:longint; {Returns the number of seconds since 12:00mn}
var h,m,s,o:word;
    h1,m1,s1:longint;
    tmpix:longint;
begin
  tmpix:=0;
  gettime(h,m,s,o);
  h1:=h; m1:=m; s1:=s;
  tmpix:=s1+(m1*60)+(h1*3600);
  secondstoday:=tmpix;
end;

function d70(year,month,day:word):longint;
var ds70,m,index:longint;
    ys70:integer;
begin
  ds70:=0;
  if
    year>=1970
  then
    begin
      ds70:=0; ys70:=0;
      setmonth;
      index:=1970;
      ys70:=year-index;
      repeat
        begin
          if
            (index mod 4)=0
          then
            ds70:=ds70+366
          else
            ds70:=ds70+365;
          inc(index);
        end;
      until index=year;
      index:=1;
      while index<month do begin ds70:=ds70+mon[index]; inc(index); end;
      ds70:=ds70+day;
    end;
  d70:=ds70;
end;

function ds1970:longint; {Returns the current day since March 1, 1970}
var year,month,day,dotw:word;
    ds70,m:longint; ys70:integer;
    index:longint;
begin
  getdate(year,month,day,dotw);
  ds1970:=d70(year,month,day);
end;

function secondsonline:longint; {Returns the number of seconds since connection}
var tmp:longint;
begin
  tmp:=0;
  tmp:=secondstoday-logonsecond;
  if (tmp<0) then tmp:=tmp+86400;
  secondsonline:=tmp;
end;

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

function sec2hms(s:longint):string;
var tmp:string;
begin
  tmp:=zeropad(int2str(s div 3600))+':'+zeropad(int2str((s mod 3600) div 60))+':'
       +zeropad(int2str(s mod 60));
  sec2hms:=tmp;
end;

function inevent(start,finish:longint):boolean;
var now:longint;
begin
  if
    (start=0) and (finish=0)
  then
    inevent:=true
  else
  begin
    now:=secondstoday;
    if
      start>finish   {If the event spans across midnight}
    then
      begin
        if now>start then now:=now-86400;
        start:=start-86400;  {Then treat the start time as a negative number}
      end;
    if
      (now>=start)
    and
      (now<finish)
    then
      inevent:=true
    else
      inevent:=false;
  end;
end;

procedure strmove(var s:string; d:string);
begin
  s:=d;
end;

function sec70:longint;
begin
  sec70:=(ds1970*86400)+secondstoday;
  {Seconds since January 1, 1970 12:00 midnight}
end;

function converttime(secondnumber:longint; ttype:integer):string; {returns the time of day}
var hour,minute,second,sec100:longint;
    junk:longint;
    meridian:string;
    tmp:string;
    hours,minutes,seconds,sec100s,hour12s:string;
begin
  hour:=0; minute:=0; second:=0;
  hour:=secondnumber div 3600;
  minute:=((secondnumber mod 3600) div 60);
  second:=secondnumber mod 60;
  str(hour,hours);
  hour12s:=hours;
  str(hour mod 12,hour12s);
  meridian:='pm';
  if
    hour12s=hours
  then
    meridian:='am';
  if (hour=0) or (hour=12) then hour12s:='12';
  if (hour<10) then hours:='0'+hours;
  str(minute,minutes);
  if
    (minute<10)
  then
    minutes:='0'+minutes;
  str(second,seconds);
  if
    (second<10)
  then
    seconds:='0'+seconds;
  str(sec100,sec100s);
  if
    sec100<10
  then
    sec100s:='0'+seconds;
  tmp:=hour12s+':'+minutes;
  case ttype of
    1: strmove(tmp,hour12s+':'+minutes);               {12 hour, no secs   }
    2: strmove(tmp,hour12s+':'+minutes+':'+seconds);   {12 hour, with secs }
    3: strmove(tmp,hours+':'+minutes);                 {24 hour, no secs   }
    4: strmove(tmp,hours+':'+minutes+':'+seconds);     {24 hour, with secs }
    5: tmp:=meridian;                                  {AM or PM as apropos}
(*    6: strmove(tmp,hours);                             {The hour, in 24h   }
    7: strmove(tmp,hour12s);                           {The hour, in 12h   }
    8: strmove(tmp,minutes);                           {The minute         }
    9: strmove(tmp,seconds);                           {The second         }
   10: begin        {Seconds since midnight}
         junk:=0;
         junk:=secondstoday;
         str(junk,tmp);
       end;
   11: strmove(tmp,int2str(sec70)); {Seconds since midnight Jan. 1, 1970}
   12: tmp:=int2str(secondnumber div 3600); {Hours user has been online}
   13: tmp:=int2str(secondnumber div 60); {Minutes user has been online}
   14: tmp:=int2str(secondnumber); {Total seconds user has been online}
   15: tmp:=int2str((secondnumber mod 3600) div 60); {Minute component of}
                                                       {users time online}
   16: tmp:=int2str(secondnumber mod 60); {Second component of users time online}
   17: tmp:=hours+':'+minutes+':'+seconds; *)
  end; {case}
  converttime:=tmp;
end; {function converttime}

function convertdate(daynumber:longint; dtype:integer):string;
var thisyear,thismonth,thisdate,thisday:word;
    thistmp:word;
    tmp:string; csis,index:integer; test:boolean;
begin
  setmonth;
  thisyear:=1970+((daynumber*100)-26) div 36525;
  thistmp:=(((daynumber*100)-26) mod 36525) div 100;
  csis:=thistmp; test:=false;
  index:=0;
  repeat
    begin
      inc(index);
      if
        csis<mon[index]
      then
        test:=true
      else
        csis:=csis-mon[index];
    end;
  until test;
  thisdate:=csis;
  thismonth:=index;
  if
    thisdate=0
  then
    begin
      dec(thismonth); if thismonth=0 then begin thismonth:=12; dec(thisyear); end;
      thisdate:=mon[thismonth];
    end;
  thisday:=(daynumber+3) mod 7;

  case DTYPE of
  1:  begin  { CENTURY }
        strmove(tmp,'20');
        if
          (thisyear<2000)
        then
          strmove(tmp,'19');
      end;
  2:  begin  { YEAR }
        str(thisyear,tmp);
        tmp:=copy(tmp,3,2);
      end;
  3:  begin { MONTH with zero padding }
        str(thismonth,tmp);
        if
          thismonth<10
        then
          strmove(tmp,'0'+tmp);
      end;
(*  4:  str(thismonth,tmp); { MONTH without zero padding }*)
  7:  begin { DATE with zero padding }
        str(thisdate,tmp);
        if
          thisdate<10
        then
          strmove(tmp,'0'+tmp);
      end;
(*  8:  str(thisdate,tmp); { DATE without zero padding }
  9:  begin { DATE ORDINAL SUFFIX }
        strmove(tmp,'th');
        case THISDATE of
        1,21,31: strmove(tmp,'st');
        2,22   : strmove(tmp,'nd');
        3,23   : strmove(tmp,'rd');
        end; {case thisdate}
      end;*)
  end; {major case}
  convertdate:=tmp;
end;

function chksec:boolean;
var sec,shit:word;
    tmp:boolean;
begin
  tmp:=false;
  gettime(shit,shit,sec,shit);
  if
    not(sec=lsecond)
  then
    tmp:=true;
  if
    lsecond>sec
  then
    newminute:=true;
  lsecond:=sec;
  chksec:=tmp;
end;

procedure n1;
begin
  timeslice;
end;

procedure delayX(ms:word);
var index: word;
begin
  for
    index:=1 to ms
  do
    begin
      n1;
      delay(1);
    end;
end;

procedure timeslice;
var regs:registers;
begin
  if
    desqview and dvblog
  then
    inline($50/                     { push  ax        }
           $b8/$1a/$10/             { mov   ax,101a   }
           $cd/$15/                 { int   15        }
           $b8/$00/$10/             { mov   ax,1000   }
           $cd/$15/                 { int   15        }
           $b8/$25/$10/             { mov   ax,1025   }
           $cd/$15/                 { int   15        }
           $58);                    { pop   ax        }
end;

function dcd:boolean;
begin
  dcd:=false;
  if (comport=0) or (baudrate=0) or localmode or consoleonly then exit;
  dcd:=protcomm.comm_carrier;
end;

function charinbuffer:boolean;
begin
  charinbuffer:=protcomm.comm_rx_ready and dcd;
end;

function outbufnotfull:boolean;
begin
  outbufnotfull:=comm_tx_ready and dcd;
end;

function addslash(idir:string):string;
begin
  if (idir[length(idir)]<>'\') then idir:=idir+'\';
  addslash:=idir;
end;

function stripslash(idir:string):string;
begin
  if (idir[length(idir)]='\') then idir[0]:=chr(ord(idir[0])-1);
  stripslash:=idir;
end;

procedure com_tx(character:char);
var c:byte absolute character;
begin
  if consoleonly then exit;
  protcomm.comm_tx(c);
end;

function com_RX:char;
var tmp:char;
    t2:byte absolute tmp;
begin
  com_rx:=#00;
  if consoleonly then exit;
  if not dcd then exit;
  tmp:=#00;
  t2:=protcomm.comm_rx;
  com_rx:=tmp;
end;

{                                                                            }
{ This changes the status of the RS-232's DTR state, either High or Low      }
{                                                                            }
{                                                                            }
procedure dtr(portnumber:integer; state:boolean);
begin
  if state then protcomm.comm_dtr_on else protcomm.comm_dtr_off;
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;

procedure send(txt:string);
var index:word;
    l:byte; tch:char;
begin
  if quitnow then exit;
  index:=1;
  l:=ord(txt[0]);  {Get length of string; it determines how we proceed here}
  if l=0 then exit;  {If zero length then bug out quick}

  if        {we handle single-char strings differently!}
    l=1
  then
    begin
      tch:=txt[1];
      case tch of
        #10: begin end;
        #13: begin
               if not (noecho or directmode) then writeln;
               com_tx(#13); com_tx(#10);
               if not(nomore) then inc(totallines);
               if totallines>21 then begin totallines:=0; more; end;
               nothing; {always give a slice at the end of each line}
             end;
      else
        begin
          csend(tch);
        end;
      end; {case}
    exit;
  end; {if l=1}

  {if the string is non-trivial (4 or more chars) we'll give a slice}
  if l>3 then nothing;

  repeat
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    tch:=txt[index];
    case tch of
      '~','`','':begin
                inc(index);
                if
                  index>l
                then
                  exit
                else
                  changecolour(txt[index]);
              end;
      #10: begin end; {Do nothing with LF; lines are terminated with CR}
      #13: begin
             if not (noecho or directmode) then writeln;
             com_tx(#13); com_tx(#10); {Send out both a CR and LF}
             if not(nomore) then inc(totallines);
             if totallines>21 then begin totallines:=0; more; end;
             nothing; {always give a slice at the end of each line}
           end;
      #32: if
             (autowrap)
           and
             (wherex>autocol)
           then
             sendln('')
           else
             begin
               csend(#32);
             end;
    else
      begin
        csend(tch);
      end;
    end; {case}
    inc(index);
  until (index>l) or quitnow or lostcarrier;
end;

procedure sendlocal(txt:string);
var tco,tic:boolean;
begin
  tco:=consoleonly;
  tic:=ignorecarrier;
  ignorecarrier:=true;
  consoleonly:=true;
  send(txt);
  consoleonly:=tco;
  ignorecarrier:=tic;
end;

procedure sendln(txt:string);
begin
  send(txt+crlf);
end;

procedure sendlnlocal(txt:string);
begin
  sendlocal(txt+crlf);
end;

function scond:longint;
var d,h,m,s,o,tmp:word;
begin
  getdate(tmp,tmp,d,tmp);
  gettime(h,m,s,o);
  tmp:=s+(m*60)+(h*3600)+(d*86400);
  scond:=tmp;
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 locase(c:char):char;
begin
  case c of
    'A'..'Z':locase:=chr(ord(c)+32);
  else
    locase:=c;
  end;
end;

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

procedure sendansi(code:string);
var echotemp:boolean;
begin
  if not ansi then exit;
  echotemp:=noecho;
  noecho:=true;
  send(code);
  noecho:=echotemp;
end;

procedure setattr(c:byte); {Performs changecolour necessary to achieve a given textattr}
var fore:byte;
    back:byte;
    blink:boolean;
    tstr:string[16];
begin
  fore:=c and $0f;
  back:=(c and $70) shr 4;
  blink:=(c and $80)<>0;
  case fore of
    0:tstr:='`A';
    1:tstr:='`E';
    2:tstr:='`C';
    3:tstr:='`G';
    4:tstr:='`B';
    5:tstr:='`F';
    6:tstr:='`D';
    7:tstr:='`H';
    8:tstr:='`I';
    9:tstr:='`M';
    10:tstr:='`K';
    11:tstr:='`O';
    12:tstr:='`J';
    13:tstr:='`N';
    14:tstr:='`L';
    15:tstr:='`P';
  end;
  case back of
    0: tstr:=tstr+'`a';
    1: tstr:=tstr+'`e';
    2: tstr:=tstr+'`c';
    3: tstr:=tstr+'`g';
    4: tstr:=tstr+'`b';
    5: tstr:=tstr+'`f';
    6: tstr:=tstr+'`d';
    7: tstr:=tstr+'`h';
  end;
  if
    blink
  then
    tstr:=tstr+'`6';
  send(tstr);
end;

procedure changecolour(c1:char);
var
  bg,fg,col,line:integer;
  n1,n2:string;
begin
  if directmode then exit; {NO colours in direct mode!}
  if not blinkhere then textattr:=(textattr and $7F);
  lastcolour:=c1;
  bg:=textattr div 16;
  fg:=textattr mod 16;
    case C1 of
      {Special Effects}

      #96: csend(#96);
      #126: csend(#126);
      'þ' : begin totallines:=0; send('`Eþ`Mþ`Oþ`P]`L '); end;
      '{','[' : begin
              lastattr:=textattr;
              if
                ansi
              then
                send('`O`gÝ`P`g') { Quicky ansi3d start/end tokens }
              else
                send('*');
            end;
      '}',']' : begin
              if
                ansi
              then
                send('`E`gÞ`a`1')
              else
                send('*');
              if ansi then setattr(lastattr);
            end;
      '(' : begin
              lastattr:=textattr;
              if
                ansi
              then
                send('`P`hÝ`7`A`h') { Quicky ansi3d start/end tokens }
              else
                send('[');
            end;
      ')' : begin
              if
                ansi
              then
                send('`I`hÞ`a`1')
              else
                send(']');
              if ansi then setattr(lastattr);
            end;
      '<' : begin
              lastattr:=textattr;
              if
                ansi
              then
                send('`J`bÝ`7`P`b') { Quicky ansi3d start/end tokens }
              else
                send('[');
            end;
      '>' : begin
              if
                ansi
              then
                send('`I`bÞ`a`1')
              else
                send(']');
              if ansi then setattr(lastattr);
            end;
      {ANSI control and cursor positioning }

      '1' : begin  {ANSI cleol}
              if localansi then clreol;
              if ansi then sendansi(ansicleol);
            end;
      '2' : begin  {ANSI cls}
              if localansi then clrscr;
              if ansi then sendansi(ansicls);
              totallines:=0;
            end;
      '3' : begin  {ANSI Save Cursor Position}
              asx:=wherex;
              asy:=wherey;
              if ansi then sendansi(ansiscp);
            end;
      '4' : begin  {ANSI Restore Cursor Position}
              gotoxy(asx,asy);
              if ansi then sendansi(ansircp);
            end;
      '5' : sendansi(ansidsr);
      '6' : begin  {ANSI blink attribute}
              if localansi then textattr:=(textattr or blink);
              if ansi then sendansi(ansiblinkon);
            end;
      '7' : begin  {Clear all ANSI attributes}
              if localansi then textattr:=lightgray;
              if ansi then sendansi(ansiclrattr);
            end;


      {ANSI colour control }

      'a' : begin  {ANSI background black}
              if localansi then textattr:=fg+16*black;
              if ansi then sendansi(ansibgblack);
            end;
      'b' : begin  {ANSI background red}
              if localansi then textattr:=fg+16*red;
              if ansi then sendansi(ansibgred);
            end;
      'c' : begin  {ANSI backround green}
              if localansi then textattr:=fg+16*green;
              if ansi then sendansi(ansibggreen);
            end;
      'd' : begin
              if localansi then textattr:=fg+16*brown;
              if ansi then sendansi(ansibgbrown);
            end;
      'e' : begin
              if localansi then textattr:=fg+16*blue;
              if ansi then sendansi(ansibgblue);
            end;
      'f' : begin
              if localansi then textattr:=fg+16*magenta;
              if ansi then sendansi(ansibgmagenta);
            end;
      'g' : begin
              if localansi then textattr:=fg+16*cyan;
              if ansi then sendansi(ansibgcyan);
            end;
      'h' : begin
              if localansi then textattr:=fg+16*lightgray;
              if ansi then sendansi(ansibggray);
            end;

      'A' : begin
              if localansi then textattr:=(16*bg)+black;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgblack);
            end;
      'B' : begin
              if localansi then textattr:=(16*bg)+red;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgred);
            end;
      'C' : begin
              if localansi then textattr:=(16*bg)+green;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifggreen);
            end;
      'D' : begin
              if localansi then textattr:=(16*bg)+brown;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgbrown);
            end;
      'E' : begin
              if localansi then textattr:=(16*bg)+blue;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgblue);
            end;
      'F' : begin
              if localansi then textattr:=(16*bg)+magenta;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgmagenta);
            end;
      'G' : begin
              if localansi then textattr:=(16*bg)+cyan;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgcyan);
            end;
      'H' : begin
              if localansi then textattr:=(16*bg)+lightgray;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifggray);
            end;
      'I' : begin
              if localansi then textattr:=(16*bg)+darkgray;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgdkgray);
            end;
      'J' : begin
              if localansi then textattr:=(16*bg)+lightred;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgltred);
            end;
      'K' : begin
              if localansi then textattr:=(16*bg)+lightgreen;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgltgreen);
            end;
      'L' : begin
              if localansi then textattr:=(16*bg)+yellow;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgyellow);
            end;
      'M' : begin
              if localansi then textattr:=(16*bg)+lightblue;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgltblue);
            end;
      'N' : begin
              if localansi then textattr:=(16*bg)+lightmagenta;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgltmagenta);
            end;
      'O' : begin
              if localansi then textattr:=(16*bg)+lightcyan;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgltcyan);
            end;
      'P' : begin
              if localansi then textattr:=(16*bg)+white;
              if not(doingansi) then sendansi(ansiclrattr);
              if ansi then sendansi(ansifgwhite);
            end;
      'w'..'z','W'..'Z':process_imbedded(C1);
       end;

end;

function more:boolean;
var tmp:boolean;
    tch:char;
    lc:char;
begin
  abort:=false;
  totallines:=0;
  lc:=lastcolour;
  tmp:=false;
  ansi3dn(' More? ');
  nocr:=true; yndefault:=true;
  if lostcarrier then begin nocarrier; exit; end;
  tch:=yn;
  if lostcarrier then begin nocarrier; exit; end;
  if
    tch='Y'
  then
    begin
      tmp:=true;
      repeat send (#8#32#8) until wherex=1;
    end
  else
    begin
      abort:=true;
      sendln('');
    end;
  changecolour(lc);
  more:=tmp;
end;

procedure swallowbuffer;
var  tch:char;
begin
  while (dcd or ignorecarrier) and charinbuffer do tch:=com_rx;
end;

function  exist(filename:dos.pathstr):boolean;
begin
  Exist:=fSearch(filename,'')<>'';
end;

procedure w(s:String);
begin
	totallines:=0;
	sendlocal(s);
end;

procedure wln(s:String);
begin
	totallines:=0;
	sendlnlocal(s);
end;

begin
  consoleonly:=true;
  ignorecarrier:=true;
  abort:=true;
  lf:=true;
  noecho:=false;
  echochar:=chr(11);
  ansi:=true;
  minimuminput:=2;
  maximuminput:=80;
  baudrate:=57600;
  directvideo:=true;
  debugmode:=false;
end.
