Columbia Kermit/kermit.zip/perqa/kermitutils

Text File | 2020-01-01 | 5.8 KB | 212 lines

module  KermitUtils;

EXPORTS

IMPORTS KermitGlobals     FROM KermitGlobals ;


PROCEDURE StartTimer;
PROCEDURE CheckTimer ;
PROCEDURE StopTimer;
PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
FUNCTION GetIn :CharBytes;    (* get character *)
FUNCTION UnChar(c:CharBytes): CharBytes;
FUNCTION MakeChar(c:CharBytes): CharBytes;
FUNCTION IsControl(c:CharBytes): Boolean;
FUNCTION IsPrintable(c:CharBytes): Boolean;
FUNCTION Ctl(c:CharBytes): CharBytes;
FUNCTION IsValidPType(c:CharBytes): Boolean;
FUNCTION CheckFunction(c:Integer): CharBytes;
FUNCTION ilength (VAR s : istring) : Integer;
FUNCTION GetArgument(VAR arg: istring): Boolean ;
PROCEDURE EnCodeParm(VAR data:istring);  (* encode parameters *)
PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
PROCEDURE Inverse( turn_on: Boolean ) ;




PRIVATE



IMPORTS IOErrors        FROM IOErrors ;
IMPORTS IO_Unit         FROM IO_Unit ;
IMPORTS IO_Others       FROM IO_Others ;
IMPORTS CmdParse        FROM CmdParse ;
IMPORTS Screen          FROM Screen ;

                                                   {$RANGE-}

FUNCTION UnChar(c:CharBytes): CharBytes;
   (* reverse of makechar *)
   BEGIN
      UnChar := c - BLANK
   END;


FUNCTION MakeChar(c:CharBytes): CharBytes;
   (* convert integer to printable *)
   BEGIN
      MakeChar := c + BLANK
   END;

FUNCTION IsControl(c:CharBytes): Boolean;
   (* true if control *)
   BEGIN
      (* Clear the 8th bit *)
      c := Land( c, #177 ) ;
      IsControl := (c = DEL) OR (c < BLANK)
   END;

FUNCTION IsPrintable(c:CharBytes): Boolean;
   (* opposite of iscontrol *)
   BEGIN
      IsPrintable := NOT IsControl(c)
   END;

FUNCTION Ctl(c:CharBytes): CharBytes;
   (* c XOR 100 *)
   BEGIN
      Ctl := LXor(c, #100)
   END;

FUNCTION IsValidPType(c:CharBytes): Boolean;
   (* true if valid packet type *)
   BEGIN
      IsValidPType :=
        c IN [TYPEB, TYPED, TYPEE, TYPEF, TYPEN, TYPES, TYPET, TYPEY, TYPEZ]
   END;

FUNCTION CheckFunction(c:Integer): CharBytes;
   (* calculate checksum *)
   VAR
      x: Integer;
   BEGIN
      (*   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
      x := Shift( Land(c, #300), -6) ;
      CheckFunction := Land(x+c, #077)
   END;

PROCEDURE EnCodeParm((* Updating *) VAR data:istring);  (* encode parameters *)
   VAR
      i: Integer;
   BEGIN
      FOR i:=1 TO NUMPARAM DO
         data[i] := BLANK;
      data[NUMPARAM+1] := ENDSTR;
      data[1] := MakeChar(SizeRecv);     (* my biggest packet *)
      data[2] := MakeChar(MyTimeOut);    (* when I want timeout*)
      data[3] := MakeChar(MyPad);        (* how much padding *)
      data[4] := Ctl(MyPadChar);         (* my padding character *)
      data[5] := MakeChar(myEOL);        (* my EOL *)
      data[6] := MyQuote;                (* my quote char *)
   END;

PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
   BEGIN
      SizeSend := UnChar(data[1]);
      TheirTimeOut := UnChar(data[2]);   (* when I should time out *)
      NumPad := UnChar(data[3]);         (* padding characters to send  *)
      PadChar := Ctl(data[4]);           (* padding character *)
      SendEOL := UnChar(data[5]);        (* EOL to send *)
      SendQuote := data[6];              (* quote to send *)
   END;


   { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
   { length -- compute length of string }
FUNCTION ilength (VAR s : istring) : Integer;
   VAR
      n : Integer;
   BEGIN
      n := 1;
      WHILE (s[n] <> ENDSTR) DO
         n := n + 1;
      ilength := n - 1
   END;



PROCEDURE StartTimer;
   (* Start the time count, in clock ticks.  -pt*)
   BEGIN
      IOGetTime( OldTime ) ; (* Current clock value *)
      TimeLeft := TheirTimeOut * 60 (* in ticks *)
   END;

PROCEDURE CheckTimer ;
   (* Decrement "TimeLeft" by time between last call and now -pt*)
   VAR  now: Double ;
   BEGIN
      IF (TimeLeft > 0) THEN (* Still counting *)
         BEGIN
            IOGetTime( now ) ;
            TimeLeft := TimeLeft - now[0] + OldTime[0] ;
            OldTime := now
         END
   END ;

PROCEDURE StopTimer;
   BEGIN
      TimeLeft := Maxint;
   END;


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


PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
   BEGIN
      WHILE IOCWrite(RS232Out, ch) <> IOEIOC DO (* nothing *) ;
   END;


FUNCTION GetIn :CharBytes;  (* get character *)
   (* Should return NULL (ENDSTR) if no characters, Perq version -pt*)
   VAR
      byte: CharBytes ;
      c :Char ;
   BEGIN
      IF (IOCRead(RS232In, c) = IOEIOC) THEN
         BEGIN
            byte := land( Ord(c), #377 ) (* [pgt001] *)
         END
      ELSE byte := ENDSTR ;
      GetIn := byte ;
      (* ChInPack := ChInPack + 1.0  (@ AddTo( x, 1)  *)
   END;


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


   (* Get the next argument from the command line -pt*)
   (* Return True if an argument is available - returned in "arg" too -pt*)
FUNCTION GetArgument(VAR arg: istring): Boolean ;
   VAR
      return: Boolean ;   (* Return value *)
      i, len: Integer ;   (* index and argument length *)
      id: String ;        (* Identifier/argument from the line *)
   BEGIN (*-GetArgument-*)
      dumCh := NextIDString( CmdLine, id, return ) ; (* Get an identifier *)
      IF (id = '') THEN return := False (* nothing *)
      ELSE
         BEGIN
            return := True ;       (* Success *)
            len := Length( id ) ;  (* get the string's length *)
            FOR i := 1 TO len DO   (* put the string in "arg" *)
               arg[i] := Ord( id[i] ) ;
            arg[len+1] := ENDSTR   (* finish it off *)
         END ;
      GetArgument := return
   END ; (*-GetArgument-*)

PROCEDURE Inverse( turn_on: Boolean ) ;
  (* Change chrsor function for inverse video *)
  BEGIN  (*-Inverse-*)
     IF turn_on THEN SChrFunc( RNot )
     ELSE  SChrFunc( RRpl )
  END    (*-Inverse-*).