telegard/miniterm.pas

(*****************************************************************************)
(*>                                                                         <*)
(*>  MINITERM.PAS - Telegard Communications Program                         <*)
(*>                 Copyright 1988,89,90 by Eric Oman, Martin Pollard,      <*)
(*>                 and Todd Bolitho - All Rights Reserved.                 <*)
(*>                                                                         <*)
(*****************************************************************************)
{$A+,B+,E+,F+,I+,L+,N-,O-,R-,S+,V-}
{$M $4000,0,0}

program miniterm;

uses
  crt, dos, myio, file0, file1, common, tmpcom;

procedure clearscr;
begin
  tc(7);
  clrscr;
end;

procedure term;
const
  delay_time = 25000;

type pnrec=record
             name:string[40];
             number:string[14];
             hs:byte;
           end;
     minirec=record
               dpath:string[40];
             end;

var c,bl,bl2:char;
    done,bac,eco,LFEEDS,macedited:boolean;
    ns:array[1..50] of pnrec;
    fil:file of pnrec;
    cfgfil:file of minirec;
    mini:minirec;

    lnd,i:integer;
    rl:real;
    r:registers;
    sx,sy:integer;
    chkcom:boolean;
    pagnum,pages,hientrynum:integer;
    hs,maxs:byte;
    wind:windowrec;

    mtcfilter:cfilterrec;
    mtcfiltertype,mtcfilternum,mtcfiltercount:integer;
    mtcfilteron:boolean;

    tchkpart:integer;
    timerison:boolean;
    timerstart,timerstop,tooktime:real;

  procedure tell(s:astr);
  var st:integer;
  begin
    cursoron(FALSE);
    st:=40-(length(s) div 2)-3;
    setwindow(wind,st,10,st+length(s)+5,14,9,1,1);
    gotoxy(3,2); tc(15); writeln(s); tc(7);
  end;

  procedure sendmpcode(s:string);
  var outc:string;
      i:integer;
  begin
    outc:=^A^B^A+mln(s,6)+#253+#254+#255;
    for i:=1 to length(outc) do sendcom1(outc[i]);
  end;

(*  procedure timertog;
  var s:string;
      c:char;
  begin
    timerison:=not timerison;
    if (timerison) then begin
      timerstart:=timer;
      tell('Timer started');
      delay(100);
      removewindow(wind);
    end else begin
      timerstop:=timer;
      tooktime:=timerstop-timerstart;
      str(tooktime:2:4,s);
      tell('Time: '+s);
      c:=readkey;
      removewindow(wind);
      cursoron(TRUE);
    end;
  end;*)

  procedure tab(x:integer);
  begin
    while wherex<x do write(' ');
  end;

  procedure savepos(var x,y:integer);
  begin
    x:=wherex; y:=wherey;
  end;

  procedure wait;
  var i:integer;
      c:char;
  begin
    for i:=1 to delay_time do
      if keypressed then begin
        i:=delay_time-1;
        c:=readkey;
      end;
  end;

  procedure tellak(s:astr);
  var x,y:integer;
  begin
    savepos(x,y); tell(s);

    wait;

    removewindow(wind);
    gotoxy(x,y);
    cursoron(TRUE);
    tc(7);
  end;

  procedure om(ch:char);
  begin
    if ((mtcfilteron) and (mtcfiltertype=0) and
        (textattr<>mtcfilter[ord(ch)])) then textattr:=mtcfilter[ord(ch)];
    outkey(ch);
  end;

