(* RECEIVE SECTION *)
 
segment procedure recsw(var rec_ok: boolean);
 
function rdata: char;
 
(* send file data *)
 
var num, len: integer;
    ch: char;
 
  begin
 
    repeat
        if numtry > maxtry then
          begin
            state := 'a';
            exit(rdata)
          end;
 
        num_try := num_try + 1;
 
        ch := rpack(len,num,recpkt);   (* receive a packet *)
 
        refresh_screen(numtry,n);
 
        if (ch = 'D') then             (* got data packet *)
          begin
            if (num <> (n mod 64)) then (* wrong packet *)
              begin
                if (oldtry > maxtry) then
                  begin
                    rdata := 'a';      (* too many tries, abort *)
                    exit(rdata)
                  end; (* if *)
 
                n := n - 1;
 
                if (num = (n mod 64)) then (* previous packet again *)
                  begin                (* so re-ACK it *)
                    spack('Y',num,6,packet);
                    numtry := 0;       (* reset try counter *)
                                       (* stay in same state *)
                  end (* if *)
                else                   (* wrong number *)
                    state := 'a'       (* so abort *)
              end (* if *)
            else                       (* right packet *)
              begin
                bufemp(recpkt,f,len);  (* write data to file *)
                spack('Y',(n mod 64),0,packet); (* ACK packet *)
                oldtry := numtry;      (* reset try counters *)
                numtry := 0;
                n := n + 1             (* bump packet number *)
                                       (* stay in data send state *)
              end (* else *)
          end (* if 'D' *)
        else if (ch = 'F') then        (* file header *)
          begin
            if (oldtry > maxtry) then
              begin
                rdata := 'a';          (* too many tries, abort *)
                exit(rdata)
              end; (* if *)
 
            n := n - 1;
 
            if (num = (n mod 64)) then (* previous packet again *)
              begin                    (* so re-ACK it *)
                spack('Y',num,0,packet);
                numtry := 0;           (* reset try counter *)
                state := state;        (* stay in same state *)
              end (* if *)
            else
                state := 'a'           (* not previous packet, abort *)
          end (* if 'F' *)
        else if (ch = 'Z') then        (* end of file *)
          begin
            if (num <> (n mod 64)) then(* wrong packet, abort *)
              begin
                rdata := 'a';
                exit(rdata)
              end; (* if *)
            spack('Y',n mod 64,0,packet); (* ok, ACK it *)
            close(f,lock);             (* close up the file *)
            n :=  n + 1;               (* bump packet counter *)
            state := 'f';              (* go to complete state *)
          end (* else if 'Z' *)
        else if (ch = 'E') then        (* error packet *)
          begin
            error(recpkt,len);         (* display error *)
            state := 'a'               (* and abort *)
          end (* if 'E' *)
        else if (ch <> chr(0)) then    (* some other packet type, *)
            state := 'a'               (* abort *)
    until (state <> 'd');
    rdata := state
  end; (* rdata *)
 
function rfile: char;
 
(* receive file header *)
 
var num, len: integer;
    ch: char;
    oldfn: string;
    i: integer;
 
procedure makename(recpkt: packettype; var fn: string; l: integer);
 
function exist(fn: string): boolean;
 
(* returns true if file named fn exists *)
 
var f: file;
 
  begin
    (*$I-*) (* turn off i/o checking *)
    reset(f,fn);
    exist := (ioresult = 0)
    (*$I+*)
  end; (* exist *)
 
procedure checkname(var fn: string);
 
