{ ROSSND.INC - Remote Operating System File Send Routines }

overlay procedure SendXmodem;
{ Send a file using Xmodem protocol }
  var
    OK: boolean;
    this: FilePtr;
    XfrName: FileName;
    XfrFile: untype_file;

   procedure SendFile(var XfrFile: untype_file; remaining: integer);
    const
      maxerr = 10;
    var
      CRCmode, timeout: boolean;
      ch: byte;
      mm, ss, time_on, time_left, i, vv, block, errcnt: integer;
    begin
      timer(time_on, time_left);
      send_time(remaining, mm, ss);
      if mm > time_left
        then
          begin
            writeln(USR, 'Insufficient time remaining for transfer.');
            OK := FALSE
          end
        else
          begin
            errcnt := 0;
            block := 1;
            writeln(USR, XfrName, ' contains ', remaining, ' blocks.');
            writeln(USR, 'Send time: ', mm, ' minutes ',ss, ' seconds at ', rate, ' bps.');
            writeln(USR, 'To cancel, type CTRL-X repeatedly.');
            writeln(USR, 'Ready to send...');
            repeat
              ch := GetByte(10, timeout);
              CRCmode := (ch = ord('C'));
              if CRCmode
                then
                  begin
                    writeln('CRC mode requested.');
                    errcnt := 0
                  end
              else if ch = ord(NAK)
                then
                  begin
                    writeln('Checksum mode requested.');
                    errcnt := 0
                  end
                else errcnt := succ(errcnt)
            until (errcnt = 0) or (errcnt >= maxerr);
            while (remaining > 0) and (errcnt < maxerr) do
              begin
                blockread(XfrFile, Buffer, BufBlocks);
                remaining := pred(remaining);
                repeat
                  vv := 0;
                  if CRCmode
                    then
                      begin
                        for i := 1 to 128 do
                          updcrc(vv, Buffer[i]);
                        updcrc(vv, 0);
                        updcrc(vv, 0)
                      end
                    else for i := 1 to 128 do
                           vv := vv + Buffer[i];
                  PutByte(ord(SOH));
                  PutByte(lo(block));
                  PutByte(not lo(block));
                  for i := 1 to 128 do
                    PutByte(Buffer[i]);
                  if CRCmode
                    then PutByte(hi(vv));
                  PutByte(lo(vv));
                  ch := GetByte(10, timeout);
                  if ch = ord(ACK)
                    then
                      begin
                        write(CR, 'Block sent: ', block);  { Local display of what is happening }
                        block := succ(block);
                        errcnt := 0
                      end
                    else
                      begin
                        writeln;
                        if ch = ord(NAK)
                          then write('  ++ NAK received')
                          else write('  ++ Timeout');
                        errcnt := succ(errcnt);
                        writeln('.  Error ', errcnt, ' in block ', block, '. ++')
                      end
                until (errcnt = 0) or (errcnt >= maxerr)
              end;
            writeln;
            OK := (errcnt = 0);
            if OK
              then
                begin
                  repeat
                    PutByte(ord(EOT));
                    if ord(ACK) = GetByte(10, timeout)
                      then errcnt := 0
                      else errcnt := succ(errcnt)
                  until (errcnt = 0) or (errcnt >= maxerr);
                  ch := GetByte(2, timeout);
                  OK := (errcnt = 0);
                  if OK
                    then writeln(USR, 'Transfer complete.')
                    else writeln(USR, 'End of file not acknowledged.')
                end
              else writeln(USR, 'Transfer aborted.')
          end;
    end;

  begin { SendXmodem }
    XfrName := compress(prompt('File name: ', 12, 'ES'));
    writeln(USR);
    if XfrName <> ''
      then
        begin
          if 0 = pos('.', XfrName)
            then XfrName := XfrName + '.';
          if in_library
            then this := LibBase
            else this := DirBase;
          while (this <> nil) and (XfrName <> compress(this^.fname)) do
            this := this^.next;
          if XfrName = compress(this^.fname)
            then
              begin
                log(5, XfrName);
                SetSect(SetDrv, SetUsr);
                if in_library
                  then
                    begin
                      seek(libr_file, this^.index);
                      SendFile(libr_file, this^.fsize)
                    end
                  else
                    begin
                      Assign(XfrFile, XfrName);
                      Reset(XfrFile);
                      SendFile(XfrFile, FileSize(XfrFile));
                      Close(XfrFile)
                    end
              end
            else writeln(USR, XfrName, ' not found.');
          SetSect(HomDrv, HomUsr);
          if OK
            then
              begin
                log(7, '');
                user_rec.download := succ(user_rec.download)
              end
            else log(8, '')
        end
  end;

