Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/ECO30603.ZIP/ECO30603.LZH/ECOLIBBS/ECO_DOOR.PAS

Pascal/Delphi Source File | 1993-03-08 | 30.9 KB | 1,147 lines

{$R-}
{$M 5000, 0, 262144}
unit eco_door;
interface
uses
  dos, crt,
  eco_ansi;

const
  processextended: boolean = true;

type
  charset = set of char;
  userrec = record
    name       :       string[35];   { name of the user online     }
    city       :       string[25];   { city where user lives       }
    timeleft   :             word;   { time user has left          }
    timeout    :             byte;   { inactivity time for user    }
    ansi       :          boolean;   { does the user support ansi  }
    chatreason :       string[60];   { chat reason incase he yells }
  end;


var
  port       :    byte;   {                                    comm port 0-3 }
  baud       :    word;   {                            current connect speed }
  online     : boolean;   {                whether it's a local/remote login }
  mstatus    :    word;   {                               modem status, word }
  foreground :    byte;   { foreground color, so you can check and change... }
  background :    byte;   {  background color so you can check and change... }
  stop       : boolean;   {          variable used for some stop procedures. }

  modemonly  : boolean;   {         if true then output will only be sent to }
                          {       the modem! this boolean is used by several }
                          {                                       procedures }

  sysopname  :  string;   {                      name of the system operator }

  showstatwin: boolean;   {                should the status window be shown }
  user       : userrec;

  statevent,              {                       booleans to control events }
                          {              if statevent = true then the window }
                          {                                will be refreshed }
  timeoutwarn: boolean;   {              if timeoutwarn = true then the user }
                          {                  will be warned that his time is }
                          {                                    running short }
  localkey   : boolean;   {             this boolean will be true when a key }
                          {                is pressed and it happend to be a }
                          {               local key, this makes it easier to }
                          {               support special sysop keys without }
                          {             having to rebuild several procedures }

function softinitfossil: boolean; { will initialize the fossil, true if }
                                  {                           sucessful }
procedure inittimes;              {is automatically run when the program }
                                  {starts.                               }
procedure send(s: string);        {modem equivalent of write}
procedure sendln(s: string);      {modem equivalent of writeln}
                                  {read a string with max length = len}
procedure readstr(var s: string; len: byte);
                                  {read a word with max number of chars = len}
procedure readint(var int: word; len: byte);
procedure editstr(var s  : string; len: byte);
                                   {edit a string with max length = len,
                                   if the string s has a length > len then
                                   len := length(s) !! }
procedure portcolor(f: byte);     {modem equivalent of textcolor}
procedure portbackground(b: byte);{modem equivalent of textbackground}
procedure clrportscr;             {modem equivalent of clrscr}
procedure clrporteol;             {modem equivalent of clreol}
procedure autoansidetect;         {detect if remote has user.ansi support}
procedure purgeinbuffer;          {purge input buffer}
procedure portxy(x,y: byte);      {modem equivalent of gotoxy}
procedure displayfile(
  fname: string;
  stopkeys: charset;
  pausekeys: charset;
  var ch   : char
);
                                  {display a file with hotkeys in set hotkeys}
function  waitchar(cset: charset): char;
                                  {waits till a key has been pressed in
                                   cset and returns that key}

function  portx: byte;            {modem equivalent of wherex}
function  porty: byte;            {modem equivalent of wherey}
function  readchar: char;         {modem equivalent of readch}
function  getstatus: word;        {returns modem status}
function  portkeypressed: boolean;{modem equivalent of keypressed}

procedure resetcounter(num: byte;col: byte);
                                  {reset line counter to num lines
                                   and with prompt color = col}
procedure stopcounter;            {stop the line counter.}
procedure hangup;                 {hang up the modem!}

{other helpfull functions and procedures}

function  ms(l: longint): string;  {convert a word to a string fast}
function  rep(ch: char;b: byte): string;
                                   {return a string with filled with ch and }
                                   {with length b                           }
function  uprcase(s: string): string;
                                  {convert a string to uprcase}
procedure trim(var s: string);    {trim all leading and trailing #0 and #32}
function  byte_set(b,bit: byte): boolean;
                                  {checks to see if bit is set in b}
function  lz(w: word): string;    {aka leading zero, adds a 0 before one digit }
                                  {numbers, handy for dates!                   }
procedure chat(full,direct: boolean); {inline fullscreen chatter. if full is   }
                                  {False, then it will go into normal mode, If
                                  {Direct is true, then it will not display the}
                                  {Chat reason (since there won't be one)      }
Procedure DisplayStat;            {show sysop status window}
                                  {This option isn't really finished yet, but
                                   the part that is done works...}
Procedure Delay(Num: byte);       {A replacement for the Delay in the CRT
                                   unit. This Delay works with seconds, and
                                   it works in and outside of dv}




implementation







const
  esc = #27;
  fore: array[0..15] of string[5] = (
    '[0;30', '[0;34', '[0;32', '[0;36', '[0;31', '[0;35', '[0;33', '[0;37',
    '[1;30', '[1;34', '[1;32', '[1;36', '[1;31', '[1;35', '[1;33', '[1;37'
  );
  back: array[0..7]  of string[4] = (
    ';40m', ';44m', ';42m', ';46m', ';41m', ';45m', ';43m', ';47m'
  );

var
  _countline  : boolean;
  _linecount  :    byte;
  _pausecount :    byte;
  _checktime  : boolean;

  promptcolor :    byte;
  timeoutmin,
  lastmin     :    byte;



  procedure delay(num: byte);
  var
    stoptime,
    curtime : longint;
    regs    : registers;

  begin
    regs.ah := $00;
    intr($1a,regs);
    stoptime := regs.cx*65536 + regs.dx + (num * 18);
    if stoptime > $1800b0 then stoptime := stoptime - $1800b0;
    repeat
      regs.ah := $00;
      intr($1a,regs);
      curtime := regs.cx*65536 + regs.dx;
    until curtime >= stoptime;
  end;



  procedure displaystat;
  var x,y: byte;
  begin
    if statevent then begin
      x := wherex;
      y := wherey;
      window(1,24,80,25);
      textcolor(yellow);
      textbackground(7);
      gotoxy(1,1);
      write(user.name,', From ',user.city);
      write(rep(' ',64-wherex));
      write('Baud: ',baud);
      clrporteol;
      gotoxy(1,2);
      write('Time left: ',user.timeleft);
      clrporteol;
      window(1,1,80,23);
      textattr := 7;
      gotoxy(x,y);
      statevent := false;
    end;
  end;



  procedure checkwarnflags;
  var oldfore,oldback: byte;
  begin
    if timeoutwarn then begin
      oldfore := foreground;
      oldback := background;
      portcolor(12);
      portbackground(0);
      sendln('Hello ?? Are you still there ??');
      portcolor(oldfore);
      portbackground(oldback);
    end;
  end;



  function lz(w: word): string;
  var s: string;
  begin
    str(w,s);
    if length(s) < 2 then s := '0'+s;
    lz := s;
  end;



  function byte_set(b,bit: byte): boolean;
  var v: byte;
  begin
    v := 1 shl bit;
    byte_set := v = v and b;
  end;



  procedure inittimes;
  var hour,min,sec,hund: word;
  begin
    gettime(hour,min,sec,hund);
    lastmin    := min;
    timeoutmin := min;
  end;



  function ms(l: longint): string;
  var s: string;
  begin
    str(l,s);
    ms := s;
  end;



  function rep(ch: char;b: byte): string;
  var s: string;
  begin
    fillchar(s,sizeof(s),ch);
    s[0] := chr(b);
    rep := s;
  end;



  function uprcase(s: string): string;
  var j: byte;
  begin
    for j := 1 to length(s) do s[j] := upcase(s[j]);
    uprcase := s;
  end;



  function getstatus: word;
  var regs: registers;
  begin
    fillchar(regs,sizeof(regs),$00);
    regs.ah := $03;
    intr($14,regs);
    getstatus := regs.ah*256+regs.al;
    writeln(regs.ah);
  end;



  procedure trim(var s: string);
  begin
    while (s[1] in [' ',#0]) do delete(s,1,1);
    while (s[length(s)] in [' ',#0]) do delete(s,length(s),1);
  end;



  procedure carrierlost;
  begin
    writeln('Carrier lost, returning to board...');
    halt;
  end;



  procedure checkcarrier;
  var regs: registers;
  begin
    fillchar(regs,sizeof(regs),$0);
    regs.ah := $03;
    regs.dx := port;
    intr($14,regs);
    if not byte_set(regs.al, 7) then carrierlost;
  end;



  procedure resetcounter(num: byte;col: byte);
  begin
    promptcolor := col;
    stop := false;
    _pausecount := num;
    _countline  := true;
    _linecount  := 0;
  end;



  procedure stopcounter;
  begin
    _countline := false;
    stop       := false;
  end;



  procedure promptcontinue;
  var
    cnt: byte;
    s  : string;
    ch : char;
    oldf: byte;
    oldb: byte;

  begin
    oldf := foreground;
    oldb := background;
    portcolor(promptcolor);
    portbackground(0);
    send('More [Y/n]');
    ch := #255;
    repeat
      if portkeypressed then ch := readchar;
      ch := upcase(ch);
    until ch in [#13,'Y','N'];
    stop := ch = 'N';
    _linecount := 0;
    send(rep(#08,10)+rep(#32,10)+rep(#08,10));
    portcolor(oldf);
    portbackground(oldb);
  end;



  procedure clickcounter;
  begin
    inc(_linecount);
    if _linecount = _pausecount then promptcontinue;
  end;



  procedure sendchar(ch: char);
  var regs: registers;
  begin
    if online then begin
      checkcarrier;
      fillchar(regs,sizeof(regs),$00);
      regs.ah := $01;
      regs.al := ord(ch);
      regs.dx := port;
      intr($14,regs);
    end;
    if not modemonly then write(ch);
  end;



  procedure send(s: string);
  var cnt: byte;
  begin
    for cnt := 1 to length(s) do sendchar(s[cnt]);
  end;



  procedure sendln(s: string);
  var cnt: byte;
  begin
    for cnt := 1 to length(s) do sendchar(s[cnt]);
    sendchar(#13);
    sendchar(#10);
    if _countline then clickcounter;
  end;



  procedure purgeinbuffer;
  var regs: registers;
  begin
    fillchar(regs,sizeof(regs),$00);
    regs.ah := $0a;
    regs.dx := port;
    intr($14,regs);
  end;



  function portpressed: boolean;
  var regs: registers;
  begin
    portpressed := false;
    fillchar(regs,sizeof(regs),$00);
    if online then begin
      regs.ah := $03;
      regs.dx := port;
      intr($14,regs);
      portpressed := byte_set(regs.ah,0);
      if not byte_set(regs.al,7) then carrierlost;
    end;
  end;



  function portkeypressed: boolean;
  var ok: boolean;

    procedure checktimer(ok: boolean);
    var hour,min,sec,hund: word;
    begin
      gettime(hour,min,sec,hund);
      if min <> lastmin then begin
        lastmin   := min;
        statevent := true;
        dec(user.timeleft);
      end;
      if ok then timeoutmin := min else begin
        if min > timeoutmin + 2 then timeoutwarn := true;
        if min > timeoutmin + 3 then hangup;
      end;
    end;



  begin
    ok := keypressed or portpressed;
    portkeypressed := ok;
    checktimer(ok);
    displaystat;
    checkwarnflags;
  end;




  procedure jumptodos;
  var y: byte;
  begin
    portcolor(15); portbackground(0); sendln(''); y := wherey;
    sendln('Sysop is jumping to DOS, please wait...');
    textattr := 7; clrscr; swapvectors;
    exec(getenv('COMSPEC'),''); swapvectors; statevent := true;
    displaystat; portxy(1,y); portcolor(15); portbackground(0);
    sendln('Sysop has returned, thank you for waiting.');
  end;





  function readchar: char;
  var
    regs: registers;
    ch  : char;

  begin
    if online and portpressed then begin
      checkcarrier;
      fillchar(regs,sizeof(regs),$00);
      regs.ah := $02;
      regs.dx := port;
      intr($14,regs);
      readchar := chr(regs.al);
      localkey := false;
    end else if keypressed then begin
      ch := readkey;
      if (ch = #0) and processextended then begin
        ch := readkey;
        case ch of
          #46: chat(true,true);
          #35: hangup;
          #36: jumptodos;
        end;
        readchar := #255;
      end else readchar := ch;
      localkey := true;
    end;
  end;



  procedure readstr(var s: string; len: byte);
  var ch: char;
  begin
    s := '';
    ch := #0;
    repeat
      if portkeypressed then begin
        ch := readchar;
        if (ch = #08) and (length(s) > 0) then begin
          delete(s,length(s),1);
          send(#08#32#08);
        end;
        if (ch = #0) then begin
          ch := readkey;
          ch := #255;
        end;
        if (
          (ch <> #08) and (ch <> #13) and (length(s) < len) and
          (ch > #31) and (ch < #127)
        ) then begin
          s := s + ch;
          sendchar(ch);
        end;
      end;
    until (length(s) >= len) or (ch = #13);
  end;



  procedure readint(var int: word; len: byte);
  var
    ch   :    char;
    s    :  string;
    code : integer;

  begin
    s := '';
    ch := #0;
    repeat
      if portkeypressed then begin
        ch := readchar;
        if (ch = #08) and (length(s) > 0) then begin
          delete(s,length(s),1);
          send(#08#32#08);
        end;
        if (
          (ch <> #08) and (ch <> #13) and (length(s) < len) and
          (ch > #47) and (ch < #58)
        ) then begin
          s := s + ch;
          send(ch);
        end;
      end;
    until (length(s) > len) or (ch = #13);
    val(s,int,code);
  end;



  procedure editstr(var s  : string; len: byte);
  var ch: char;
  begin
    ch := #0;
    send(s);
    if len < length(s) then len := length(s);
    repeat
      if portkeypressed then begin
        ch := readchar;
        if (ch = #08) and (length(s) > 0) then begin
          delete(s,length(s),1);
          send(#08#32#08);
        end;
        if (
          (ch <> #08) and (ch <> #13) and (length(s) < len) and
          (ch > #31) and (ch < #127)
        ) then begin
          s := s + ch;
          send(ch);
        end;
      end;
    until (length(s) > len) or (ch = #13);
  end;



  procedure portcolor(f: byte);
  begin
    if (f < 16) and user.ansi then begin
      textcolor(f);
      foreground := f;
      modemonly := true;
      if f < 8 then send(esc+'[0m');
      send(esc+fore[foreground]+back[background]);
      modemonly := false;
    end;
  end;



  procedure portbackground(b: byte);
  begin
    if (b < 8) and user.ansi then begin
      textbackground(b);
      background := b;
      modemonly := true;
      send(esc+'[0m');
      send(esc+fore[foreground]+back[background]);
      modemonly := false;
    end;
  end;



  procedure clrportscr;
  begin
    clrscr;
    modemonly := true;
    send(esc+'[2J');
    modemonly := false;
  end;



  procedure clrporteol;
  begin
    clreol;
    modemonly := true;
    if user.ansi then send(esc+'[K');
    modemonly := false;
  end;



  procedure autoansidetect;
  var
    ch :    char;
    j  : longint;

  begin
    purgeinbuffer;
    user.ansi := false;
    if online then begin
      modemonly := true;
      send(esc+'[6n');
      send(rep(#08,4));
      modemonly := false;
      delay(1);
      if portpressed then begin
        ch := readchar;
        user.ansi := ch = 'R';
      end;
    end else user.ansi := true;
  end;



  procedure portxy(x,y: byte);
  begin
    if not online then gotoxy(x,y) else if user.ansi then begin
      gotoxy(x,y);
      modemonly := true;
      send(esc+'['+ms(y)+';'+ms(x)+'H');
      modemonly := false;
    end else begin
      if y > wherey then send(rep(#10,wherey-y));
      if x > wherex then send(rep(#32,wherex-x));
      if x < wherex then send(rep(#08,x-wherex));
    end;
  end;



  procedure displayfile(
    fname     :  string;
    stopkeys  : charset;
    pausekeys : charset;
    var ch    :    char
  );

  var
    s  : string[80];
    f  : file;
    j  : byte;
    nr : word;
    io : byte;

    function hotkeypressed: boolean;
    var ch2: char;
    begin
      hotkeypressed := false;
      if stopkeys <> [] then if portkeypressed then begin
        ch2 := upcase(readchar);
        if ch2 in stopkeys then begin
          hotkeypressed := true;
          ch := ch2;
        end else if ch2 in pausekeys then begin
          repeat until portkeypressed;
          ch2 := readchar;
        end;
        modemonly := true;
      end;
    end;

  begin
    if fname <> '' then begin
      if pos('.',fname) > 0 then delete(fname,pos('.',fname),4);
      if user.ansi then fname := fname + '.ANS' else fname := fname + '.ASC';
      assign(f,fname);
      {$I-} reset(f,1); {$I+}
      io := ioresult;
      if (io <> 0) and user.ansi then begin
        if user.ansi then fname := copy(fname,1,pos('.',fname))+'ASC';
        assign(f,fname);
        {$I-} reset(f,1); {$I+}
        io := ioresult;
      end;
      if io = 0 then begin
        modemonly := true;
        repeat
          s := '';
          blockread(f,s[1],80,nr);
          s[0] := chr(nr);
          send(s);
          ansiwrite(s);
        until (nr = 0) or hotkeypressed;
        modemonly := false;
        close(f);
      end else writeln('Error: ',fname, ' not found');
    end;
  end;



  function portx: byte;
  begin
    portx := wherex;
  end;



  function porty: byte;
  begin
    porty := wherey;
  end;



  function waitchar(cset: charset): char;
  var ch: char;
  begin
    ch := #255;
    repeat
      if portkeypressed then ch := readchar;
      ch := upcase(ch);
    until ch in cset;
    waitchar := ch;
  end;



  procedure hangup;
  var regs: registers;
  begin
    with regs do begin
      ah := $06; dx := port; al := $00; intr($14,regs);
    end;
    halt;
  end;



  procedure chat(full,direct: boolean);
  const
    infocolor = 14;
    dsz    : string[4] = #24'B00';
    dszcnt : byte = 1;

  var
    sysopscreen   : array[2..11] of string[80];
    userscreen    : array[13..22] of string[80];
    normalline    : string[80];
    sysopx,sysopy :       byte;
    userx,usery   :       byte;
    ch            :       char;
    sysopchat     :       byte;
    userchat      :       byte;
    starttime     :    longint;
    endtime       :    longint;
    hour, min,
    sec, hund     :       word;
    chatlog       :       text;



    procedure scrollsysopscreen;
    var cnt: byte;
    begin
      for cnt := 2 to 6 do sysopscreen[cnt] := sysopscreen[cnt+5];
      for cnt := 7 to 11 do fillchar(
        sysopscreen[cnt], sizeof(sysopscreen[cnt]), 0
      );
      for cnt := 11 downto 2 do begin
        portxy(1,cnt);
        clrporteol;
        if cnt < 7 then sendln(sysopscreen[cnt]);
      end;
      sysopy := 7;
    end;


    procedure wrapsysopscreen;
    var cnt: byte;
    begin
      cnt := 81;
      repeat
        dec(cnt);
      until (sysopscreen[sysopy-1][cnt] = #32) or (cnt = 1);
      if cnt > 1 then begin
        sysopscreen[sysopy] := copy(sysopscreen[sysopy-1],cnt+1,80-cnt);
        delete(sysopscreen[sysopy-1],cnt,80-cnt);
        portxy(cnt,sysopy-1);
        send(rep(#32,81-cnt));
        portxy(1,sysopy);
        send(sysopscreen[sysopy]);
      end;
    end;



    procedure scrolluserscreen;
    var cnt: byte;
    begin
      for cnt := 13 to 17 do userscreen[cnt] := userscreen[cnt+5];
      for cnt := 18 to 22 do fillchar(
        userscreen[cnt], sizeof(userscreen[cnt]), 0
      );
      for cnt := 22 downto 13 do begin
        portxy(1,cnt);
        clrporteol;
        if cnt < 18 then sendln(userscreen[cnt]);
      end;
      usery := 18;
    end;



    procedure clearsysopscreen;
    var cnt : byte;
    begin
      for cnt := 2 to 11 do fillchar(
        sysopscreen[cnt], sizeof(sysopscreen[cnt]), 0
      );
      for cnt := 11 downto 2 do begin
        portxy(1,cnt);
        clrporteol;
      end;
      sysopy := 2;
    end;



    procedure clearuserscreen;
    var cnt : byte;
    begin
      for cnt := 13 to 22 do fillchar(
        userscreen[cnt], sizeof(userscreen[cnt]), 0
      );
      for cnt := 22 downto 13 do begin
        portxy(1,cnt);
        clrporteol;
      end;
      usery := 13;
    end;



    procedure wrapuserscreen;
    var cnt: byte;
    begin
      cnt := 81;
      repeat
        dec(cnt);
      until (userscreen[usery-1][cnt] = #32) or (cnt = 1);
      if cnt > 1 then begin
        userscreen[usery] := copy(userscreen[usery-1],cnt+1,80-cnt);
        delete(userscreen[usery-1],cnt,80-cnt);
        portxy(cnt,usery-1);
        send(rep(#32,81-cnt));
        portxy(1,usery);
        send(userscreen[usery]);
      end;
    end;



    procedure wordwrapnormal;
    var cnt: byte;
    begin
      cnt := 81;
      repeat
        dec(cnt);
      until (normalline[cnt] = #32) or (cnt = 1);
      if cnt > 1 then begin
        normalline := copy(normalline,cnt+1,80-cnt);
        portxy(cnt,porty);
        send(rep(#32,81-cnt));
        send(normalline);
      end;
    end;

    procedure redrawscreen(sysop: boolean);
    var cnt: byte;
    begin
      if sysop then begin
        modemonly := true; clrscr; textcolor(15); textbackground(1);
        clreol; write(#32+sysopname); gotoxy(1,12); clreol;
        write(#32+user.name); gotoxy(1,23); clreol; textcolor(14);
        write(
          'Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen'
        );
        textbackground(0); gotoxy(1,2); textcolor(14); gotoxy(1,2);
        for cnt := 2 to sysopy do writeln(sysopscreen[cnt]);
        textcolor(3); gotoxy(1,13);
        for cnt := 13 to usery do writeln(userscreen[cnt]);
      end else begin
        clrportscr; portcolor(15); portbackground(1); clrporteol;
        send(#32+sysopname); portxy(1,12); clrporteol; send(#32+user.name);
        portxy(1,23); clrporteol; portcolor(14);
        send(
          'Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen'
        );
        portbackground(0); portxy(1,2); portcolor(14); portxy(1,2);
        for cnt := 2 to sysopy do sendln(sysopscreen[cnt]);
        portcolor(3); portxy(1,13);
        for cnt := 13 to usery do sendln(userscreen[cnt]);
      end;
      if sysop then portxy(length(sysopscreen[sysopy])+1,sysopy) else
        portxy(length(userscreen[usery])+1,usery);
     end;

  begin
    gettime(hour,min,sec,hund); starttime := hour*60+min; statevent := true;
    displaystat; sysopchat := 14; userchat  := 3;
    ch := #255; portcolor(infocolor); portbackground(0); sendln(''); sendln('');
    sendln('SysOp entering chat mode...');
    if user.ansi and full then begin
      portbackground(0); clrportscr; portcolor(15); portbackground(1);
      clrporteol; send(#32+sysopname); portxy(1,12); clrporteol;
      send(#32+user.name); portxy(1,23); clrporteol; portcolor(14);
      send(
        'Press Ctrl + R to re-draw screen and Ctrl + W to clear your screen'
      );
      portbackground(0); portxy(1,2); sysopy := 2; usery  := 13;
      fillchar(sysopscreen,sizeof(sysopscreen),0);
      fillchar(userscreen ,sizeof(userscreen) ,0);
      processextended := false;
      repeat
        if portkeypressed then begin
          ch := readchar;
          if localkey then begin
            if ch = #0 then begin
              ch := readkey;
              case ch of
                #35: hangup;
                #36: begin
                  jumptodos;
                  redrawscreen(true);
                end;
              end;
            end else begin
              displaystat;
              if foreground <> sysopchat then portcolor(sysopchat);
              if (
                (wherex <> length(sysopscreen[sysopy])+1) or
                (wherey <> sysopy)
              ) then portxy(length(sysopscreen[sysopy])+1,sysopy);
              if (ch = #08) then begin
                if (
                  (length(sysopscreen[sysopy]) = 0) and (sysopy > 2)
                ) then begin
                  dec(sysopy);
                  if length(sysopscreen[sysopy]) = 80 then begin
                    portxy(80,sysopy);
                    send(#32);
                    portxy(80,sysopy);
                  end else begin
                    portxy(length(sysopscreen[sysopy])+1,sysopy);
                    delete(sysopscreen[sysopy],length(sysopscreen[sysopy]),1);
                    send(#08#32#08);
                  end;
                end else if length(sysopscreen[sysopy]) > 0 then begin
                  delete(sysopscreen[sysopy],length(sysopscreen[sysopy]),1);
                  send(#08#32#08);
                end;
              end;
              if (ch > #27) and (ch <> #255) then begin
                sysopscreen[sysopy] := sysopscreen[sysopy] + ch; send(ch);
                if length(sysopscreen[sysopy]) = 80 then begin
                  if sysopy = 11 then scrollsysopscreen else inc(sysopy);
                  if sysopscreen[sysopy-1][80] > #32 then wrapsysopscreen;
                end;
              end;
              if ch = #23 then clearsysopscreen;
              if ch = #18 then redrawscreen(true);
              if ch = #25 then begin
                sysopscreen[sysopy] := '';
                portxy(1,sysopy);
                clrporteol;
              end;
              if ch = #13 then begin
                if sysopy = 11 then scrollsysopscreen else inc(sysopy);
                portxy(1,sysopy);
              end;
            end;
          end else begin
            if foreground <> userchat then portcolor(userchat);
            if (
              (portx <> length(userscreen[usery])+1) or
              (porty <> usery)
            ) then portxy(length(userscreen[usery])+1,usery);
            if (ch = #08) then begin
              if (length(userscreen[usery]) = 0) and (usery > 13) then begin
                dec(usery);
                if length(userscreen[usery]) = 80 then begin
                  portxy(80,usery);
                  send(#32);
                  portxy(80,usery);
                end else begin
                  portxy(length(userscreen[usery])+1,usery);
                  delete(userscreen[usery],length(userscreen[usery]),1);
                  send(#08#32#08);
                end;
              end else if length(userscreen[usery]) > 0 then begin
                delete(userscreen[usery],length(userscreen[usery]),1);
                send(#08#32#08);
              end;
            end;
            if (ch = #0) then begin
              ch := readkey;
              ch := #255;
            end;
            if (
              (ch <> #08) and (ch <> #13) and (ch > #27) and (ch <> #255)
            ) then begin
              userscreen[usery] := userscreen[usery] + ch;
              send(ch);
              if length(userscreen[usery]) = 80 then begin
                if usery = 22 then scrolluserscreen else inc(usery);
                if userscreen[usery-1][80] > #32 then wrapuserscreen;
              end;
            end;
            if ch = #13 then begin
              if usery = 22 then scrolluserscreen else inc(usery);
              portxy(1,usery);
            end;
            if ch = #18 then redrawscreen(false);
            if ch = #23 then clearuserscreen;
            if ch = #25 then begin
              userscreen[usery] := '';
              portxy(1,usery);
              clrporteol;
            end;
            if ch = #27 then ch := #255;
          end;
        end;
      until (ch = #27);
    end else begin
      sendln('Hi there, '+user.name+' this is your Sysop.');
      normalline := '';
      repeat
        if portkeypressed then begin
          ch := readchar;
          if localkey then if (
            foreground <> sysopchat
          ) then portcolor(sysopchat) else if (
            foreground <> userchat
          ) then portcolor(userchat);
          if (ch = #08) and (length(normalline) > 0) then begin
            delete(normalline,length(normalline),1);
            send(#08#32#08);
          end;
          if (
            (ch <> #08) and (ch <> #13) and (length(normalline) < 80) and
            (ch > #31) and (ch < #127)
          ) then begin
            normalline := normalline + ch;
            if length(normalline) = 80 then wordwrapnormal;
            send(ch);
          end;
          if (ch = #13) then begin
            sendln('');
            normalline := '';
          end;
        end;
      until (ch = #27) and (localkey);
      processextended := true;
    end;

    portbackground(0); clrportscr; portcolor(infocolor);
    sendln('Chat mode ended.'); sendln('');
    gettime(hour,min,sec,hund); endtime := hour*60+sec;
    if direct then begin
      if (
        endtime < starttime
      ) then user.timeleft := user.timeleft+endtime-starttime else
        user.timeleft := user.timeleft+starttime-endtime;
    end;
  end;



  function softinitfossil: boolean;
  var regs: registers;
  begin
    softinitfossil := false;
    with regs do begin
      ah := $04; dx := port; intr($14,regs);
      if ax = $1954 then softinitfossil := true;
    end;
  end;

begin
  user.ansi   := false;
  port        :=     1;
  foreground  :=     7;
  background  :=     0;
  modemonly   := false;
  _countline  := false;
  _linecount  :=     0;
  _pausecount :=     0;
  stop        := false;
  _checktime  := false;
  statevent   :=  true;
  timeoutwarn := false;
  timeoutmin  :=    61;
  fillchar(user,sizeof(user),0);
  fillchar(sysopname,sizeof(sysopname),0);
  inittimes;
end.