(* >>>> SENDER.TEXT  ***************************************************)

(*$I-*)
(*$R-*)
(*$S+*)
(*$V-*)

UNIT sender;    INTRINSIC CODE 26   ;

INTERFACE

USES  kermglob,
      kermutil,
      kermpack;

PROCEDURE sendsw( VAR send_ok: BOOLEAN );


IMPLEMENTATION


PROCEDURE  sendsw{ var send_ok : boolean };

VAR size, numtry, spnum, rpnum, len : INTEGER;
    ch : CHAR;
    leg_fname : STRING;
    ready : boolean;



FUNCTION  openfile : BOOLEAN;

(* resets file & gets past first 2 blocks in case of textfile *)

var b : integer;

begin
  reset( apple_file,  xfile_name );
  io_status := ioresult;
  if io_status = 0 then
    begin
      if text_file then
        b := blockread( apple_file, filebuf[1], 2 );
        { for a textfile skip past the first two blocks }
        io_status := ioresult;
        bufend := 0;
        bufpos := 1;
    end;
  openfile := ( io_status = 0 );
 
end; { open_file }


PROCEDURE legalize( var fn : string );

 make filename acceptable to host 
 filename is already uppercase and cannot contain a ':' as last char. 

var i, point_pos, len : integer;

begin
  delete( fn, 1, pos( ':', fn ) );   { strip off volumename }
  len := length( fn );
  i := 1; point_pos := 1;
  repeat
    if fn[i] = '.' then point_pos := i; { save last occurrence of '.' }
    if not ( fn[i] in [ '0'..'9', 'A'..'Z' ] )  then fn[i] := 'X';
    { replace every non alphanumeric character with a 'X' }
    i := i + 1;
  until i > len;
  if point_pos > 1 then fn[point_pos] := '.';
  { restore last encountered '.', except when '.' was in first position }
end; { legalize }




FUNCTION sinit: char;

