Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/FORUM25C.ZIP/WAITCALL.PAS

Pascal/Delphi Source File | 1989-02-25 | 12.4 KB | 472 lines

{$R-,S-,I-,V-,B-,N-,L- }
{$O+}

unit waitcall;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

interface

uses Overlay,
     dos,
     crt,
     gentypes,
     statret,
     configrt,
     modem,
     gensubs,
     subs1,
     subs2,
     mailret,
     overret1,
     mainr1,
     mainr2;

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}


Function waitforacall:boolean;


{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}

implementation

{/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\}


Function waitforacall:boolean;

  VAR wscount:integer;
      mustgetbaud:boolean;

  Procedure maybewritestatus;
  begin
    wscount:=wscount+1;
    if wscount>10 then begin
      writestatus;
      wscount:=0
    end
  end;

  Function checkforhayesreport:boolean;  { Looks for CONNECT 300 }
  VAR n:longint;
      q:sstr;
      p,b:integer;
      k:char;
      brate:baudratetype;
  const lookfor:sstr=#13#10'CONNECT ';
  begin
    checkforhayesreport:=false;
    if numchars=0 then exit;
    p:=1;
    q:='';
    b:=0;
    repeat
      n:=now;
      repeat until (now>n+1) or (numchars>0);
      if numchars=0 then exit else k:=getchar;
      if (k=#13) and (length(q)>0) then begin
        val (q,b,p);
        brate:=b110;
        while (brate<=b9600) and
              ((b<>baudarray[brate])
                or (not (brate in supportedrates)))
              do brate:=succ(brate);
        if brate<=b9600 then begin
          parity:=false;
          baudrate:=b;
          checkforhayesreport:=true;
          mustgetbaud:=false;
          n:=now;
          repeat until carrier or (now>n+1)
        end;
        exit
      end;
      if p>length(lookfor) then q:=q+k else begin
        if k=lookfor[p] then p:=p+1 else begin
          b:=b+1;
          if b=2 then exit
        end
      end
    until false
  end;

  Procedure receivecall;
  VAR b:byte;
      timeout,autoswitch:integer;
      k:char;
      brate:baudratetype;

    Procedure nextrate (VAR b:baudratetype);
    VAR ob:baudratetype;
    begin
      ob:=b;
      repeat
        b:=succ(b);
        if b>b9600 then b:=b110;
        if b=ob then exit
      until b in supportedrates
    end;

    Procedure disconnect;
    begin
      if carrier then hangupmodem;
      baudrate:=defbaudrate;
      parity:=false;
      setparam (usecom,baudrate,parity);
      setupmodem
    end;

    Function seconds:integer;
    VAR r:registers;
    begin
      r.ah:=$2c;
      intr ($21,r);
      seconds:=r.dh
    end;

  label abort,connected;
  begin
    local:=false;
    online:=false;
    textcolor (normbotcolor);
    window (1,1,80,25);
    clrscr;
    window (1,1,80,24);
    if not mustgetbaud then goto connected;
    writeln (usr,'╒═════════════════════════════════════════════════╕');
    writeln (usr,'│               Someone is calling                │');
    writeln (usr,'│    Waiting for the user to press the CR key     │');
    writeln (usr,'│ Press CR yourself to choose displayed BAUD rate │');
    writeln (usr,'│   Press space to advance to the next BAUD rate  │');
    writeln (usr,'│               Press D to disconnect             │');
    writeln (usr,'╘═════════════════════════════════════════════════╛');
    writeln;
    brate:=b110;
    parity:=false;
    timeout:=timer+2;
    repeat
      nextrate (brate);
      baudrate:=baudarray[brate];
      write (usr,^M^J'Trying ',baudrate,' BAUD: ');
      setparam (usecom,baudrate,parity);
      while numchars>0 do k:=getchar;
      autoswitch:=seconds+3;
      if autoswitch>59 then autoswitch:=autoswitch-60;
      repeat until (not carrier) or (numchars>0) or (keyhit) or
                   (timer>=timeout) or (autoswitch=seconds);
      if timer>=timeout then hangupmodem;
      if not carrier then goto abort;
      if keyhit
        then
          begin
            k:=bioskey;
            case upcase(k) of
              #13:goto connected;
              'D':goto abort;
            end
          end
        else
          begin
            if numchars>0 then begin
              b:=ord(getchar);
              write (usr,b,' received.')
            end else b:=0;
            if b<>13
              then if b=141
                then parity:=true
                else
                  begin
                    delay (200);
                    while numchars>0 do b:=ord(getchar)
                  end
          end
    until (b=13) or (b=141) or (timer>timeout);
    if timer<=timeout then begin
      connected:
      setparam (usecom,baudrate,parity);
      if parity
        then baudstr:='E,7'
        else baudstr:='N,8';
      baudstr:=strr(baudrate)+','+baudstr+',1';
      online:=true;
      urec.config:=[lowercase,linefeeds,eightycols];
      writestr (^M^M'Connected at '+baudstr+^M^M);
      newcalls:=newcalls+1;
      if carrier then exit
    end;
    abort:
    disconnect
  end;

  Procedure exitprog;
  begin
    dontanswer;
    window (1,1,80,25);
    textcolor (normtopcolor);
    textbackground (0);
    clrscr;
    gotoxy (30,24);
    writeln (usr,'Use FORUM-PC again!');
    ensureclosed;
    halt(4)
  end;

  Procedure checkday;
  begin
    if lastdayup<>datestr(now) then begin
      lastdayup:=datestr(now);
      numdaysup:=numdaysup+1;
      callstoday:=0;
      writestatus
    end
  end;

  Procedure dotimedevent;
  VAR tf:text;
  begin
    window (1,1,80,25);
    clrscr;
    writeln (usr,'Executing timed event: ',eventbatch);
    writeln (usr);
    assign (tf,'Door.bat');
    rewrite (tf);
    writeln (tf,eventbatch);
    textclose (tf);
    timedeventdate:=datestr(now);
    ensureclosed;
    halt (3)
  end;

  Function statusscreen:char;
  const statwindx=5;
        statwindy=1;
        firstcolx=15;
        firstline=5;
        secondcolx=54;

    Procedure col1;
    begin
      window (statwindx+firstcolx,statwindy+firstline,80,25);
    end;

    Procedure col2;
    begin
      window (statwindx+secondcolx,statwindy+firstline,80,25);
    end;

    Procedure percent (r1,r2:real);
    begin
      if (r2<1) then exit;
      r2:=round((r1/r2)*1000)/10;
      writeln (usr,r2:0:1,'%')
    end;

    Procedure drawstatus;
    VAR totalidle,totalup,totalmins,r:real;
        tmp:integer;
    begin
      col1;
      tmp:=timetillevent;
      if tmp<=30 then begin
        gotoxy (1,0);
        write (usr,'Timed event scheduled in ',tmp,' minutes!  ');
        if tmp<=5 then begin
          dontanswer;
          if tmp<=1 then dotimedevent
        end
      end;
      if carrier or keyhit then exit;
      gotoxy (1,2);
      writeln (usr,callstoday);
      tmp:=elapsedtime (numminsidle);
      write (usr,tmp);
      gotoxy (1,6);
      writeln (usr,numdaysup);
      r:=round(10*numcallers/numdaysup)/10;
      writeln (usr,r:0:1);
      writeln (usr,timestr(now),' ');
      write (usr,datestr(now),'  ');
      col2;
      gotoxy (1,3);
      totalidle:=numminsidle.total+elapsedtime(numminsidle);
      writeln (usr,totalidle:0:0);
      totalup:=totalidle+numminsused.total;
      writeln (usr,totalup:0:0);
      totalmins:=1440.0*(numdaysup-1.0)+timer;
      if (totalup<1) or (totalmins<1) then exit;
      percent (numminsused.total,totalmins);
      percent (numminsxfer.total,totalmins);
      percent (totalidle,totalmins);
      percent (totalup,totalmins);
      percent (totalmins-totalup,totalmins);
      col1;
      gotoxy (1,1);
      maybewritestatus
    end;

    Procedure writeavail;
    VAR m:sstr;
    begin
      gotoxy (1,12);
      m:=sysopavailstr;
      while length(m)<15 do m:=m+' ';
      write (usr,m);
      gotoxy (1,1)
    end;

  VAR cnt,numsmail:integer;
      k:char;
      tmp:mstr;
      b:byte;
      done:boolean;

    Function shouldexit:boolean;
    begin
      shouldexit:=done or carrier
    end;

    Procedure handlekey (k:char; beforeabout:boolean);
    begin
      b:=ord(k)-128;
      case b of
        availtogglechar:begin
          toggleavail;
          if not beforeabout then writeavail
        end;
        59,60,68:begin
          done:=true;
          statusscreen:=k
        end
      end
    end;

    Function interrupted (beforeabout:boolean):boolean;
    begin
      if keyhit then begin
        k:=bioskey;
        handlekey (k,beforeabout)
      end;
      done:=done or carrier;
      interrupted:=done
    end;

  begin
    statusscreen:=#0;
    done:=false;
    window (1,1,80,25);
    textcolor (normbotcolor);
    clrscr;
    window (statwindx,statwindy,80,25);
    gotoxy (1,1);
    if interrupted (true) then exit;
writeln (usr,'                       ╒═══════════════════╕');
writeln (usr,'                       │   ',versionnum,'   │');
writeln (usr,'╒══════════════════════╡ Waiting for calls ╞═══════════════════════╕');
writeln (usr,'│                      ╘═══════════════════╛                       │');
writeln (usr,'│                                                                  │');
    if interrupted (true) then exit;
writeln (usr,'│ Last caller:                      Total mins used:               │');
writeln (usr,'│ Calls today:                      Used by transfer:              │');
writeln (usr,'│ Mins idle:                        Total mins idle:               │');
    if interrupted (true) then exit;
writeln (usr,'│ Sysop mail:                       Total mins up:                 │');
writeln (usr,'│ Total calls:                      Percent used:                  │');
writeln (usr,'│ Total days:                       Percent xfer:                  │');
    if interrupted (true) then exit;
writeln (usr,'│ Calls/day:                        Percent idle:                  │');
writeln (usr,'│ Time:                             Percent up:                    │');
writeln (usr,'│ Date:                             Percent down:                  │');
    if interrupted (true) then exit;
writeln (usr,'│ Recent calls:                     Recent uploads:                │');
writeln (usr,'│ Recent posts:                     Recent feedback:               │');
writeln (usr,'│ Available:                        Recent mail:                   │');
writeln (usr,'│                                                                  │');
writeln (usr,'╘══════════════════════════════════════════════════════════════════╛');
    if interrupted (true) then exit;
    window (1,1,80,25);
    gotoxy (1,24);
    writeln (usr,'Commands:       F1: Forum-Term        F2: Exit Forum-PC');
      write (usr,'                F10: Sign on local    Alt-A: Toggle chat availability');
    if interrupted (true) then exit;
    numsmail:=getnummail(1)+numfeedback;
    tmp:=getlastcaller;
    col1;
    gotoxy (1,1);
    textcolor (normtopcolor);
    write (usr,copy(tmp,1,20));
    gotoxy (1,4);
    writeln (usr,numsmail);
    write (usr,numcallers:0:0);
    gotoxy (1,10);
    writeln (usr,newcalls);
    write (usr,newposts);
    writeavail;
    col2;
    gotoxy (1,1);
    writeln (usr,numminsused.total:0:0);
    write (usr,numminsxfer.total:0:0);
    gotoxy (1,10);
    writeln (usr,newuploads);
    writeln (usr,newfeedback);
    write (usr,newmail);
    repeat
      checkday;
      drawstatus;
      cnt:=0;
      repeat
        delay (250);
        cnt:=cnt+1;
        done:=done or checkforhayesreport
      until (cnt>=240) or interrupted (false) or done
    until done
  end;

VAR k:char;
label exit;
begin
  waitforacall:=false;
  starttimer (numminsidle);
  wscount:=0;
  clrscr;
  repeat
    doanswer;
    mustgetbaud:=true;
    k:=statusscreen;
    if carrier then begin
      receivecall;
      if carrier then goto exit;
    end;
    case ord(k)-128 of
      59:begin
           local:=false;
           online:=false;
           writestatus;
           waitforacall:=true;
           goto exit
         end;
      60:exitprog;
      68:begin
           dontanswer;
           local:=true;
           online:=false;
           newfeedback:=0;
           newuploads:=0;
           newcalls:=0;
           newposts:=0;
           newmail:=0;
           writestatus;
           goto exit
         end
    end
  until 0=1;
  exit:
  textcolor (normbotcolor);
  window (1,1,80,25);
  clrscr
end;

end.