home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pub / ucsdwdme / utils.text < prev    next >
Text File  |  2020-01-01  |  8KB  |  265 lines
  1. function ready(p:port):boolean;
  2. begin
  3.   ready:= ((p=terminal) and istarr) or ((p=modem) and istbrr);
  4. end;
  5.  
  6. function pget(p:port):char;
  7. begin
  8.   if p=terminal then pget:=rcvabt
  9.   else pget:=rcvbbt;
  10. end;
  11.  
  12. procedure read_str(*var p: port; var s: string*);
  13.  
  14. (* acts like readln(s) but takes input from specified port *)
  15.  
  16. var i: integer;
  17.  
  18.   begin
  19.     i := 0;
  20.     s := copy('',0,0);
  21.     repeat
  22.       repeat                              (* get a character *)
  23.       until ready(p);
  24.       ch:=pget(p);
  25.       if (ord(ch) = backspace) then       (* if it's a backspace then *)
  26.         begin
  27.           if (i > 0) then                   (* if not at beginning of line *)
  28.             begin
  29.               write(ch);                      (* go back a space on screen *)
  30.               write(' ');                     (* erase char on screen *)
  31.               write(ch);                      (* go back a space again *)
  32.               i := i - 1;                     (* adjust string counter *)
  33.               s := copy(s,1,i)                (* adjust string *)
  34.             end (* if *)
  35.         end (* if *)
  36.       else if (ord(ch) <> eoln_sym) then  (* otherwise if not at eoln  then *)
  37.         begin
  38.           write(ch);                        (* echo char on screen *)
  39.           i := i + 1;                       (* inc string counter *)
  40.           s := concat(s,' ');
  41.           s[i] := ch;                       (* put char in string *)
  42.         end; (* if *)
  43.     until (ord(ch) = eoln_sym);           (* if not eoln, get another char *)
  44.     s := copy(s,1,i);                     (* correct string length *)
  45.     writeln                               (* write a line on the screen *)
  46.   end; (* read_str *)
  47.  
  48. function read_ch(*p: port; var ch: char): boolean*);
  49.  
  50. (* read a character from an input port *)
  51.  
  52.   begin
  53.         if ready(p) then            (* if a char there *)
  54.           begin
  55.             ch := pget(p);      (* get the char *)
  56.             read_ch := true;               (* and return true *)
  57.           end (* if *)
  58.         else                             (* otherwise *)
  59.             read_ch := false;              (* return false *)
  60.   end; (* read_ch *)
  61.  
  62. function getch(*var r: char; p: port): boolean*);
  63.  
  64. (* gets a character, strips parity, returns true if it got a char which *)
  65. (* isn't Kermit SOH, false if it gets SOH or nothing after maxtry *)
  66.  
  67. const maxtry = 10000;
  68.  
  69. var count: integer;
  70.  
  71.   begin
  72.     count := 0;
  73.     getch := false;
  74.     repeat
  75.         count := count + 1;
  76.     until ready(p) or (count > maxtry);         (* wait for a character *)
  77.     if (count > maxtry) then                    (* if wait too long then *)
  78.         exit(getch);                            (* get out of here *)
  79.     r:=pget(p);                                 (* get the character *)
  80.     r := chr(aand(ord(r),127));                 (* strip parity from char *)
  81.     getch := (r <> chr(soh));                   (* return true if not SOH *)
  82.   end; (* getch *)
  83.  
  84.  
  85. function aand(*x,y: integer): integer*);
  86.  
  87. (* arithmetic and--takes 2 integers and ands them, yeilding an integer *)
  88.  
  89. var xrec, yrec, temp: int_bool_rec;
  90.  
  91.   begin
  92.     xrec.i := x;                  (* put the two numbers in variant record *)
  93.     yrec.i := y;
  94.     temp.b := xrec.b * yrec.b;  (* use as sets to 'and' them *)
  95.     aand := temp.i                (* return integer result *)
  96.   end; (* aand *)
  97.  
  98. function aor(*x,y: integer): integer*);
  99.  
  100. (* arithmetic or *)
  101.  
  102. var xrec, yrec, temp: int_bool_rec;
  103.  
  104.   begin
  105.     xrec.i := x;                  (* put two numbers in variant record *)
  106.     yrec.i := y;
  107.     temp.b := xrec.b + yrec.b;   (* use as sets to 'or' them *)
  108.     aor := temp.i                 (* return integer result *)
  109.   end; (* aor *)
  110.  
  111. function xor(*x,y: integer): integer*);
  112.  
  113. (* exclisive or *)
  114.  
  115. var xrec, yrec, temp: int_bool_rec;
  116.  
  117.   begin
  118.     xrec.i := x;                  (* put two numbers in variant record *)
  119.     yrec.i := y;
  120.                                   (* use as sets to 'xor' them *)
  121.     temp.b := (xrec.b - yrec.b) + (yrec.b - xrec.b);
  122.     xor := temp.i                 (* return integer result *)
  123.   end; (* xor *)
  124.  
  125. procedure error(*p: packettype; len: integer*);
  126.  
  127. (* writes error message sent by remote host *)
  128.  
  129. var i: integer;
  130.  
  131.   begin
  132.     gotoxy(0,errorline);
  133.     for i := 0 to len-1 do
  134.         write(p[i]);
  135.     gotoxy(0,promptline);
  136.   end; (* error *)
  137.  
  138. procedure io_error(*i: integer*);
  139.  
  140.   begin
  141.     gotoxy(0,errorline);
  142.     write(chr(27),'K');         (* erase to end of line *)
  143.     case i of
  144.         0: writeln('No error');
  145.         1: writeln('Bad Block, Parity error (CRC)');
  146.         2: writeln('Bad Unit Number');
  147.         3: writeln('Bad Mode, Illegal operation');
  148.         4: writeln('Undefined hardware error');
  149.         5: writeln('Lost unit, Unit is no longer on-line');
  150.         6: writeln('Lost file, File is no longer in directory');
  151.         7: writeln('Bad Title, Illegal file name');
  152.         8: writeln('No room, insufficient space');
  153.         9: writeln('No unit, No such volume on line');
  154.         10: writeln('No file, No such file on volume');
  155.         11: writeln('Duplicate file');
  156.         12: writeln('Not closed, attempt to open an open file');
  157.         13: writeln('Not open, attempt to close a closed file');
  158.         14: writeln('Bad format, error in reading real or integer');
  159.         15: writeln('Ring buffer overflow')
  160.       end; (* case *)
  161.     gotoxy(0,promptline)
  162.   end; (* io_error *)
  163.  
  164. procedure debugwrite(*s: string*);
  165.  
  166. (* writes a debugging message *)
  167. var i: integer;
  168.  
  169.   begin
  170.     if debug then
  171.       begin
  172.         gotoxy(0,debugline+debnext);
  173.         debnext:=(debnext+1) mod debug_max;
  174.         write(chr(27),'K');         (* erase to end of line *)
  175.         write(s);                   (* write debugging message *)
  176.       end (* if debug *)
  177.   end; (* debugwrite *)
  178.  
  179. procedure debugint(*s: string; i: integer*);
  180.  
  181. (* write a debugging message and an integer *)
  182.  
  183.   begin
  184.     if debug then
  185.       begin
  186.         debugwrite(s);
  187.         write(i)
  188.       end (* if debug *)
  189.   end; (* debugint *)
  190.  
  191. procedure writescreen(*s: string*);
  192.  
  193. (* sets up the screen for receiving or sending files *)
  194.  
  195.   begin
  196.     write(chr(esc),'E'{clearscreen});
  197.     gotoxy(0,titleline);
  198.     write('                        Kermit UCSD p-system');
  199.     gotoxy(statuspos,statusline);
  200.     write(s);
  201.     gotoxy(0,packetline);
  202.     write('Number of Packets: ');
  203.     gotoxy(0,retryline);
  204.     write('Number of Tries: ');
  205.     gotoxy(0,fileline);
  206.     write('File Name: ');
  207.   end; (* writescreen *)
  208.  
  209. procedure refresh_screen(*numtry, num: integer*);
  210.  
  211. (* keeps track of packet count on screen *)
  212.  
  213.   begin
  214.     gotoxy(retrypos,retryline);
  215.     write(numtry: 5);
  216.     gotoxy(packetpos,packetline);
  217.     write(num: 5)
  218.   end; (* refresh_screen *)
  219.  
  220. function min(*x,y: integer): integer*);
  221.  
  222. (* returns smaller of two integers *)
  223.  
  224.   begin
  225.     if x < y then
  226.         min := x
  227.     else
  228.         min := y
  229.   end; (* min *)
  230.  
  231. function tochar(*ch: char): char*);
  232.  
  233. (* tochar converts a control character to a printable one by adding space *)
  234.  
  235.   begin
  236.     tochar := chr(ord(ch) + ord(' '))
  237.   end; (* tochar *)
  238.  
  239. function unchar(*ch: char): char*);
  240.  
  241. (* unchar undoes tochar *)
  242.  
  243.   begin
  244.     unchar := chr(ord(ch) - ord(' '))
  245.   end; (* unchar *)
  246.  
  247. function ctl(*ch: char): char*);
  248.  
  249. (* ctl toggles control bit: ^A becomes A, A becomes ^A *)
  250.  
  251.   begin
  252.     ctl := chr(xor(ord(ch),64))
  253.   end; (* ctl *)
  254.  
  255. procedure echo(ch: char);
  256.  
  257. (* echos a character on the screen *)
  258.  
  259.   begin
  260.     ch := chr(aand(ord(ch),127)); (* mask off parity bit *)
  261.     repeat until istatr;
  262.     sndabt(ch)
  263.   end; (* echo *)
  264.  
  265.