(*----------------------------------------------------------------------*)
(*             Get_Char --- Get character for Kermit packet             *)
(*----------------------------------------------------------------------*)

PROCEDURE Get_Char( VAR Ch : INTEGER );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Get_Char                                             *)
(*                                                                      *)
(*     Purpose:    Gets character for Kermit packet                     *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Get_Char( VAR Ch: INTEGER );                                  *)
(*                                                                      *)
(*           Ch --- returned character                                  *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        Async_Receive                                                 *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Temp          : INTEGER;
   Rec_Stat_Flag : BOOLEAN;
   A_Ch          : CHAR;

BEGIN (* Get_Char *)

   Temp         := 0;
   Kermit_Abort := FALSE;
   Kermit_Retry := FALSE;
                                   (* Loop until char found from *)
                                   (* comm port or keyboard      *)
   REPEAT
                                   (* Pick up a character from comm port, *)
                                   (* if any.                             *)

      Async_Receive_With_TimeOut( His_TimeOut , Ch );

                                   (* If we timed out, indicate retry *)
                                   (* should be done.                 *)
      IF ( Ch = TimeOut ) THEN
         BEGIN
            Kermit_Retry  := TRUE;
            Rec_Stat_Flag := FALSE;
            Ch            := 0;
         END
      ELSE
         Rec_Stat_Flag := TRUE;

                                   (* Pick up keyboard entry, if any.     *)
      IF KeyPressed THEN
         BEGIN

            READ( Kbd, A_Ch );

            IF ( ORD( A_Ch ) = ESC ) AND KeyPressed THEN
               READ( Kbd, A_Ch );

            IF ( ( ORD( A_Ch ) = ALT_R ) AND ( NOT Sending_File ) ) OR
               ( ( ORD( A_Ch ) = ALT_S ) AND (     Sending_File ) ) THEN
               A_Ch := CHR( ETX );

         END
      ELSE
         A_CH := CHR( 0 );

      Temp := ORD( A_Ch );
                                   (* Keyboard entry can be Alt_R or  *)
                                   (* Alt_S to halt transfer or CR to *)
                                   (* force end of packet.            *)
      IF ( Temp <> 0 ) THEN
         CASE Temp OF
            ETX : Kermit_Abort := TRUE;
            CR  : Kermit_Retry := TRUE;
            ELSE ;
         END (* CASE *);

   UNTIL ( Rec_Stat_Flag OR Kermit_Abort OR Kermit_Retry );

END    (* Get_Char *);

(*----------------------------------------------------------------------*)
(*                Receive_Packet --- Receive Kermit packet              *)
(*----------------------------------------------------------------------*)

PROCEDURE Receive_Packet;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*     Procedure:  Receive_Packet                                       *)
(*                                                                      *)
(*     Purpose:    Gets Kermit packet                                   *)
(*                                                                      *)
(*     Calling Sequence:                                                *)
(*                                                                      *)
(*        Receive_Packet;                                               *)
(*                                                                      *)
(*     Calls:                                                           *)
(*                                                                      *)
(*        Get_Char                                                      *)
(*        Get_P_Length                                                  *)
(*        Kermit_CRC                                                    *)
(*                                                                      *)
(*     Remarks:                                                         *)
(*                                                                      *)
(*        A Kermit packet starts with an SOH character, followed by a   *)
(*        packet length, then the block number MOD 64, then the packet  *)
(*        data, and finally a checksum or crc.                          *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   Rec_Char        : INTEGER;
   B_Rec_Char      : BYTE;
   Temp            : INTEGER;
   Check_Char      : CHAR;
   Check_OK        : BOOLEAN;
   CheckSum        : INTEGER;
   Count           : INTEGER;
   Index           : INTEGER;
   StrNum          : STRING[3];
   Chk1            : CHAR;
   Chk2            : CHAR;
   Chk3            : CHAR;
   Check_Type      : INTEGER;
   L_Packet        : INTEGER;

(*----------------------------------------------------------------------*)
(*             Get_P_Length --- Get length of Kermit packet             *)
(*----------------------------------------------------------------------*)

PROCEDURE Get_P_Length;

BEGIN (* Get_P_Length *)

   IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
      BEGIN
         Get_Char( Rec_Char );
         Count    := Rec_Char - 32;
      END;

END   (* Get_P_Length *);

(*----------------------------------------------------------------------*)

FUNCTION SIval( I: INTEGER ) : ShortStr;

VAR
   IWidth : INTEGER;
   ISave  : INTEGER;
   S      : ShortStr;

BEGIN (* SIval *)

   IWidth := 0;
   ISave  := I;

   WHILE( ISave > 0 ) DO
      BEGIN
         IWidth := IWidth + 1;
         ISave  := ISave DIV 10;
      END;

   STR( I : IWidth , S );

   SIVal := S;

END   (* SIval *);

(*----------------------------------------------------------------------*)

BEGIN (* Receive_Packet *)

   Rec_Packet := '';
   Check_OK   := FALSE;
   Packet_OK  := FALSE;
   Check_Type := ORD( His_Chk_Type ) - ORD('0');

                                   (* Wait for header character (SOH) *)

   REPEAT  (* get header character *)
      Get_Char( Rec_Char );
   UNTIL ( ( Rec_Char = ORD( Kermit_Header_Char ) ) OR
            Kermit_Abort OR Kermit_Retry );

                                   (* Get packet length *)
   Get_P_Length;
                                   (* Get rest of packet *)

   IF NOT ( Kermit_Abort OR Kermit_Retry ) THEN
      BEGIN (* NOT ( Abort OR Retry ) *)
         REPEAT
                                   (* Packet type and data *)
            Get_Char( Rec_Char );

            IF ( Rec_Char = ORD( Kermit_Header_Char ) ) THEN
               BEGIN  (* got new start of packet *)

                                   (* Packet is initially empty *)
                  Rec_Packet := '';
                  Get_P_Length;

               END
            ELSE  (* must be a character *)
               BEGIN
                  Rec_Packet := Rec_Packet + CHR( Rec_Char );
                  Count      := Count - 1;
               END;

         UNTIL ( Kermit_Abort OR Kermit_Retry OR ( Count = 0 ) );

                                   (* Update packets received *)

      Packets_Received := Packets_Received + 1;

                                   (* Update display *)
      Update_Kermit_Display;

      IF ( NOT Kermit_Abort ) THEN
         BEGIN  (* NOT Abort *)
                                   (* Compute and check checksum or crc *)

            L_Packet := LENGTH( Rec_Packet );

            CASE His_Chk_Type OF

               '1': BEGIN

                       CheckSum := L_Packet + 32;

                       FOR Index := 1 TO ( L_Packet - 1 ) DO
                          CheckSum := CheckSum + ORD( Rec_Packet[Index] );

                       CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );

                       Chk1     := Kermit_Char40( CheckSum );

                       Check_OK := ( Chk1 = Rec_Packet[ L_Packet ] );

                   END;

              '2': BEGIN

                      CheckSum := L_Packet + 32;

                      FOR Index := 1 TO ( L_Packet - 2 ) DO
                         CheckSum := CheckSum + ORD( Rec_Packet[Index] );

                      CheckSum        := CheckSum AND 4095;

                      Chk1 := Kermit_Char40( CheckSum SHR 6  );
                      Chk2 := Kermit_Char40( CheckSum AND 63 );

                      Check_OK := ( Chk1 = Rec_Packet[ L_Packet - 1 ] ) AND
                                  ( Chk2 = Rec_Packet[ L_Packet     ] );

                  END;

             '3': BEGIN

                      B_Rec_Char := L_Packet + 32;
                      CheckSum   := 0;
                      CheckSum   := Kermit_CRC( CheckSum , B_Rec_Char );

                      FOR Index := 1 TO ( L_Packet - 3 ) DO
                         BEGIN
                            B_Rec_Char := ORD( Rec_Packet[Index] );
                            CheckSum   := Kermit_CRC( CheckSum , B_Rec_Char );
                         END;

                      Chk1 := Kermit_Char40( ( CheckSum SHR 12 ) AND 15 );
                      Chk2 := Kermit_Char40( ( CheckSum SHR 6  ) AND 63 );
                      Chk3 := Kermit_Char40( CheckSum AND 63   );

                      Check_OK := ( Chk1 = Rec_Packet[ L_Packet - 2 ] ) AND
                                  ( Chk2 = Rec_Packet[ L_Packet - 1 ] ) AND
                                  ( Chk3 = Rec_Packet[ L_Packet     ] );

                  END;

            END (* CASE *);
                                   (* Get packet number *)

            Rec_Packet_Num := Kermit_UnChar( Rec_Packet[1] );

                                   (* Set next state based upon packet type *)

            CASE Rec_Packet[2] OF
               'B' : Kermit_Packet_Type := Break_Pack;
               'D' : Kermit_Packet_Type := Data_Pack;
               'E' : Kermit_Packet_Type := Error_Pack;
               'F' : Kermit_Packet_Type := Header_Pack;
               'N' : Kermit_Packet_Type := NAK_Pack;
               'S' : Kermit_Packet_Type := Send_Pack;
               'T' : Kermit_Packet_Type := Reserved_Pack;
               'Y' : Kermit_Packet_Type := ACK_Pack;
               'Z' : Kermit_Packet_Type := End_Pack;
               ELSE  Kermit_Packet_Type := Unknown;
            END (* CASE *);

                                   (* Strip type, #, checksum from packet *)

            IF ( LENGTH( Rec_Packet ) > ( Check_Type + 2 ) ) THEN
               BEGIN
                  DELETE( Rec_Packet, 1, 2 );
                  DELETE( Rec_Packet, LENGTH( Rec_Packet ) - Check_Type + 1,
                          Check_Type );
               END;
                                    (* Set flag if packet OK *)

            IF ( Check_OK AND ( Kermit_Packet_Type <> Unknown ) ) THEN
               Packet_OK := TRUE;

         END  (* NOT Abort *);

      END  (* NOT ( Abort OR Retry ) *);

END   (* Receive_Packet *);
