unit engine2; (* SPECIALLY HACKED FOR RANCHO NEVADA *)
{$V-}
{$A-}
{$O+,F+}
interface

uses bbskv;

TYPE
  ansidat = array[1..8] of integer;
  s16 = string[16];
const
  maxlin=72;
  one=1;
  zero=0;
  hell=FALSE;
  frozenover=TRUE;
  bell=chr(7);
  backspace=chr(8);
  linefeed=chr(10);
  carriagereturn=chr(13);

var
  tch:char;

  bsx,bsy,asx,asy:integer;
  savex,savey:integer;
  gotansi:boolean;

  intensity:boolean;
  cdata:ansidat;
  currentfiledate:longint;

{  (C) 1993/94 Whirlwind Software       ALL RIGHTS RESERVED              }

procedure nothing;
function f_size(fnm:string):longint;
procedure process_ANSI(var tfile:text); {Processes embedded ANSI codes}
function  getchr:char;
function  getln1:string;
procedure cardiac;
function  f_date(fnm:string):longint;
Function  HexLong(Number: LongInt): String;
procedure dumbwrap(s:string);
Function  HexByte(Number: Byte): String;
Function  HexStr(Number: Word): String;

implementation

uses dos,crt,bbskern,rgoods,sys_msg;

procedure cardiac;
begin
  sysmsg(359);
  quitnow := True;
end;

function readf(var tfile:textf):char;
var tmp:char;
begin
  read(tfile,tmp);
  readf:=tmp;
end;

procedure ripansicodes(x:s16);
var index,oldindex:byte;
    count:byte;
    temp:string;
    tch:char;
begin
  count:=1;
  index:=1; oldindex:=1;
  while index<=length(x) do
    begin
      temp:='';
      repeat
        tch:=x[index];
        if tch<>';' then temp:=temp+tch;
        inc(index);
      until (tch=';') or (index>length(x));
      cdata[count]:=str2int(temp);
      inc(count);
    end;
end;

function cins(s:string; c:char):boolean;
var tb:boolean;
    i: byte;
begin
  tb:=false;
  i:=1;
  repeat
    if
      c=s[i]
    then
      tb:=true;
    inc(i);
  until (tb=true) or (i>length(s));
  cins:=tb;
end;

procedure process_ANSI(var tfile:text); {Processes embedded ANSI codes}
const ansicmds = 'HfABCDsuJKm';
      ansiprfx = esc+'[';
var chrin,tch,tch1:char;
    thiscode:s16;
    index:integer;
    command:char;
    line:integer;
