home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / perqa.tar.gz / perqa.tar / kermitutils < prev    next >
Text File  |  1984-12-04  |  6KB  |  212 lines

  1. module  KermitUtils;
  2.  
  3. EXPORTS
  4.  
  5. IMPORTS KermitGlobals     FROM KermitGlobals ;
  6.  
  7.  
  8. PROCEDURE StartTimer;
  9. PROCEDURE CheckTimer ;
  10. PROCEDURE StopTimer;
  11. PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
  12. FUNCTION GetIn :CharBytes;    (* get character *)
  13. FUNCTION UnChar(c:CharBytes): CharBytes;
  14. FUNCTION MakeChar(c:CharBytes): CharBytes;
  15. FUNCTION IsControl(c:CharBytes): Boolean;
  16. FUNCTION IsPrintable(c:CharBytes): Boolean;
  17. FUNCTION Ctl(c:CharBytes): CharBytes;
  18. FUNCTION IsValidPType(c:CharBytes): Boolean;
  19. FUNCTION CheckFunction(c:Integer): CharBytes;
  20. FUNCTION ilength (VAR s : istring) : Integer;
  21. FUNCTION GetArgument(VAR arg: istring): Boolean ;
  22. PROCEDURE EnCodeParm(VAR data:istring);  (* encode parameters *)
  23. PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
  24. PROCEDURE Inverse( turn_on: Boolean ) ;
  25.  
  26.  
  27.  
  28.  
  29. PRIVATE
  30.  
  31.  
  32.  
  33. IMPORTS IOErrors        FROM IOErrors ;
  34. IMPORTS IO_Unit         FROM IO_Unit ;
  35. IMPORTS IO_Others       FROM IO_Others ;
  36. IMPORTS CmdParse        FROM CmdParse ;
  37. IMPORTS Screen          FROM Screen ;
  38.  
  39.                                                    {$RANGE-}
  40.  
  41. FUNCTION UnChar(c:CharBytes): CharBytes;
  42.    (* reverse of makechar *)
  43.    BEGIN
  44.       UnChar := c - BLANK
  45.    END;
  46.  
  47.  
  48. FUNCTION MakeChar(c:CharBytes): CharBytes;
  49.    (* convert integer to printable *)
  50.    BEGIN
  51.       MakeChar := c + BLANK
  52.    END;
  53.  
  54. FUNCTION IsControl(c:CharBytes): Boolean;
  55.    (* true if control *)
  56.    BEGIN
  57.       (* Clear the 8th bit *)
  58.       c := Land( c, #177 ) ;
  59.       IsControl := (c = DEL) OR (c < BLANK)
  60.    END;
  61.  
  62. FUNCTION IsPrintable(c:CharBytes): Boolean;
  63.    (* opposite of iscontrol *)
  64.    BEGIN
  65.       IsPrintable := NOT IsControl(c)
  66.    END;
  67.  
  68. FUNCTION Ctl(c:CharBytes): CharBytes;
  69.    (* c XOR 100 *)
  70.    BEGIN
  71.       Ctl := LXor(c, #100)
  72.    END;
  73.  
  74. FUNCTION IsValidPType(c:CharBytes): Boolean;
  75.    (* true if valid packet type *)
  76.    BEGIN
  77.       IsValidPType :=
  78.         c IN [TYPEB, TYPED, TYPEE, TYPEF, TYPEN, TYPES, TYPET, TYPEY, TYPEZ]
  79.    END;
  80.  
  81. FUNCTION CheckFunction(c:Integer): CharBytes;
  82.    (* calculate checksum *)
  83.    VAR
  84.       x: Integer;
  85.    BEGIN
  86.       (*   CheckFunction := (c + ( c AND 300 ) /100 ) AND 77; *)
  87.       x := Shift( Land(c, #300), -6) ;
  88.       CheckFunction := Land(x+c, #077)
  89.    END;
  90.  
  91. PROCEDURE EnCodeParm((* Updating *) VAR data:istring);  (* encode parameters *)
  92.    VAR
  93.       i: Integer;
  94.    BEGIN
  95.       FOR i:=1 TO NUMPARAM DO
  96.          data[i] := BLANK;
  97.       data[NUMPARAM+1] := ENDSTR;
  98.       data[1] := MakeChar(SizeRecv);     (* my biggest packet *)
  99.       data[2] := MakeChar(MyTimeOut);    (* when I want timeout*)
  100.       data[3] := MakeChar(MyPad);        (* how much padding *)
  101.       data[4] := Ctl(MyPadChar);         (* my padding character *)
  102.       data[5] := MakeChar(myEOL);        (* my EOL *)
  103.       data[6] := MyQuote;                (* my quote char *)
  104.    END;
  105.  
  106. PROCEDURE DeCodeParm(VAR data:istring); (* decode parameters *)
  107.    BEGIN
  108.       SizeSend := UnChar(data[1]);
  109.       TheirTimeOut := UnChar(data[2]);   (* when I should time out *)
  110.       NumPad := UnChar(data[3]);         (* padding characters to send  *)
  111.       PadChar := Ctl(data[4]);           (* padding character *)
  112.       SendEOL := UnChar(data[5]);        (* EOL to send *)
  113.       SendQuote := data[6];              (* quote to send *)
  114.    END;
  115.  
  116.  
  117.    { Copyright (C) 1981 by Bell Laboratories, Inc., and Whitesmiths Ltd. }
  118.    { length -- compute length of string }
  119. FUNCTION ilength (VAR s : istring) : Integer;
  120.    VAR
  121.       n : Integer;
  122.    BEGIN
  123.       n := 1;
  124.       WHILE (s[n] <> ENDSTR) DO
  125.          n := n + 1;
  126.       ilength := n - 1
  127.    END;
  128.  
  129.  
  130.  
  131. PROCEDURE StartTimer;
  132.    (* Start the time count, in clock ticks.  -pt*)
  133.    BEGIN
  134.       IOGetTime( OldTime ) ; (* Current clock value *)
  135.       TimeLeft := TheirTimeOut * 60 (* in ticks *)
  136.    END;
  137.  
  138. PROCEDURE CheckTimer ;
  139.    (* Decrement "TimeLeft" by time between last call and now -pt*)
  140.    VAR  now: Double ;
  141.    BEGIN
  142.       IF (TimeLeft > 0) THEN (* Still counting *)
  143.          BEGIN
  144.             IOGetTime( now ) ;
  145.             TimeLeft := TimeLeft - now[0] + OldTime[0] ;
  146.             OldTime := now
  147.          END
  148.    END ;
  149.  
  150. PROCEDURE StopTimer;
  151.    BEGIN
  152.       TimeLeft := Maxint;
  153.    END;
  154.  
  155.  
  156. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  157.  
  158.  
  159. PROCEDURE XmtChar(ch:Char);   (* Perq version -pt*)
  160.    BEGIN
  161.       WHILE IOCWrite(RS232Out, ch) <> IOEIOC DO (* nothing *) ;
  162.    END;
  163.  
  164.  
  165. FUNCTION GetIn :CharBytes;  (* get character *)
  166.    (* Should return NULL (ENDSTR) if no characters, Perq version -pt*)
  167.    VAR
  168.       byte: CharBytes ;
  169.       c :Char ;
  170.    BEGIN
  171.       IF (IOCRead(RS232In, c) = IOEIOC) THEN
  172.          BEGIN
  173.             byte := land( Ord(c), #377 ) (* [pgt001] *)
  174.          END
  175.       ELSE byte := ENDSTR ;
  176.       GetIn := byte ;
  177.       (* ChInPack := ChInPack + 1.0  (@ AddTo( x, 1)  *)
  178.    END;
  179.  
  180.  
  181. (*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*)
  182.  
  183.  
  184.    (* Get the next argument from the command line -pt*)
  185.    (* Return True if an argument is available - returned in "arg" too -pt*)
  186. FUNCTION GetArgument(VAR arg: istring): Boolean ;
  187.    VAR
  188.       return: Boolean ;   (* Return value *)
  189.       i, len: Integer ;   (* index and argument length *)
  190.       id: String ;        (* Identifier/argument from the line *)
  191.    BEGIN (*-GetArgument-*)
  192.       dumCh := NextIDString( CmdLine, id, return ) ; (* Get an identifier *)
  193.       IF (id = '') THEN return := False (* nothing *)
  194.       ELSE
  195.          BEGIN
  196.             return := True ;       (* Success *)
  197.             len := Length( id ) ;  (* get the string's length *)
  198.             FOR i := 1 TO len DO   (* put the string in "arg" *)
  199.                arg[i] := Ord( id[i] ) ;
  200.             arg[len+1] := ENDSTR   (* finish it off *)
  201.          END ;
  202.       GetArgument := return
  203.    END ; (*-GetArgument-*)
  204.  
  205. PROCEDURE Inverse( turn_on: Boolean ) ;
  206.   (* Change chrsor function for inverse video *)
  207.   BEGIN  (*-Inverse-*)
  208.      IF turn_on THEN SChrFunc( RNot )
  209.      ELSE  SChrFunc( RRpl )
  210.   END    (*-Inverse-*).
  211.  
  212.