(* if file fn exists, makes a new name which doesn't *)
(* does this by changing letters in file name until it *)
(* finds some combination which doesn't exitst *)
 
var ch: char;
    i: integer;
 
  begin
    i := 1;
    while (i <= length(fn)) and exist(fn) do
      begin
        ch := 'A';
        while (ch in ['A'..'Z']) and exist(fn) do
          begin
            fn[i] := ch;
            ch := succ(ch);
          end; (* while *)
        i := i + 1
      end; (* while *)
    end; (* checkname *)
 
  begin (* makename *)
    fn := copy('               ',1,15);    (* stretch length *)
    moveleft(recpkt[0],fn[1],l);           (* get filename from packet *)
    oldfn := copy(fn, 1,l);                (* save fn sent to show user *)
    fn := copy(fn,1,min(15,l));            (* set length of filename *)
                                           (* and make sure <= 15 *)
    uppercase(fn);
    if pos('.TEXT',fn) <> length(fn)-4 then
      begin
        if length(fn) > 10 then
            fn := copy(fn,1,10);           (* can only be 15 long in all *)
        fn := concat(fn,'.TEXT');          (* and we'll add .TEXT *)
      end; (* if *)
    if fwarn then                          (* if file warning is on *)
        checkname(fn);                       (* must check that name unique *)
  end; (* makename *)
 
  begin (* rfile *)
    if debug then
        debugwrite('rfile');
 
    if (numtry > maxtry) then         (* if too many tries, give up *)
      begin
        rfile := 'a';
        exit(rfile)
      end;
    numtry := numtry + 1;
 
    ch := rpack(len,num,recpkt);      (* receive a packet *)
 
    refresh_screen(numtry,n);
 
    if ch = 'S' then                  (* send init, maybe our ACK lost *)
      begin
        if (oldtry > maxtry) then     (* too many tries, abort *)
          begin
            rfile := 'a';
            exit(rfile)
          end; (* if *)
 
        n := n - 1;
 
        if num = (n mod 64) then      (* previous packet mod 64? *)
          begin                       (* yes, ACK it again *)
            spar(packet);             (* with our send init params *)
            spack('Y',num,6,packet);
            numtry := 0;              (* reset try counter *)
            rfile := state;           (* stay in same state *)
          end (* if *)
        else                          (* not previous packet, abort *)
          state := 'a'
      end (* if 'S' *)
    else if (ch = 'Z') then           (* end of file *)
      begin
        if (oldtry > maxtry) then     (* too many tries, abort *)
          begin
            rfile := 'a';
            exit(rfile)
          end; (* if *)
 
        n := n - 1;
 
        if num = (n mod 64) then       (* previous packet mod 64? *)
          begin                       (* yes, ACK it again *)
            spack('Y',num,0,packet);
            numtry := 0;
            rfile := state            (* stay in same state *)
          end (* if *)
        else
            rfile := 'a'              (* no, abort *)
      end (* else if *)
    else if (ch = 'F') then           (* file header *)
      begin                           (* which is what we really want *)
        if (num <> (n mod 64)) then   (* if wrong packet, abort *)
          begin
            rfile := 'a';
            exit(rfile)
          end;
 
        makename(recpkt,filename,len); (* get filename, make unique if filew *)
        gotoxy(filepos,fileline);
        write(oldfn,' ==> ',filename);
 
        if not getfil(filename) then  (* try to open new file *)
          begin
            ioerror(ioresult);        (* if unsuccessful, tell them *)
            rfile := 'a';             (* and abort *)
            exit(rfile)
          end; (* if *)
 
        spack('Y',n mod 64,0,packet); (* ACK file header *)
        oldtry := numtry;             (* reset try counters *)
        numtry := 0;
        n := n + 1;                   (* bump packet number *)
        rfile := 'd';                 (* switch to data state *)
      end (* else if *)
    else if ch = 'B' then             (* break transmission *)
      begin
        if (num <> (n mod 64)) then            (* wrong packet, abort *)
          begin
            rfile := 'a';
            exit(rfile)
          end;
        spack('Y',n mod 64,0,packet); (* say ok *)
        rfile := 'c'                  (* go to complete state *)
      end (* else if *)
    else if (ch = 'E') then
      begin
        error(recpkt,len);
       (* returned false *)
        rfile := state                (* so stay in same state *)
    else                              (* some weird state, so abort *)
        rfile := 'a'
  end; (* rfile *)
 
function rinit: char;
 
(* receive initialization *)
 
var num, len: integer;  (* packet number and length *)
    ch: char;
 
  begin
    if debug then
        debugwrite('rinit');
 
    numtry := numtry + 1;
 
    ch := rpack(len,num,recpkt); (* receive a packet *)
    refresh_screen(num_try,n);
 
    if (ch = 'S') then           (* send init packet *)
      begin
        rpar(recpkt);            (* get other side's init data *)
        spar(packet);            (* fill packet with my init data *)
        ctl_set := [chr(1)..chr(31),chr(del),quote];
        spack('Y',n mod 64,6,packet); (* ACK with my params *)
        oldtry := numtry;        (* save old try count *)
        numtry := 0;             (* start a new counter *)
        n := n + 1;              (* bump packet number *)
        rinit := 'f';            (* enter file send state *)
      end (* if 'S' *)
    else if (ch = 'E') then
      begin
        rinit := 'a';
        error(recpkt,len)
      end (* if 'E' *)
    else if (ch = chr(0)) then
        rinit := 'r'             (* stay in same state *)
    else
        rinit := 'a'             (* abort *)
  end; (* rinit *)
 
(* state table switcher for receiving packets *)
 
  begin (* recswok *)
    writescreen('Receiving');
    state := 'r';            (* initial state is send *)
    n := 0;                  (* set packet # *)
    numtry := 0;             (* no tries yet *)
 
    while true do
        if state in ['d', 'f', 'r', 'c', 'a'] then
          case state of
              'd': state := rdata;
              'f': state := rfile;
              'r': state := rinit;
              'c': begin
                     rec_ok := true;
                     exit(recsw)
                   end; (* case c *)
              'a': begin
                     rec_ok := false;
                     exit(recsw)
                   end (* case a *)
            end (* case *)
        else (* state not in legal states *)
          begin
            rec_ok := false;
            exit(recsw)
          end (* else *)
  end; (* recsw *)