(*  procedure docchk(c:char);
  begin
    if ((c=#224) and (tchkpart=0)) then begin tchkpart:=1; exit; end;
    if ((c=#225) and (tchkpart=1)) then begin tchkpart:=2; exit; end;
    if ((c=#226) and (tchkpart=2)) then begin tchkpart:=0; timertog; end;
    tchkpart:=0;
  end;*)

  procedure handlemtcode;
  var f:file of char;
      rl:real;
      s:string;
      i,nzz:integer;
      c,cft:char;

    function getnextc:char;
    begin
      while (com_rx_empty) do ;
      getnextc:=ccinkey1;
    end;

  begin
    rl:=timer;
    repeat until (not com_rx_empty);
    c:=ccinkey1;
    if (ord(c) and $70=$70) then
      textattr:=ord(c) and $8F
    else
      case c of
        'C':textattr:=ord(getnextc);
        'c':case getnextc of
              '=':begin
                    for i:=0 to 255 do mtcfilter[i]:=ord(getnextc);
                    if (getnextc=';') then begin
                      mtcfilteron:=TRUE;
                      mtcfiltertype:=0;
                    end else
                      mtcfilteron:=FALSE;
                  end;
              '*':;
              '-':mtcfilteron:=FALSE;
            end;
        'f':begin
              rl:=timer; s:='';
              repeat s:=s+getnextc
              until ((s[ord(s[0])]=';') or (timer-rl>5.0));
              if (copy(s,length(s),1)=';') then begin
                s:=allcaps(copy(s,1,length(s)-1));
                setwindow(wind,3,10,77,17,9,1,1);
                clearscr; tc(15);
                writeln;
                writeln(' BBS wants to send you "'+s+'"');
                writeln(' Enter filename to accept download as.');
                write(' '); for i:=1 to 70 do write('_'); writeln;
                s:=allcaps(mini.dpath)+s;
                tc(9); write(''); tc(11); infield1(wherex,wherey,s,70);
                removewindow(wind);
                if (s='') then exit;
                assign(f,s);
                {$I-} reset(f); {$I+}
                if (ioresult=0) then begin
                  close(f);
                  tellak('"'+s+'": File already exists.');
                  com_tx(#21); { NAK }
                end else begin
                  rewrite(f); nzz:=0;
                  com_tx(#6); { ACK }
                  repeat
                    c:=getnextc;
                    write(f,c); write(c);
                    if (c=^Z) then inc(nzz) else nzz:=0;
                  until (nzz>=3);
                  close(f);
                end;
              end else
                com_tx(#21); { NAK }
            end;
      end;
    dosansion:=FALSE;
  end;

(*
ferr.log;
c*R1,2,3,4;
c*C1,2,3,4;
c=   (0..255 color codes)   ;
c-;                                        { turn off color filter }
*)

  procedure in1(c:char);
  begin
(*    if ((c>=#224) and (c<=#226)) then docchk(c);*)
    if (c=^T) then begin handlemtcode; exit; end;
    if ((c=^M) and (lfeeds)) then writeln;
    if (c=^L) then clrscr else
      if (c=^H) then begin
        om(c);
        if (bac) then begin om(' '); om(^H); end;
      end
    else
      if (c<>#0) then om(c);
  end;

  procedure gkey(var c:char);
  begin
    repeat until keypressed;
    c:=readkey;
  end;

  function lyn:boolean;
  var c:char;
  begin
    repeat gkey(c);
    until upcase(c) in ['Y','N',#13];

    if (upcase(c)='Y') then begin
      lyn:=TRUE;
      writeln('Yes');
    end else begin
      lyn:=FALSE;
      writeln('No');
    end;
  end;

  procedure ss(hs:byte);
  var s:astr;
  begin
    writeln; writeln;
    tc(1); write('--- '); tc(3);
    case hs of
      0:s:='300';     1:s:='1200';
      2:s:='2400';    3:s:='4800';
      4:s:='9600';
    end;
    write(s+' BAUD '); tc(1); writeln('---');
    writeln;
    tc(7);
  end;

  procedure cs(hs:byte);
  var s:astr;
  begin
    case hs of
      0:s:='300';     1:s:='1200';
      2:s:='2400';    3:s:='4800';
      4:s:='9600';
    end;
    com_set_speed(value(s));
    spd:=s;
  end;

  procedure hang;
  var rl:real;
      try:integer;

    procedure dely(r:real);
    var r1:real;
    begin
      r1:=timer;
      while abs(timer-r1)<r do;
    end;

  begin
    try:=0;
    term_ready(FALSE);
    if (com_carrier) then while (try<2) do begin
      dely(2.0);
      pr1('+++');
      rl:=timer;
      while (cinkey1<>'0') and (abs(timer-rl)<2.0) do;
      dely(0.8);
      pr1('ATH0'+#13);
      try:=try+1;
      dely(0.3);
    end;
  end;

  procedure beep;
  var a,b,c,i,j:integer;
  begin
    for j:=1 to 3 do begin
      for i:=1 to 3 do begin
        a:=i*500;
        b:=a;
        while b>a-300 do begin
          sound(b);
          b:=b-50;
          c:=a+1000;
          while c>a+700 do begin
            sound(c);
            delay(2);
            c:=c-50;
          end;
        end;
      end;
      delay(50);
      nosound;
    end;
  end;

  function filepath(fn:astr):astr;
  var a,b:integer;
      s:astr;
  begin
    b:=0;
    {rcg11242000 dosism.}
    {for a:=1 to length(fn) do if fn[a]='\' then b:=a;}
    for a:=1 to length(fn) do if fn[a]='/' then b:=a;
    if b<>0 then filepath:=copy(fn,1,b)
    else begin
      getdir(0,s);
      {rcg11242000 dosism.}
      {filepath:=s+'\';}
      filepath:=s+'/';
    end;
  end;

  procedure ul;
  var dok,abort,kabort:boolean;
      i,pa:astr;
      f:text;
      c:char;
      j,sxx,syy,termprotocol:integer;
      st:real;
      suboard:astr;
      pnumber:integer;
  begin
    savepos(sxx,syy);
    setwindow(wind,3,5,38,21,9,1,1);
    tc(15); textbackground(0); clearscr;
    window(4,5,37,20); textbackground(1);
    gotoxy(2,1); write('Upload');
    window(4,6,37,20); textbackground(0);
    gotoxy(1,15);

    termprotocol:=1;
    dok:=FALSE;
    removewindow(wind);
    if termprotocol<>-1 then begin
      i:='';
      setwindow(wind,3,10,77,16,9,1,1);
      clearscr; tc(15);
      writeln;
      if (termprotocol=1) then
        writeln(' Enter file to ASCII send, <CR> to abort.')
      else
        writeln(' Enter file(s) to upload, <CR> to abort.');
      write(' '); for j:=1 to 70 do write('_'); writeln;
      tc(9); write('');
      tc(11); i:=''; infield1(wherex,wherey,i,70);
      removewindow(wind);
      if (i<>'') then begin
        assign(f,i);
        {$I-} reset(f); {$I+}
        if (ioresult=0) then begin
          close(f);
          outcom:=FALSE; incom:=FALSE;
          fileboard:=1;
          loaduboard(1);
          suboard:=memuboard.dlpath; memuboard.dlpath:=filepath(i);
          if (termprotocol=1) then begin
            dok:=TRUE;
            gotoxy(sxx,syy);
            reset(f);
            while (not eof(f)) and (dok) do begin
              if keypressed then
                if readkey=#27 then dok:=FALSE;
              read(f,c);
              sendcom1(c);
              if (eco) then om(c);
              if (not com_rx_empty) then begin
                c:=cinkey1;
                in1(c);
              end;
            end;
            close(f);
            sxx:=wherex; syy:=wherey;
          end;
          memuboard.dlpath:=suboard;
          term_ready(TRUE);
          cs(hs);
        end else begin
          tellak('File not found');
          cursoron(TRUE);
        end;
      end;
    end;
    hangup:=FALSE;
    incom:=FALSE;
    outcom:=FALSE;
    gotoxy(sxx,syy);
    tc(7);
  end;

  procedure dl;
  var dok,kabort,addbatch:boolean;
      i:astr;
      f:file;
      j,sxx,syy,sxx2,syy2:integer;
      st:real;
      suboard:astr;
      pnumber:integer;
      wind1:windowrec;
  begin
(*
    savepos(sxx,syy);
    setwindow(wind,3,9,77,16,9,1,1);
    clearscr;
    tc(9); writeln(mrn(cstr(freek(exdrv(mini.dpath)))+'k of free space in '+mini.dpath,72));

    savepos(sxx2,syy2);
    setwindow(wind1,3,5,38,21,9,1,1);
    tc(15); textbackground(0); clearscr;
    window(4,5,37,20); textbackground(1);
    gotoxy(2,1); write('Download');
    window(4,6,37,20); textbackground(0);
    gotoxy(1,15);

    termprotocol:=gtp(TRUE,FALSE);
    pnumber:=protocols[termprotocol]^.ptype;
    dok:=FALSE;
    removewindow(wind1);
    window(4,10,76,15); gotoxy(sxx2,syy2); textbackground(1);
    if termprotocol=-1 then
      removewindow(wind)
    else begin
      if pnumber=4 then begin
        dok:=TRUE;
        i:=mini.dpath;
      end else begin
        tc(15); writeln; writeln(' Enter file to download to, <CR> to abort.');
        write(' '); for j:=1 to 70 do write('_'); writeln;
        ft:=255;
        tc(9); write('');
        tc(11); infield(i,70);
        removewindow(wind);
        if i<>'' then begin
          assign(f,i);
          {$I-} reset(f); {$I+}
          if ioresult<>0 then begin
            {$I-} rewrite(f); {$I+}
            if ioresult=0 then begin
              close(f);
              erase(f);
              dok:=TRUE;
            end else begin
              dok:=FALSE;
              removewindow(wind);
              tellak('Illegal filename');
              cursoron(TRUE);
            end;
          end else begin
            close(f);
            setwindow(wind,27,10,52,16,9,1,1);
            clearscr; tc(15);
            writeln;
            writeln(#7+'  File already exists.');
            writeln;
            write('  Overwrite? '); tc(3);
            dok:=lyn;
            removewindow(wind);
          end;
        end;
      end;
      if dok then begin
        outcom:=FALSE; incom:=FALSE;
        fileboard:=1;
        suboard:=uboards[1]^.dlpath; uboards[1]^.dlpath:=mini.dpath;
        receive1(i,FALSE,dok,kabort,addbatch);
        uboards[1]^.dlpath:=suboard;
        term_ready(TRUE);
        cs(hs);
      end;
      removewindow(wind);
    end;
    hangup:=FALSE;
    incom:=FALSE;
    outcom:=FALSE;
    gotoxy(sxx,syy);
    tc(7);
*)
  end;

  procedure pc(s:astr);
  var i:integer;
  begin
    s:=s+#13;
    for i:=1 to length(s) do sendcom1(s[i]);
  end;

  procedure initmodem;
  begin
    com_flush_rx;
    delay(500); pc('AT');
    delay(500); pc('ATQ0V1E1S2=43M0S11=50');
    delay(200);
    com_flush_rx;
  end;

  procedure savedialer;
  var i:integer;
  begin
    reset(fil);
    rewrite(fil);
    for i:=1 to hientrynum do begin
      seek(fil,i-1);
      write(fil,ns[i]);
    end;
    close(fil);
  end;

  procedure redial;
  const loco=9;
        hico=15;
        ttspend=30;
  var c,kk:char;
      done,done1,gotonext,checking:boolean;
      try:integer;
      rl,rl1,rl2:real;
      int:integer;
      i,i1,rs,rc:astr;
      sxx,syy:integer;
      cl:integer;
      slpos:integer;

    procedure getresultcode(rs:astr);
    var i,j:integer;
    begin
      with systat do
        for i:=1 to 2 do
          for j:=0 to 4 do
            if (modemr.resultcode[i][j]<>0) and
               (rs=cstr(modemr.resultcode[i][j])) then begin
              case j of
                0:spd:='300'; 1:spd:='1200'; 2:spd:='2400';
                3:spd:='4800'; 4:spd:='9600';
              end;
              chkcom:=TRUE;
              exit;
            end;
    end;
      
  begin
    cursoron(FALSE);
    savepos(sxx,syy);
    setwindow(wind,1,1,51,9,9,1,1);
    clearscr; try:=0;
    hs:=ns[lnd].hs; cs(hs); rl:=timer;
    chkcom:=FALSE; done:=FALSE; checking:=FALSE; rc:=''; spd:='N.A.';
    pc('ATX4M0Q0V0E0S7=16');
    tc(loco);
    writeln('Redial started at 00:00:00');
    writeln('Attempt #0        00:00:00');
    write('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
    writeln('Dialing');
    writeln('     at');
    write('<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>');
    write('Last result: None.');
    gotoxy(31,1);
    tc(14); write('Hit '); textbackground(4); write('<ESC>');
    textbackground(1); write(' to abort');

    tc(hico);
    gotoxy(19,1); write(ctim(timer));

    gotoxy(9,4); write(ns[lnd].name);
    gotoxy(9,5); write(ns[lnd].number);
    tc(loco); write(' ... '); slpos:=wherex;
    gotoxy(10,2);
    tc(hico); write('0');
    delay(500); com_flush_rx;

    repeat
      pc('ATDT'+ns[lnd].number);
      inc(try);
      tc(hico);
      gotoxy(10,2); write(try);
      gotoxy(19,2); write(ctim(timer));
      com_flush_rx;
      kk:=#0;
      rl:=timer;
      done1:=FALSE;
      while ((not done) and (not done1) and (com_rx_empty)) do begin
        gotonext:=FALSE;
        rl1:=timer;
        if rl1<rl then rl1:=rl1+24.0*3600.0;
        rl2:=(ttspend-abs(rl1-rl))+1;
        gotoxy(slpos,5);
        tc(hico); write(trunc(rl2));
        tc(loco); write(' seconds   ');
        if trunc(rl2)<=0 then done1:=TRUE;
        if keypressed then begin
          kk:=readkey;
          if kk in [#27,#32] then done:=TRUE;
          if kk=#32 then gotonext:=TRUE;
          if upcase(kk)='C' then checking:=not checking;
        end;
        if ((done1) or (done)) then sendcom1('A');
      end;
      delay(100); rc:='';
      if ((not com_rx_empty) or (done1) or (gotonext)) then begin
        if (not com_rx_empty) then begin
          rs:='';
          rl1:=timer;
          while tchk(rl1,0.4) do begin
            c:=cinkey;
            if c in [#32..#255] then rs:=rs+c;
          end;
          if checking then begin
            gotoxy(1,6); tc(loco);
            for int:=1 to 20 do write('<27>');
            gotoxy(1,6); tc(hico); write('"'+rs+'"');
          end;
        end;
        rs:=cstr(value(copy(rs,1,3)));
        with systat do begin
          if (modemr.busy<>0) then
            if rs=cstr(modemr.busy) then begin rc:='BUSY'; cl:=14; end;
          if (modemr.nocarrier<>0) or (done1) then
            if (rs=cstr(modemr.nocarrier)) or (done1) then begin rc:='NO CARRIER'; cl:=12; end;
          if (modemr.nodialtone<>0) then
            if rs=cstr(modemr.nodialtone) then begin rc:='NO DIALTONE'; cl:=28; end;
          getresultcode(rs);
        end;
        if (chkcom) then begin rc:='CONNECT '+spd+'!'; cl:=30; end;
      end;

      if kk=#27 then begin rc:='User abort!'; cl:=15; end;
      if kk=#32 then begin rc:='Skipped to next.'; cl:=15; end;

      if rc<>'' then begin
        gotoxy(14,7); tc(15); clreol;
        gotoxy(14,7); tc(cl); write(rc); tc(7);
      end;

      if chkcom then done:=TRUE;
      if rc='NO DIALTONE' then done:=TRUE;
      if gotonext then done:=FALSE;
    until done;

    if (rc='NO DIALTONE') and (kk<>#27) then begin
      clearscr;
      tc(28); writeln(' NO DIALTONE ');
      writeln;
      tc(12); writeln('Dial tone is NOT detected.');
      gotoxy(1,7); textbackground(4); tc(14); clreol;
      gotoxy(2,7); write('Hit any key to return to terminal mode');
      textbackground(1);
      repeat
        sound(800); delay(100);
        nosound; delay(50);
      until keypressed;
      c:=readkey;
    end;

    if (not chkcom) or (spd='N.A.') then initmodem
    else begin
      removewindow(wind);
      tell('Connection Established at '+spd+' baud');
      repeat
        sound(1200); delay(30); sound(1300); delay(60);
        sound(1500); delay(90); sound(2000); delay(120);
        nosound; delay(100);
      until (try=30) or (keypressed);
      if keypressed then c:=readkey;
    end;

    removewindow(wind);
    gotoxy(sxx,syy);
    textbackground(0); tc(7);
    cursoron(TRUE);
  end;

  procedure dial;
  var sxx,syy,i,j,k:integer;
      changed,done:boolean;
      qd,c:char;
      s:astr;
      savp:pnrec;

    procedure updatelist;
    var i:integer;
    begin
      tc(15); gotoxy(67,1); write('Page '+cstr(pagnum)+' of '+cstr(pages));
      writeln;
      for i:=(pagnum-1)*10+1 to (pagnum-1)*10+10 do begin
        gotoxy(1,(i-(pagnum-1)*10)+2);
        if i<=hientrynum then begin
          tc(9); write(i);
          tc(15); tab(4); write(ns[i].name);
          tc(14); tab(46); write(ns[i].number);
          tc(11); tab(61);
          case ns[i].hs of
            0:writeln(' 300');
            1:writeln('1200');
            2:writeln('2400');
            3:writeln('4800');
            4:writeln('9600');
          end;
        end
        else clreol;
      end;
    end;

    procedure showlist;
    var i:integer;
    begin
      clearscr;
      tc(15); writeln('N  NAME                                      NUMBER         SPD');
      tc(9); writeln('<27><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>  <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>  <20><><EFBFBD><EFBFBD>');
    end;

    procedure resetpages;
    begin
      pages:=((hientrynum-1) div 10)+1;
    end;

    procedure dcmds(i:integer);
    var x,y:integer;
    begin
      cursoron(TRUE);
      savepos(x,y);
      gotoxy(1,15); clreol;
      gotoxy(1,16); clreol;
      if i<>0 then begin
        gotoxy(1,15); tc(15); write('Dial: '); tc(9);
        writeln('(PgUp PgDn) [A]dd [C]lear [D]ial [I]nsert [K]ill [M]odify');
        tab(19); write('[Q]uit');
        cursoron(FALSE);
      end;
      gotoxy(x,y);
    end;

  begin
    changed:=FALSE;
    cursoron(FALSE);
    savepos(sxx,syy);
    setwindow(wind,1,5,79,22,9,1,1);
    showlist;
    done:=FALSE;
    repeat
      updatelist;
      dcmds(1);
      repeat c:=upcase(readkey);
      until pos(c,#27+'Q0123456789ACDIKM'+#0)>0;
      if c in ['0'..'9'] then begin qd:=c; c:='D'; end else qd:=#0;
      gotoxy(1,15);
      case c of
        #0:if keypressed then
             case readkey of
               #73:if pagnum>1 then dec(pagnum);
               #81:if pagnum<pages then inc(pagnum);
             end;
        'Q',
        #27:begin
              done:=TRUE;
              removewindow(wind);
              gotoxy(sxx,syy);
            end;
        'A':begin
              if hientrynum<>50 then begin
                inc(hientrynum);
                with ns[hientrynum] do begin
                  name:='';
                  number:='';
                  hs:=maxs;
                end;
                resetpages;
                changed:=TRUE;
              end
              else write(^G);
            end;
        'C':begin
              dcmds(0);
              tc(15); write('Clear which? :');
              infield(s,2);
              i:=value(s);
              if (i>=1) and (i<=hientrynum) then begin
                with ns[i] do begin
                  name:='';
                  number:='';
                  hs:=maxs;
                end;
                resetpages;
                changed:=TRUE;
              end;
            end;
        'D':begin
              dcmds(0);
              tc(15); write('Dial which? :');
              if qd<>#0 then s:=qd else s:='';
              infield1(wherex,wherey,s,2);
              i:=value(s);
              if (i>=1) and (i<=hientrynum) then begin
                removewindow(wind);
                lnd:=i;
                if changed then savedialer;
                changed:=FALSE;
                redial;
                done:=TRUE;
              end;
            end;
        'I':begin
              if hientrynum<>50 then begin
                dcmds(0);
                tc(15); write('Insert before which? :');
                infield(s,2);
                i:=value(s);
                if (i>=1) and (i<=hientrynum+1) then begin
                  if i<>hientrynum+1 then
                    for j:=hientrynum+1 downto i+1 do
                      ns[j]:=ns[j-1];
                  with ns[i] do begin
                    name:='';
                    number:='';
                    hs:=maxs;
                  end;
                  inc(hientrynum);
                  resetpages;
                  changed:=TRUE;
                end;
              end
              else write(^G);
            end;
        'K':begin
              if hientrynum>1 then begin
                dcmds(0);
                tc(15); write('Kill which? :');
                infield(s,2);
                i:=value(s);
                if (i>=1) and (i<=hientrynum) then begin
                  if i<>hientrynum then
                    for j:=i to hientrynum-1 do
                      ns[j]:=ns[j+1];
                  dec(hientrynum);
                  resetpages;
                  changed:=TRUE;
                end;
              end;
            end;
        'M':begin
              dcmds(0);
              tc(15); write('Modify which? :');
              infield(s,2);
              i:=value(s);
              if (i>=1) and (i<=hientrynum) then begin
                clearscr;
                writeln('Entry number: ',i);
                writeln('Enter <CR> alone at any prompt for no change.');
                writeln;
                tc(14); write('Name:   '); tc(15); writeln(ns[i].name);
                tc(14); write('Number: '); tc(15); writeln(ns[i].number);
                tc(14); write('Speed:  '); tc(15);
                case ns[i].hs of
                  0:write('300');
                  1:write('1200');
                  2:write('2400');
                  3:write('4800');
                  4:write('9600');
                end;
                writeln(' baud');
                s:=ns[i].name; infield1(9,4,s,40);
                if s<>ns[i].name then begin
                  ns[i].name:=s;
                  changed:=TRUE;
                end;
                s:=ns[i].number; infield1(9,5,s,14);
                if s<>ns[i].number then begin
                  ns[i].number:=s;
                  changed:=TRUE;
                end;
                writeln;
                tc(11); write('[3]00  ');
                if maxs>0 then write('[1]200  ');
                if maxs>1 then write('[2]400  ');
                if maxs>2 then write('[4]800  ');
                if maxs>3 then write('[9]600  ');
                writeln;
                writeln;
                tc(9); write('New speed? ');
                c:=readkey; tc(11);
                if c in ['3','1','2','4','9'] then begin
                  writeln(c);
                  changed:=TRUE;
                end
                else writeln('No change.');
                with ns[i] do
                  case c of
                    '3':hs:=0;
                    '1':hs:=1;
                    '2':hs:=2;
                    '4':hs:=3;
                    '5':hs:=4;
                  end;
                c:=' ';
                showlist;
              end;
            end;
      end;
      cursoron(FALSE);
    until (done);
    if changed then savedialer;
    textbackground(0); tc(15);
    gotoxy(sxx,syy);
    cursoron(TRUE);
  end;

  procedure pp(s:astr);
  var i:integer; c:char;
  begin
    for i:=1 to length(s) do
    begin
      c:=s[i];
      if c='{' then c:=#13;
      if eco then om(c);
      sendcom1(c);
    end;
  end;

  procedure wcenter(s:string; color,row:integer);
  var col:integer;
  begin
    col:=((80-length(s)) div 2); gotoxy(col,row);
    tc(color); write(s);
  end;

  procedure logo;
  begin
    clearscr; tc(1); box(1,11,1,68,5); window(1,1,80,25);
    wcenter('Telegard MiniTerm - Version '+ver,15,2);
    wcenter('Copyright 1988,89,90 by Eric Oman, Martin Pollard,',11,3);
    wcenter('and Todd Bolitho - All Rights Reserved.',11,4);
    wcenter('To get help, press "Alt-Z".',14,6);
    tc(7);
  end;

  procedure help;
  var x,y:integer;
        c:char;
  begin
    cursoron(FALSE);
    savepos(x,y);

    setwindow(wind,43,1,80,18,4,0,1);
    tc(15);
    writeln('Alt-B = backspacing toggle');
    writeln('Alt-C = clear screen');
    writeln('Alt-D = dialer');
    writeln('Alt-E = echo toggle');
    writeln('Alt-H = hang up');
    writeln('Alt-I = initialize modem');
    writeln('Alt-J = jump to DOS');
    writeln('Alt-L = line feeds toggle');
    writeln('Alt-M = turbo screen mode toggle');
    writeln('Alt-R = redial last number');
    writeln('Alt-S = speed toggle');
    writeln('Alt-X = exit');
    writeln('PgUp  = send file from dloads');
    writeln('PgDn  = receive file into dloads');
    writeln;

    tc(9); write('Press any key....');
    repeat until keypressed;
    c:=readkey;

    removewindow(wind);
    gotoxy(x,y);
    cursoron(TRUE);
  end;

  procedure init;
  var x,y:integer;

    procedure loading(s:astr);
    begin
      tc(9); write('<27> ');
      tc(11); writeln('Loading "'+s+'"');
    end;

  begin
    trm:=TRUE;

    tchkpart:=0; timerison:=FALSE;

    lfeeds:=FALSE; nopfile:=FALSE; eco:=FALSE; wantout:=TRUE; checkit:=FALSE;
    wantfilename:=FALSE; enddayf:=FALSE; mailread:=FALSE; smread:=FALSE;
    beepend:=FALSE; useron:=FALSE; chatcall:=FALSE;
    outcom:=FALSE; incom:=FALSE; hangup:=FALSE; hungup:=FALSE;
    lnd:=0;
    ll:=''; chatr:=''; usernum:=1;
    curco:=7; sdc;
    delay(50); com_flush_rx; term_ready(TRUE);
{    iport;}
    com_flush_rx;

    infield_out_fgrd:=15;
    infield_out_bkgd:=1;
    infield_inp_fgrd:=0;
    infield_inp_bkgd:=7;
    infield_arrow_exit:=FALSE;

    getdir(0,start_dir);
    window(1,1,80,25);
    logo;

    savepos(x,y);
    setwindow(wind,1,1,50,8,9,1,1);

    with modemr do begin
      if (waitbaud=300) then maxs:=0;
      if (waitbaud=1200) then maxs:=1;
      if (waitbaud=2400) then maxs:=2;
      if (waitbaud=4800) then maxs:=3;
      if (waitbaud=9600) then maxs:=4;
    end;

    {rcg11242000 dosisms.}
    {
    loading(start_dir+'\miniterm.fon');
    if not exist(start_dir+'\miniterm.fon') then begin
      assign(fil,start_dir+'\miniterm.fon');
    }

    loading(start_dir+'/miniterm.fon');
    if not exist(start_dir+'/miniterm.fon') then begin
      assign(fil,start_dir+'/miniterm.fon');
      rewrite(fil);
      with ns[1] do begin
        name:='Grosse Pointe Centrale';
        number:='1-313-885-1779';
        hs:=2;
      end;
      write(fil,ns[1]);
      close(fil);
    end;

    {rcg11242000 DOSism.}
    {assign(fil,start_dir+'\miniterm.fon');}
    assign(fil,start_dir+'/miniterm.fon');
    reset(fil);
    hientrynum:=0;
    repeat
      hientrynum:=hientrynum+1;
      seek(fil,hientrynum-1);
      read(fil,ns[hientrynum]);
    until hientrynum=filesize(fil);
    close(fil);
    pages:=((hientrynum-1) div 10)+1;
    pagnum:=1;

    {rcg11242000 DOSisms.}
    {
    loading(start_dir+'\miniterm.cfg');
    if not exist(start_dir+'\miniterm.cfg') then begin
      assign(cfgfil,start_dir+'\miniterm.cfg');
    }

    loading(start_dir+'/miniterm.cfg');
    if not exist(start_dir+'/miniterm.cfg') then begin
      assign(cfgfil,start_dir+'/miniterm.cfg');
      rewrite(cfgfil);
      with mini do begin
        {rcg11242000 dosism.}
        {dpath:=start_dir+'\';}
        dpath:=start_dir+'/';
      end;
      write(cfgfil,mini);
      close(cfgfil);
    end;
    {rcg11242000 DOSism.}
    {assign(cfgfil,start_dir+'\miniterm.cfg');}
    assign(cfgfil,start_dir+'/miniterm.cfg');
    reset(cfgfil); read(cfgfil,mini); close(cfgfil);

    removewindow(wind);
    gotoxy(x,y);
    cursoron(TRUE);

    hs:=maxs; cs(hs); ss(hs); bac:=FALSE;
    done:=FALSE;

    initmodem;
  end;

var mtcolors,showascii:boolean;
    rcode:integer;

begin
  mtcolors:=FALSE; showascii:=FALSE;
  init;

  rl:=timer;
  repeat
    if (not com_rx_empty) then begin
      c:=cinkey1;
      in1(c);
      if (showascii) then write('(',ord(c),')');
    end else begin
      if (timer<rl) then rl:=rl-24.0*3600.0;
      if (timer-rl>10.0*60.0) then done:=TRUE;
    end;
    if (keypressed) then begin
      c:=readkey;
      if (c=#0) then
        if (keypressed) then begin
          c:=readkey;
          case ord(c) of
            18:begin
                 eco:=not eco;
                 if eco then tellak('Echo ON') else tellak('Echo OFF');
                 cursoron(TRUE);
               end;
            19:if lnd in [1..50] then redial;
            23:begin
                 savepos(sx,sy);
                 tell('Initializing modem....');
                 initmodem;
                 removewindow(wind);
                 gotoxy(sx,sy);
                 cursoron(TRUE);
                 tc(7);
               end;
            27:pp(#27);
            31:begin
                 hs:=hs+1;
                 if hs>maxs then hs:=0;
                 cs(hs);
                 ss(hs);
               end;
            32:begin
                 dial;
                 tc(7);
               end;
            35:begin
                 savepos(sx,sy);
                 tell('Hanging up....');
                 hang;
                 removewindow(wind);
                 gotoxy(sx,sy);
                 cursoron(TRUE);
                 tc(7);
               end;
            36:begin
                 i:=textattr;
                 savepos(sx,sy);
                 setwindow(wind,1,1,80,25,7,0,0);
                 writeln('Type "EXIT" to return to MiniTerm.');
                 shelldos(FALSE,'',rcode);
                 cs(hs);
                 removewindow(wind);
                 gotoxy(sx,sy);
                 textattr:=i;
                 if (doserror<>0) then
                   tellak('Could not execute COMMAND.COM');
               end;
            38:begin
                 lfeeds:=not lfeeds;
                 if lfeeds then tellak('Line feeds ON')
                           else tellak('Line feeds OFF');
                 cursoron(TRUE);
               end;
            44:help;
            45:begin
                 cursoron(FALSE);
                 savepos(sx,sy);
                 returna:=FALSE;
                 done:=TRUE;
                 com_flush_rx;
                 removewindow(wind);
                 gotoxy(sx,sy);
                 cursoron(TRUE);
                 clearscr;
                 chdir(start_dir);
               end;
            46:clearscr;
            48:begin
                 bac:=not bac;
                 if bac then tellak('Backspace: Destructive')
                        else tellak('Backspace: Non-Destructive');
                 cursoron(TRUE);
               end;
            50:begin
                 mtcolors:=not mtcolors;
                 if (mtcolors) then sendmpcode('rmt1')
                   else sendmpcode('rmt0');
                 if mtcolors then tellak('Turbo screen mode ON')
                             else tellak('Turbo screen mode OFF');
               end;
            130:showascii:=not showascii;
            73:ul;
            75:if (okansi) then pp(#27+'[D');
            77:if (okansi) then pp(#27+'[C');
            72:if (okansi) then pp(#27+'[A');
            80:if (okansi) then pp(#27+'[B');
            81:dl;
          end;
        end else
          om(c)
      else begin
        sendcom1(c);
        if (eco) then om(c);
      end;
      rl:=timer;
    end;
  until (done);
  trm:=FALSE;
end;

function loadfiles:boolean;
var errs:boolean;
    systatf:file of systatrec;
    modemrf:file of modemrec;
begin
  errs:=FALSE;
  assign(systatf,'status.dat');
  {$I-} reset(systatf); {$I+}
  errs:=(ioresult<>0);
  if (not errs) then begin
    {$I-} read(systatf,systat); {$I+}
    errs:=(ioresult<>0);
  end;
  close(systatf);
  if (not errs) then begin
    assign(modemrf,systat.gfilepath+'modem.dat');
    {$I-} reset(modemrf); {$I+}
    errs:=(ioresult<>0);
    if (not errs) then read(modemrf,modemr);
    close(modemrf);
  end;
  if (not errs) then begin
    assign(uf,systat.gfilepath+'user.lst');
    {$I-} reset(uf); {$I+}
    errs:=(ioresult<>0);
    if (not errs) then begin
      seek(uf,1);
      read(uf,thisuser);
      with thisuser do begin
        linelen:=80; pagelen:=25;
        ac:=[ansi,color]; ac:=ac-[onekey,pause,novice,avatar];
      end;
    end;
    close(uf);
  end;
  loadfiles:=errs;
end;

begin
  if (loadfiles) then halt(1);
  iport;
  term;
  remove_port;
  halt(0);
end.