{PICS0F.INC  Pascal Integrated Communications System Overlays}
{ 5/25/87 ver 1.6 Copyright 1987 by Les Archambault}

  Overlay procedure Get_Filename(var xfrname:filename;var Fnames:Fname_array;
      var filecount:integer;var recs,size:integer;var Abort_batch:boolean);

    const
      maxerr=10;
      start_err=25;
    var
      timeout: boolean;
      bt,blocknum,blockcpl,cancel: byte;
      ch: char;
      errcnt,i,mv,vv,block: integer;
      buffer:record_array;
      temp:filename;
      char_count,count:real;

    begin
      cancel:=0;
      OK := FALSE;
      xfrname:='';
      errcnt := 0;
      repeat
        bt := (GetByte(4, timeout) and $7F);
        if bt=ord(CAN) then cancel:=succ(cancel)
        else if cancel>0 then cancel:=0;
        if cancel>=2 then errcnt:=start_err;
        if timeout then
          begin
            errcnt:=succ(errcnt);
            PutByte(ord('C'));
          end;
      until(errcnt>0) and ((bt=ord(SOH)) or (errcnt >= start_err));
      if errcnt >= start_err then errcnt := maxerr
        else
          begin
            errcnt := 0;
            cancel:=0;
          end;
      while (errcnt < maxerr) and (not OK) do
        begin
          case chr(bt) of
            SOH: begin
                   block:=0;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blocknum := Ch_inp;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   blockcpl := not Ch_inp;
                   for i := 1 to 128 do
                     begin
                       count:=lps;
                       if ch_carck then
                         while (not ch_inprdy) and (count>0) do count:=count-1.0;
                       Buffer[i] := Ch_inp;
                     end;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   mv := Ch_inp;
                   count:=lps;
                   if ch_carck then
                     while (not ch_inprdy) and (count>0) do count:=count-1.0;
                   mv := swap(mv) or Ch_inp;
                   if cancel>0 then cancel:=0;
                   OK := (blocknum = blockcpl);
                   if OK then
                      begin
                        OK := (blocknum = lo(block));
                        if OK then
                          begin
                            vv := 0;
                            for i := 1 to 128 do
                               updcrc(vv, Buffer[i]);
                            updcrc(vv, 0);
                            updcrc(vv, 0);
                            OK := (mv = vv);
                            if not OK then write('  ++ CRC ')
                          end
                        else
                          begin
                            OK := (blocknum = lo(pred(block)));
                            if not OK then
                              write('  ++ Block number');
                          end
                      end
                   else write('  ++ Block complement ');
                   ch := GetChar;
                   if OK
                     then
                       begin
                         filecount:=succ(filecount);
                         char_count:=0;
                         temp:=''; i:=0; st:=''; size:=0; recs:=0;
                         repeat            {get filename}
                           i:=succ(i);
                           if buffer[i]<>0 then temp:=temp+upcase(chr(buffer[i]));
                         until (buffer[i]=0) or (i=13);
                         if temp<>'' then
                           repeat           {get char count}
                             if buffer[i]<>0 then st:=st+chr(buffer[i]);
                             i:=succ(i);
                           until buffer[i]=0;
                         if st<>'' then for i:=1 to length(st) do
                         if (not (st[i] in ['0'..'9'])) then delete(st,i,1);
                         val(st,char_count,i);
                         if i<>0 then char_count:=0;
                         if char_count>0 then
                           begin
                             size:=trunc(char_count/1024);
                             if frac(char_count/1024)>0 then size:=succ(size);
                             recs:=trunc(char_count/128);
                             if frac(char_count/128)>0 then recs:=succ(recs);
                           end;
                         for i:=1 to length(temp) do
                           temp[i]:=chr(ord(temp[i]) and $7F);
                         xfrname:=temp;
                         fnames[filecount]:=xfrname;
                         putbyte(ord(ACK));
                       end
                     else
                       begin
                         errcnt := succ(errcnt);
                         writeln(' - error ', errcnt, ' ++');
                         repeat bt:=GetByte(1,timeout) until timeout;
                         PutByte(ord(NAK));
                         bt:=(getbyte(10,timeout) and $7F);
                       end;
                 end;
            CAN: begin
                   cancel:=succ(cancel);
                   if cancel>=2 then
                     begin
                       OK := FALSE;
                       errcnt := maxerr;
                       writeln(usr,'Caller Cancelled.');
                     end;
                 end;
            else begin
                   OK := FALSE;
                   if cancel>0 then cancel:=0;
                   if timeout then write('  ++ Timeout')
                     else write('  ++ Received ', bt, ', not SOH');
                   errcnt := succ(errcnt);
                   writeln(' - error ', errcnt, ' ++');
                   if errcnt < maxerr then
                     begin
                       repeat bt:=GetByte(1,timeout); until timeout;
                       PutByte(ord(NAK));
                       bt:=(getbyte(10,timeout) and $7F);
                     end;
                 end;
          end;    {case}
        end;  { while errcount<maxerror  and not OK}
      if errcnt>=maxerr then
        begin
          abort_batch:=true;
          putbyte(ord(CAN));
          putbyte(ord(CAN));
        end;
    end;