begin
  doingansi:=true; {Set changecolour mode to ANSI rules}
  for index:=1 to 8 do cdata[index]:=-1;
  thiscode[0]:=chr(0);  { Initialize the temporary string! }

  chrin:=readf(tfile);
  if
    (chrin<>'[') { Make sure this is a real ANSi code }
  then           { as SendText only checks for ESC    }
    begin
      send(esc+chrin);  { It's not an ANSi code, so we'll display what we got }
      doingansi:=false; { reset our default changecolour mode                 }
      exit;             { and get out of the ANSi processor                   }
    end
  else
    begin               { We got ESC [ so we know this is a valid ANSi code;  }
      repeat            { This block will read the rest of the code and act   }
        chrin:=readf(tfile);
        thiscode:=thiscode+chrin;
      until (eof(tfile)) or (thiscode[0]>=chr(16)) or cins(ansicmds,chrin);
      if
        thiscode[0]>=chr(16)       { If we overran the 16 char limit... }
      then
        begin
          send(ansiprfx+thiscode); { ...then send what we got... }
          doingansi:=false;        { ...reset changecolour mode..}
          exit;                    { ...And forget about it.     }
        end
      else
        begin
          index:=ord(thiscode[0]);   { Quickly get the size of ThisCode  }
          command:=thiscode[index];  { The ANSi command is the last chr  }
          dec(index);
          thiscode:=copy(thiscode,1,index);
          case COMMAND of
            'm' : begin   {Colour Codes}
                    index:=1;
                    ripansicodes(thiscode);
                    blinkhere:=false;
                    repeat
                      begin
                        case cdata[index] of
                         -1: nothing; {-1 indicates no more data}
                          0: begin  {Clr Attrs}
                               intensity:=false;
                               changecolour('7');
                               textattr:=lightgray;
                             end;
                          1: begin
                               intensity:=true;
                               textattr:=textattr or 8; { add brightness }
                               sendansi(ansiprfx+'1m');
                             end;
                          4: nothing;
                          5: begin
                               changecolour('6'); {Blink}
                               blinkhere:=true;
                               if debugmode then writeln('Blink!');
                             end;
                          7: nothing;
                          8: nothing;
                         30: if intensity then changecolour('I') else changecolour('A');
                         31: if intensity then changecolour('J') else changecolour('B');
                         32: if intensity then changecolour('K') else changecolour('C');
                         33: if intensity then changecolour('L') else changecolour('D');
                         34: if intensity then changecolour('M') else changecolour('E');
                         35: if intensity then changecolour('N') else changecolour('F');
                         36: if intensity then changecolour('O') else changecolour('G');
                         37: if intensity then changecolour('P') else changecolour('H');
                         40: changecolour('a');
                         41: changecolour('b');
                         42: changecolour('c');
                         43: changecolour('d');
                         44: changecolour('e');
                         45: changecolour('f');
                         46: changecolour('g');
                         47: changecolour('h');
                        end; {case}
                        inc(index);
                      end; {repeat loop}
                    until (index>8) or (cdata[index]=-1);
                  end; {case of 'm'}
            'H' : begin {H- Absolute cursor position}
                    ripansicodes(thiscode);
                    gotoxy(cdata[2],cdata[1]);
                    sendansi(ansiprfx+thiscode+command);
                  end;
            'f' : begin {f- Absolute cursor position - same as 'H'}
                    ripansicodes(thiscode);
                    gotoxy(cdata[2],cdata[1]);
                    sendansi(ansiprfx+thiscode+command);
                  end;
            's' : begin {'s' Save Cursor Position}
                    asx:=wherex;
                    asy:=wherey;
                    sendansi(ansiscp);
                  end;
            'u' : begin {'u' Restore Cursor Position}
                    gotoxy(asx,asy);
                    sendansi(ansircp);
                  end;
            'J' : begin {'2J' Erase Display.  Ignores the '2'}
                    clrscr;
                    sendansi(ansicls);
                    totallines:=0;
                  end;
            'K' : begin {'K' Erase Line}
                    clreol;
                    sendansi(ansicleol);
                  end;
            'A' : begin {'A' Cursor Up}
                    ripansicodes(thiscode);
                    line:=cdata[1];
                    if ansi then begin gotoxy(wherex,wherey-line);
                    sendansi(esc+'['+int2str(line)+'A'); end;
                  end;
            'B' : begin {'B' Cursor Down}
                    ripansicodes(thiscode);
                    line:=cdata[1];
                    if ansi then begin gotoxy(wherex,wherey+line);
                    sendansi(esc+'['+int2str(line)+'B'); end;
                  end;
            'C' : begin {'C' Cursor Fwd/Right}
                    ripansicodes(thiscode);
                    line:=cdata[1];
                    if ansi then begin gotoxy(wherex+line,wherey);
                    sendansi(esc+'['+int2str(line)+'C'); end;
                  end;
            'D' : begin {'D' Cursor Back\Left}
                    ripansicodes(thiscode);
                    line:=cdata[1];
                    if ansi then begin gotoxy(wherex-line,wherey);
                    sendansi(esc+'['+int2str(line)+'D'); end;
                  end;
          end; {CASE statement}
        end;
    end; {Code for a valid ANSi code}
  doingansi:=false;
end; {process_ansi}

procedure nothing;
begin

end;

function getchr:char;
var tch:char;
    seconds:longint;
    sec2:longint;
    got:boolean;
begin
  totallines:=0;
  seconds:=sec70;
  got:=false;
  tch:=chr(0);
  repeat
    repeat
      sec2:=sec70;
      if
        (sec2-seconds)>240
      then
        begin
          cardiac;
          exit;
        end
      else
        timeslice;
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    until charwaiting or quitnow or lostcarrier;
    if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    begin
      nothing;
      if
        charinbuffer and not(consoleonly or quitnow or lostcarrier)
      then
        tch:=com_rx;
        if tch=chr(0) then got:=false else got:=true;
      {else}

      if
        (keypressed)
      then
        begin
          tch:=readkey;
          if
            tch=#00
          then
            sysopkey
          else
            begin
              got:=true;
              if quitnow then exit;
            end
        end
      else
        timeslice;
    end;
  until got or quitnow or lostcarrier;
  getchr:=tch;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

function getln1:string;
var tampax:string[255];
    tch:char;
begin
  totallines:=0;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  tch:=chr(32); tampax:='';
  repeat
    begin
      nothing;
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
      if
        charwaiting
      then
        begin
          tch:=getchr;
          if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
          if
            not(tch=carriagereturn)
          then
            CASE tch of
              #127,
              backspace: if
                           length(tampax)>0
                         then
                           begin
                             send(destructiveBS);
                             tampax:=copy(tampax,1,length(tampax)-1);
                           end;
              chr(11):   nothing;
              #27: com_tx(#7);
            ELSE
              if
                length(tampax)<maximuminput
              then
                begin
                  tampax:=tampax+tch;
                  case echochar of
                    chr(11): send(tch);
                    chr(23): nothing;
                  else
                    send(echochar);
                  end; {case echochar}
                end; {we got a character and the line is < maximuminput}
            end; {case tch}
        end {if charwaiting}
      else
        nothing;
      if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
    end; {repeat}
  until ((tch=carriagereturn) and (ord(tampax[0])>=minimuminput)) or (quitnow or lostcarrier);
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
  getln1:=tampax;
end;

function f_date(fnm:string):longint;
const xxx:longint=86400;
var fshit:file of byte;
    tshit:longint;
    pftime,cft:longint;
    dt:datetime;
    hr,mi,se,s1:longint;
begin
  fillchar(dt,sizeof(dt),null);
  tshit:=0;
  if
    not exist(fnm)
  then
    tshit:=0
  else
    begin
      {$I-}
      assign(fshit,fnm);
      reset(fshit);
      getftime(fshit,pftime);
      close(fshit);
      {$I+}
      unpacktime(pftime,dt);
      hr:=dt.hour; mi:=dt.min; se:=dt.sec;
      cft:=(3600*hr);
      cft:=cft+(60*mi);
      cft:=cft+se;
      tshit:=d70(dt.year,dt.month,dt.day);
      tshit:=tshit*xxx;
      tshit:=tshit+cft;
(*      writeln(tshit);*)
    end;
  f_date:=tshit;
end;

Function HexByte(Number: Byte): String;
  Var
    HChar: Char;
    LChar: Char;

  Begin
  LChar := Chr((Number And $F) + 48);
  If LChar > '9' Then
    LChar := Chr(Ord(LChar) + 7);
  HChar := Chr((Number shr 4) + 48);
  If HChar > '9' Then
    HChar := Chr(Ord(HChar) + 7);
  HexByte := HChar + LChar;
  End;


Function HexStr(Number: Word): String;
  Begin
  HexStr := HexByte(Number Shr 8) + HexByte(Number And $FF);
  End;


Function HexLong(Number: LongInt): String;
Type WordRec = Record
                 Lo: Word;
                 Hi: Word;
               End;
Begin
  HexLong := HexStr(WordRec(Number).Hi) + HexStr(WordRec(Number).Lo);
End;

function emcount(s:string; p:byte):integer;
var index:integer;
    tmp:byte;
begin
  if p>length(s) then p:=length(s);
  index:=0; tmp:=0;
  for index:=1 to p do
    if s[i]=#96 then inc(tmp,2);
  emcount:=tmp;
end;

var lastwrap:string;  {A string which is used only by dumpwrap but is necessarily global}

procedure dumbwrap(s:string);
const crlf:string[2]=#13#10;
var runlen:integer;
    position:integer;
begin
  if s='' then begin if lastwrap<>'' then sendln(crlf) else sendln(''); exit; end;
  lastwrap:=s;
  repeat
    runlen:=78-wherex;
    if runlen>length(s) then begin send(s+' '); if s[length(s)]='.' then send(' '); exit; end;
    position:=runlen+emcount(s,runlen);
    while (position>0) and (s[position]<>#32) do dec(position); {Work backward to space}
    if
      position>0
    then
      begin
        sendln(copy(s,1,position));
        delete(s,1,position);
      end
    else
      begin
        sendln('');
      end;
  until (s[0]=#0) or quitnow or lostcarrier;
  if lostcarrier then begin nocarrier; quitnow:=true; exit; end;
end;

function f_size(fnm:string):longint;
const xxx:longint=86400;
var tshit:longint;
    cft:longint;
    dt:datetime;
    hr,mi,se,s1:longint;
    dirinfo:searchrec;
begin
  fillchar(dt,sizeof(dt),#00);
  tshit:=0;
  findfirst(fnm,archive,dirinfo);
  if
    doserror<>0
  then
    tshit:=-1
  else
    begin
      tshit:=dirinfo.size;
      unpacktime(dirinfo.time,dt);
      hr:=dt.hour; mi:=dt.min; se:=dt.sec;
      cft:=(3600*hr);
      cft:=cft+(60*mi);
      cft:=cft+se;
      currentfiledate:=d70(dt.year,dt.month,dt.day);
      currentfiledate:=longint(currentfiledate*xxx);
      currentfiledate:=longint(currentfiledate+cft);
    end;
  f_size:=tshit;
end;

begin
  lastwrap:='';
end.