overlay procedure SendText;
  var
    OK: boolean;
    this: FilePtr;
    XfrName: FileName;
    XfrFile: untype_file;

  procedure SendFile(var XfrFile: untype_file; remaining: integer);
  { Send a squeezed or ASCII file }
    const
      recognize = $FF76;
      DLE       = $90;
    var
      EndOfFile, squeezed: boolean;
      ch: byte;
      i, x, BufferPtr, bpos, curin, repct, lastc, NoOfRecs: integer;
      FileType: String[3];
      ErrMsg: StrPr;
      dnode: array [0..255, 0..1] of integer;

    function getc: integer;
    { Get an 8 bit value from the input buffer - read block if necessary }
      begin
        if BufferPtr > BufSize
          then
            begin
              if BufBlocks < remaining
                then NoOfRecs := BufBlocks
                else NoOfRecs := remaining;
              if NoOfRecs > 0
                then BlockRead(XfrFile, Buffer, NoOfRecs)
                else EndOfFile := TRUE;
              remaining := remaining - NoOfRecs;
              BufferPtr := 1
            end;
        getc := Buffer[BufferPtr];
        BufferPtr := succ(BufferPtr)
      end;

    function getw: integer;
    { Get a 16 bit value from the input buffer }
      begin
        getw := getc + Swap(getc)
      end;

    procedure BuildTree;
    { Build decode tree }
      var
        i, CheckSum, numnodes: integer;
      begin
        ErrMsg := '';
        if recognize = getw                 { Is it really a squeezed file? }
          then
            begin
              CheckSum := getw;             { Get checksum }
              XfrName := '';
              i := getc;                    { Build original file name }
              while i <> 0 do
                begin
                  XfrName := XfrName + UpCase(chr(i));
                  i := getc
                end;
              numnodes := getw;             { Get the number of nodes in tree }
              if (0 < numnodes) and (numnodes <= 256)
                then for i := 0 to pred(numnodes) do
                  begin
                    dnode[i, 0] := getw;
                    dnode[i, 1] := getw;
                  end
                else
                  begin
                    ErrMsg := 'Invalid decode tree size.';
                    squeezed := FALSE
                  end
            end
          else squeezed := FALSE
      end;

    function gethuff: integer;
    { Get character coding }
      var
        i: integer;
      begin
        i := 0;
        repeat
          bpos := succ(bpos);
          if bpos > 7
            then
              begin
                curin := getc;
                bpos := 0
              end
            else curin := curin shr 1;
          i := dnode[i, curin and $0001]
        until i < 0;
        i := -succ(i);
        if i = 0
          then gethuff := 26
          else gethuff := i
      end;

    function getcr: integer;
      var
        c: integer;
      begin
        if repct > 0
          then
            begin
              repct := pred(repct);
              getcr := lastc
            end
          else
            begin
              c := gethuff;
              if c = DLE
                then
                  begin
                    repct := gethuff;
                    if repct = 0
                      then getcr := DLE
                      else
                        begin
                          repct := repct - 2;
                          getcr := lastc
                        end
                  end
                else
                  begin
                    getcr := c;
                    lastc := c
                  end
            end
      end;

    begin { SendFile }
      i := pos('.', XfrName);
      if 0 = i
        then FileType := ''
        else FileType := copy(XfrName, succ(i), length(XfrName));
      squeezed := ('Q' = FileType[2]);
      repct := 0;
      bpos := 8;
      ErrMsg := '';
      BufferPtr := MaxInt;                  { Force a read the first time }
      EndOfFile := FALSE;
      if remaining > 0
        then
          begin
            if squeezed
              then BuildTree;
            i := pos('.', XfrName);
            if 0 = i
              then FileType := ''
              else FileType := copy(XfrName, succ(i), length(XfrName));
            if (FileType = 'COM') or (FileType = 'OBJ') or
               (FileType = 'EXE') or (FileType = 'LBR')
              then ErrMsg := 'Xmodem protocol required for ".' + FileType + '" files.';
            if ErrMsg = ''
              then
                begin
                  if squeezed
                    then
                      begin
                        writeln(USR, '      ---> ', XfrName);
                        x := getcr
                      end
                    else x := getc;
                  while (not brk) and (not EndOfFile) and (x <> 26) do
                    begin
                      write(USR, chr(x));
                      if squeezed
                        then x := getcr
                        else x := getc
                    end
                end
          end
        else ErrMsg := 'Missing or empty input file.';
      if ErrMsg <> ''
        then writeln(USR, ErrMsg)
    end;

  begin { SendText }
    XfrName := compress(prompt('File name: ', 12, 'ES'));
    writeln(USR);
    if XfrName <> ''
      then
        begin
          if 0 = pos('.', XfrName)
            then XfrName := XfrName + '.';
          if in_library
            then this := LibBase
            else this := DirBase;
          while (this <> nil) and (XfrName <> compress(this^.fname)) do
            this := this^.next;
          if XfrName = compress(this^.fname)
            then
              begin
                log(6, XfrName);
                SetSect(SetDrv, SetUsr);
                if in_library
                  then
                    begin
                      seek(libr_file, this^.index);
                      SendFile(libr_file, this^.fsize)
                    end
                  else
                    begin
                      Assign(XfrFile, XfrName);
                      Reset(XfrFile);
                      SendFile(XfrFile, FileSize(XfrFile));
                      Close(XfrFile)
                    end
              end
            else writeln(USR, XfrName, ' not found.');
          SetSect(HomDrv, HomUsr);
          log(7, '')
        end
  end;