overlay procedure Send_name(name_buf:Record_array;var ok_to_send:boolean);
    const
      maxerr = 10;
    var
      timeout: boolean;
      bt,cancel: byte;
      ch: char;
      i, vv, block, errcnt: integer;
    begin
      errcnt := 0;
      block := 0;
      cancel:=0;
      repeat
        bt := (GetByte(10, timeout) and $7F);
        if timeout then errcnt:=succ(errcnt);
        if bt=ord(CAN) then cancel:=succ(cancel)
        else if cancel>0 then cancel:=0;
        if cancel>=2 then errcnt:=maxerr;
      until (errcnt>=maxerr) or (bt=ord('C')) or (bt=ord('c'));
      bt:=GetByte(1,timeout); { just in case of another character}
      if errcnt<maxerr then
        begin
          errcnt:=0;
          cancel:=0;
          repeat
            vv := 0;
            for i := 1 to 128 do updcrc(vv, name_buf[i]);
            updcrc(vv, 0);
            updcrc(vv, 0);
            PutByte(ord(SOH));
            PutByte(lo(block));
            PutByte(not lo(block));
            for i := 1 to 128 do PutByte(name_buf[i]);
            PutByte(hi(vv));
            PutByte(lo(vv));
            repeat
              bt := (GetByte(10, timeout) and $7F);
              if bt=ord(ACK) then errcnt:=0;
              if (timeout) or (bt=ord(NAK)) then errcnt:=succ(errcnt);
              if timeout then Writeln(' ++ Timeout - Error ',errcnt,' ++');
              if bt=ord(NAK) then Writeln(' ++ NAK received - Error ',errcnt,' ++');
              if bt=ord(CAN) then cancel:=succ(cancel)
              else if cancel>0 then cancel:=0;
              if cancel>=2 then errcnt:=maxerr;
            until (bt in [ord(NAK),ord(ACK)]) or (errcnt>=maxerr) or timeout;
          until (errcnt=0) or (errcnt>=maxerr);
          if errcnt>=maxerr then ok_to_send:=false;
        end
      else
        begin
          ok_to_send:=false;
          if cancel<2 then Writeln(' ++ Timeout receiving header ACK...');
        end;
    end;

Overlay Procedure Get_description(XfrName:filename);
  var  work:strstd;
       i:integer;

  begin {get_description}
   repeat
    writeln(USR, 'Please enter a one line description of your file:');
    writeln(USR);
    writeln(USR, '  |-------------------------------------------------------------------------|');
    work:=prompt('',75,'EL');
    writeln(usr);
   until ((work<>'') and (Ask('Is your description correct'))) or (not online);
   Writeln(usr,' Enter Section Name where the file should be located.');
    with nwin_rec do
      begin
        status := private;
        name := XfrName;
        GetTAD(date);
        user := user_loc;
        descr := work;
        sectn:=get_section_name('D');
        dnloads:=0;
        for i:=0 to 5 do last_dnload[i]:=0;
      end;
    seek(nwin_file, FileSize(nwin_file));
    write(nwin_file, nwin_rec);
  end;

Overlay Procedure List_file(Fname:filename;drive,user:integer);
   var work:strstd;
       Tfile:text;
       ln_count:integer;
   begin
     setsect(drive,user);
     Assign(Tfile,Fname);
     {$I-} Reset(Tfile); {$I+}
     if ioresult=0 then
       begin
         ln_count:=1;
         while (not eof(Tfile)) and (online) and (not brk) do
           begin
             readln(Tfile,work);
             Writeln(usr,work);
             if (user_rec.lines<>99) and (not nonstop) then
               begin
                 ln_count:=succ(ln_count);
                 if ln_count mod user_rec.lines=0 then pause;
               end;
           end;
       end
       else writeln(usr,'File not available.');
     setsect(homdrv,homusr);
   end;

{end of PICS0F.INC }