(* send init packet & receive other side's *)

begin
  sinit := 's';    { default state remains 's' }
  if debug then debugwrite('sinit');
  if interrupt(int_key) or (num_try > init_try) then
    begin
      sinit := 'a';
      send_errpack( spnum );
      exit( sinit )
    end;
  num_try := num_try + 1;
  spar;
  refresh_screen( numtry, spnum );
  spack( 'S', spnum, 10 );
  unitclear( inport );            { clear remin buffer }
  ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  if debug then ack_write(  ch, len, rpnum, recpkt );
  if ch = 'Y' then begin
                     if spnum <> rpnum then exit( sinit );  { stay in 's' }
                     rpar;  { get other side init package }
                     if xeol_char = chr(0) then xeol_char := eoln_char;
                     if quote= chr(0) then quote:= my_quote;
                     if xtime= 0 then xtime:= my_time;
                     if xtime>32 then xtime:= 31;
                     { use my parameters if other side did not specify them }
                     if text_file then ctlq_set := ctl_set + [quote] - [chr(0)]
                                  else
                     ctlq_set := ctl_set + [quote,chr(128)..chr(159),chr(255)];
                     { for image transfer add msbit control chars to set }
                     numtry := 0;
                     spnum := 1;
                     sinit := 'f';  { go to next state }
                   end  { then }
              else if ( ch <> 'N' ) and ( ch <> '@' ) then
                begin
                  sinit := 'a';   { for nack or receive failure stay in 's' }
                                  { for every other state : abort }
                  if ch = 'E' then error( recpkt, len );
                end;  { else }
end; (* sinit *)




FUNCTION sdata: char;

(* send file data *)

begin
  if debug then debug_write( 'sdata' );
  if text_file then size := bufill_t
               else size := bufill_i;
  if io_status <> 0 then begin
                           io_error( io_status );
                           send_errpack( spnum );
                           sdata := 'a';
                           exit( sdata );
                         end;
  while ( currstate = 'd' ) do
    begin
      if interrupt(int_key) or (numtry > maxtry) then
        begin
          sdata := 'a';
          send_errpack( spnum );
          exit( sdata )
        end;
      numtry := numtry + 1;
      refresh_screen( numtry, spnum );
      spack( 'D', spnum, size );
      unitclear( inport );
      ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
      if debug then ack_write( ch, len, rpnum, recpkt );
      if ch = 'N'
        then if ((spnum+1) mod 64 ) <> rpnum
               then ch := '@'   { if a nack and not the right num: stay in 'd'}
               else begin
                      rpnum := (rpnum+63) mod 64;  { if a nack for the next }
                      ch := 'Y';                   { packet: same as ack for}
                    end;   { this packet: indicate an ack. }
      if ch = 'Y'
        then begin
               if spnum = rpnum   { right ack received }
                 then begin
                        if text_file then size := bufill_t
                                     else size := bufill_i;
                        if io_status <> 0
                          then begin
                                 io_error( io_status );
                                 send_errpack( spnum );
                                 sdata := 'a';
                                 exit( sdata );
                               end;
                        if size = at_eof then currstate := 'z';
                        spnum := (spnum+65) mod 64;
                        numtry := 0;
                        { go to next state if data is exhausted, else }
                        { stay in the same state and send next packet }
                      end;
              end
         else if ch <> '@'
                then begin
                       currstate := 'a';
                       if ch = 'E' then error( recpkt, len );
                     end;
    end;  { while }
  sdata := currstate;
end; (* sdata *)




FUNCTION sfile: char;

(* send file header *)

begin
  sfile := 'f';
  if debug then debugwrite('sfile');
  if interrupt(int_key) or ( numtry > maxtry ) then
    begin
      sfile := 'a';
      send_errpack( spnum );
      exit( sfile )
    end;
  numtry := numtry + 1;
  len := length( leg_fname );
  moveleft( leg_fname[1], packet[4], len ); (* move filename into  packet *)
  gotoxy( filepos, fileline );
  write( xfile_name, ' ==> ', leg_fname );
  refresh_screen( numtry, spnum );
  spack( 'F', spnum , len + 4 );          (* send file header packet *)
  unitclear( inport );
  ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  if debug then ack_write( ch, len, rpnum, recpkt );
  if ch = 'N' then begin
                     if ((spnum + 1 ) mod 64) <> rpnum
                       then exit( sfile )  { a nack for the next packet is an }
                       else begin          { ack for the current packet       }
                              rpnum := (rpnum+63) mod 64; { r = r - 1 }
                              ch := 'Y';
                            end;
                   end;
   if ch = 'Y' then begin
                      if spnum <> rpnum then exit( sfile );  { stay in 'f' }
                      numtry := 0;
                      spnum := ( spnum + 65 ) mod 64; { s = s + 1 }
                      sfile := 'd';  { go to next state }
                    end
                else if ch <> '@' then begin
                                         sfile := 'a';
                                         if ch = 'E' then error( recpkt, len );
                                       end;
               { for rec. failure stay in 'f', other states : abort }
end; (* sfile *)




FUNCTION seof: char;

(* send end of file *)

begin
  seof := 'z';
  if debug then debugwrite('seof');
  if interrupt(int_key) or (numtry > maxtry) then (*if too many tries, give up*)
    begin
      seof := 'a';
      send_errpack( spnum );
      exit(seof)
    end;
  numtry := numtry + 1;
  refresh_screen( numtry, spnum );
  spack( 'Z', spnum, 4 );    (* send end of file packet *)
  unitclear( inport );
  ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  if debug then ack_write( ch, len, rpnum, recpkt );
  if ch = 'N' then
    if ((spnum+1) mod 64) <> rpnum then exit( seof )
                                   else begin
                                          rpnum := (rpnum+63) mod 64;
                                          ch := 'Y';
                                        end;
  if ch = 'Y'
    then begin
           if spnum <> rpnum then exit( seof )
                             else begin
                                    numtry := 0;
                                    spnum := (spnum+65) mod 64;
                                    seof := 'b';
                                  end;
         end
    else if ch <> '@' then begin
                             seof := 'a';
                             if ch = 'E' then error( recpkt, len );
                           end;
end; (* seof *)



FUNCTION sbreak: char;

(* send break (end of transmission) *)

begin
  sbreak := 'b';
  if debug then debugwrite('sbreak');
  if interrupt(int_key) or (numtry > maxtry) then (*if too many tries, give up*)
    begin
      sbreak := 'a';
      send_errpack( spnum );
      exit(sbreak)
    end;
  numtry := numtry + 1;
  refresh_screen(numtry, spnum);
  spack( 'B', spnum, 4);    (* send end of file packet *)
  unitclear( inport );
  ch := rpack( spnum, len, rpnum, recpkt, xtime, soh_char );
  if debug then ack_write( ch, len, rpnum, recpkt );
  if ch = 'N' then
    if ((spnum+1) mod 64) <> rpnum then exit( sbreak )
                                   else begin
                                          rpnum := (rpnum+63) mod 64;
                                          ch := 'Y';
                                        end;
  if ch = 'Y'
    then begin
           if spnum <> rpnum then exit( sbreak );
           sbreak := 'c';
         end
    else if ch <> '@' then begin
                             sbreak := 'a';
                             if ch = 'E' then error( recpkt, len );
                           end;
end; (* sbreak *)



   PROCEDURE sendsw   

(* state table switcher for sending *)

begin (* sendsw *)
  unitclear( inport );
  write_screen('Sending ');
  if text_file and ( pos( '.TEXT', xfile_name ) = 0 )
    then xfile_name := concat( xfile_name, '.TEXT' );
  gotoxy( filepos, fileline ); write( xfile_name );
  if not openfile then
    begin
      io_error(io_status);
      send_ok := false;
      exit(sendsw)
    end;
  leg_fname := xfile_name;
  legalize( leg_fname );
  if not text_file then check_apple_char( no_mask_msbit_remin );
  { for image transfer leave msbit unchanged }
  check_apple_char( sfb_char );
  { restore action of ^S, ^F, ^@ keys during send }
  currstate := 's';
  spnum:= 0;       (* set packet # *)
  numtry := 0;
  ready := false;
  while not ready do
    begin
      if currstate in ['d', 'f', 'z', 's', 'b', 'c', 'a'] then
        case currstate of
            'd': currstate := sdata;
            'f': currstate := sfile;
            'z': currstate := seof;
            's': currstate := sinit;
            'b': currstate := sbreak;
            'c': begin
                   send_ok := true;
                   ready := true;
                 end; (* case c *)
            'a': begin
                   send_ok := false;
                   ready := true;
                 end (* case a *)
          end (* case *)
      else (* state not in legal states *)
        begin
          send_ok := false;
          ready := true;
        end (* else *)
    end; { of while }
  check_apple_char( mask_msbit_remin );
  check_apple_char( no_sfb_char );
end; (* sendsw *)


begin
end. { sender }