home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / ucsdappleii / kermutil.text < prev    next >
Text File  |  1986-04-07  |  9KB  |  374 lines
  1. (*>>>>>>>>>>>>>>KERMUTIL>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>*)
  2.  
  3. $S+
  4. $I-
  5. $R-
  6. $V-
  7.  
  8. UNIT kermutil;  INTRINSIC CODE 20;
  9.  
  10. INTERFACE
  11.  
  12.    USES  kermglob;
  13.  
  14.    PROCEDURE upper_case( VAR s : STRING );
  15.  
  16.    FUNCTION  interrupt( int_key : CHAR ) : BOOLEAN;
  17.  
  18.    PROCEDURE error(VAR p: packettype; len: INTEGER);
  19.  
  20.    PROCEDURE io_error(i: INTEGER);
  21.  
  22.    PROCEDURE debugwrite( s: STRING);
  23.  
  24.    PROCEDURE packet_write( VAR p : packettype; len : INTEGER );
  25.  
  26.    PROCEDURE ack_write( ptype: CHAR; len,num: INTEGER; VAR data: packettype);
  27.  
  28.    PROCEDURE write_bool( s: STRING; b: BOOLEAN);
  29.  
  30.    PROCEDURE read_str( VAR s : STRING);
  31.  
  32.    PROCEDURE write_ctl( ch : CHAR);
  33.  
  34.    FUNCTION  test_printer : BOOLEAN;
  35.  
  36.    FUNCTION min(x,y: INTEGER): INTEGER;
  37.  
  38.    FUNCTION tochar(ch: CHAR): CHAR;
  39.  
  40.    FUNCTION unchar(ch: CHAR): CHAR;
  41.  
  42.    PROCEDURE screen( scrcmd: scrcommands );
  43.  
  44.    PROCEDURE writescreen( s: STRING);
  45.  
  46.    PROCEDURE refresh_screen(numtry, num: INTEGER);
  47.  
  48.    PROCEDURE check_apple_char( check: rem_stat_rec);
  49.  
  50.    FUNCTION ctl( ch : CHAR ) : CHAR;
  51.  
  52.    FUNCTION calc_checksum( VAR packet: packettype; len : INTEGER ) : CHAR;
  53.  
  54.  
  55. IMPLEMENTATION
  56.  
  57. PROCEDURE uppercase {var s: string};
  58.  
  59. var i: integer;
  60.  
  61. begin
  62.  for i := 1 to length(s) do
  63.      if s[i] in ['a'..'z'] then
  64.          s[i] := chr(ord(s[i]) - ord('a') + ord('A'))
  65. end; (* uppercase *)
  66.  
  67.  
  68.  
  69. FUNCTION interrupt{ (int_key : char) : boolean };
  70.  
  71. var buflen : packed array[0..7] of 0..255;
  72.     ch : char;
  73.  
  74. begin
  75.   interrupt := false;  ch := ' ';
  76.   unitstatus( keyport, buflen[0], control_word );
  77.   if buflen[0] > 0
  78.     then begin
  79.            unitread( keyport, ch, 1,, 12 );
  80.            if ch = int_key then interrupt := true;
  81.          end;
  82. end;   {  interrupt  }
  83.  
  84.  
  85.  
  86. PROCEDURE screen{ scrcmd: scr_commands };
  87.  
  88. begin
  89.   if prefixed[ scrcmd ] then unitwrite( consol, prefix, 1,,12 );
  90.   case scrcmd of
  91.      sc_up      : unitwrite( consol, rlf      , 1,,12 );
  92.      sc_right   : unitwrite( consol, ndfs     , 1,,12 );
  93.      sc_clreol  : unitwrite( consol, eraseol  , 1,,12 );
  94.      sc_clreos  : unitwrite( consol, eraseos  , 1,,12 );
  95.      sc_home    : unitwrite( consol, home     , 1,,12 );
  96.      sc_delchar : unitwrite( consol, delchar  , 1,,12 );
  97.      sc_clrall  : unitwrite( consol, clrscreen, 1,,12 );
  98.      sc_clrline : unitwrite( consol, clrline  , 1,,12 );
  99.      sc_left    : unitwrite( consol, backsp   , 1,,12 );
  100.      sc_down    : unitwrite( consol, lf       , 1,,12 );
  101.   end; { case }
  102. end; { procedure screen }
  103.  
  104.  
  105.  
  106. PROCEDURE error{ var p: packettype; len: integer };
  107.  
  108. (* writes error message sent by remote host *)
  109.  
  110. begin
  111.   gotoxy(0,errorline);
  112.   screen( sc_clreol );
  113.   write('Host error : ');
  114.   unitwrite( consol, p[0], len,, 12 );
  115.   gotoxy(0,promptline);
  116. end; (* error *)
  117.  
  118.  
  119.  
  120. PROCEDURE io_error{ i: integer };
  121.  
  122. begin
  123.  gotoxy( 0, errorline );
  124.  screen( sc_clreol );
  125.  write('IO_ERROR : ');
  126.  case i of
  127.       0: writeln('No error');
  128.       1: writeln('Bad Block, Parity error (CRC)'); {not used for Apple}
  129.       2: writeln('Bad Unit Number');
  130.       3: writeln('Bad Mode, Illegal operation');
  131.       4: writeln('Undefined hardware error'); {not used for Apple}
  132.       5: writeln('Lost unit, Unit is no longer on-line');
  133.       6: writeln('Lost file, File is no longer in directory');
  134.       7: writeln('Bad Title, Illegal file name');
  135.       8: writeln('No room, insufficient space');
  136.       9: writeln('No unit, No such volume on line');
  137.      10: writeln('No file, No such file on volume');
  138.      11: writeln('Duplicate file');
  139.      12: writeln('Not closed, attempt to open an open file');
  140.      13: writeln('Not open, attempt to close a closed file');
  141.      14: writeln('Bad format, error in reading real or integer');
  142.      15: writeln('Ring buffer overflow');
  143.      16: writeln('Diskette is write protected');
  144.    end; (* case *)
  145.  if i = 64 then writeln('Bad block on diskette');
  146.  gotoxy(0,promptline)
  147. end; (* io_error *)
  148.  
  149.  
  150.  
  151. PROCEDURE debugwrite{  s: string };
  152.  
  153. (* writes a debugging message *)
  154.  
  155. var j: integer;
  156.  
  157. begin
  158.   gotoxy( 0, debug_line );
  159.   screen( sc_clreol );
  160.   write('Debug state is ', s );
  161. end; (* debugwrite *)
  162.  
  163.  
  164. PROCEDURE packet_write{  var p:packettype; len: integer };
  165.  
  166. (* writes a packet to the screen for debugging purposes *)
  167.  
  168. var i : integer;
  169.  
  170. begin
  171.   gotoxy( 0, pack_line + 2 ); screen( sc_clreol ); gotoxy( 0, pack_line + 1 );
  172.   screen( sc_clreol );
  173.   unitwrite( consol, p[1], ( len-2 ), , 12 );
  174. end; { packet_write }
  175.  
  176.  
  177.  
  178. PROCEDURE ack_write{ ptype: char; len,num: integer; var data: packettype};
  179.  
  180. (* writes a ack/nack package to the screen for debugging purposes *)
  181.  
  182. var i : integer;
  183.  
  184. begin
  185.   gotoxy( 0, ack_line + 1 );
  186.   screen( sc_clreos );
  187.   writeln('type= ',ptype);
  188.   writeln('num = ',num);
  189.   writeln('len = ',len);
  190.   unitwrite(consol, data[0], len,, 12 );
  191. end;  { ack_write }
  192.  
  193. PROCEDURE write_bool{ s: string; b: boolean};
  194.  
  195. (* writes message & 'on' if b, 'off' if not b *)
  196.  
  197. begin
  198.   write(p, s);
  199.   case b of
  200.       true: writeln(p,'ON');
  201.       false: writeln(p,'OFF');
  202.     end; (* case *)
  203. end; (* write_bool *)
  204.  
  205.  
  206.  
  207. PROCEDURE write_ctl{ ch : char };
  208.  
  209. begin
  210.   if ord(ch) < 32
  211.    then begin
  212.           if ord(ch) = 27  then write(p,'<ESC>')
  213.                            else write(p,'<^',chr(ord(ch)+64),'> ');
  214.         end
  215.    else begin
  216.           if ord(ch) = 127 then write(p,'<DEL>')
  217.                            else write(p,'<',ch,'>  ');
  218.         end;
  219. end;  { write_ctl }
  220.  
  221.  
  222. PROCEDURE read_str{ var s : string };
  223.  
  224. var i, j, k : integer;
  225.          ch : char;
  226.  
  227. begin
  228.   i := 0; s := ''; ch := ' ';
  229.   repeat
  230.     unitread( keyport, ch, 1 );
  231.     if ch = backsp
  232.       then begin
  233.              if i > 0
  234.                then begin
  235.                       if s[i] in ctl_set then j := 5 else j := 1;
  236.                       for k := 1 to j do write( ch, ' ', ch );
  237.                       delete( s, i, 1 );
  238.                       i := i - 1;
  239.                     end;
  240.            end
  241.       else begin
  242.              if  ch  <>  cr
  243.                then begin
  244.                       if i < 80
  245.                         then begin
  246.                                if ch in ctl_set then write_ctl( ch )
  247.                                                 else write( ch );
  248.                                i := i + 1;
  249.                                s := concat( s, ' ' );
  250.                                s[i] := ch;
  251.                              end
  252.                         else write( chr(bell) );
  253.                     end;
  254.            end;
  255.   until ch = cr;
  256.   writeln;
  257. end;  { read_str }
  258.  
  259.  
  260.  
  261. FUNCTION  test_printer;
  262.  
  263.  this function only tests for the presence of a printerinterface card 
  264.  
  265. begin
  266.   close( pr );
  267.   reset( pr, pr_file );
  268.   test_printer := ( ioresult = 0 );
  269. end;
  270.  
  271.  
  272.  
  273. FUNCTION min{(x,y: integer): integer };
  274.  
  275. (* returns smaller of two integers *)
  276.  
  277. begin
  278.  if x < y then min := x else min := y
  279. end; (* min *)
  280.  
  281.  
  282.  
  283. FUNCTION tochar{ (ch: char): char };
  284.  
  285. (* tochar converts a control character to a printable one by adding space *)
  286.  
  287. begin
  288.  tochar := chr(ord(ch) + ord(' '))
  289. end; (* tochar *)
  290.  
  291.  
  292.  
  293. FUNCTION unchar{ (ch: char): char };
  294.  
  295. (* unchar undoes tochar *)
  296.  
  297. begin
  298.   unchar := chr(ord(ch) - ord(' '))
  299. end; (* unchar *)
  300.  
  301.  
  302.  
  303.  
  304. PROCEDURE writescreen{  s: string };
  305.  
  306. (* sets up the screen for receiving or sending files *)
  307.  
  308. begin
  309.    page(output);
  310.    gotoxy( 11, titleline); write('Kermit UCSD p-System : ', s );
  311.    gotoxy( 50, statusline - 1 );
  312.    write('( type '); write_ctl( int_key );
  313.    write(' to break off )');
  314.    gotoxy(0,packetline);
  315.    write('Number of Packets: ');
  316.    gotoxy(0,retryline);
  317.    write('Number of Tries: ');
  318.    gotoxy(0,fileline);
  319.    write('File Name: ');
  320.    if debug then
  321.      begin
  322.        gotoxy(0,packline);
  323.        write('Outgoing Packet:');
  324.        gotoxy(0,ackline);
  325.        write('Incoming Packet:');
  326.      end;
  327. end; (* writescreen *)
  328.  
  329.  
  330.  
  331. PROCEDURE refresh_screen{ numtry, num: integer };
  332.  
  333. (* keeps track of packet count on screen *)
  334.  
  335. begin
  336.    gotoxy(retrypos,retryline);
  337.    write(numtry: 5);
  338.    gotoxy(packetpos,packetline);
  339.    write(num: 5)
  340. end; (* refresh_screen *)
  341.  
  342.  
  343. PROCEDURE check_apple_char {  check : rem_stat_rec };
  344.  
  345.  this procedure only works with a special implementation of unitstatus 
  346.  in the attached remin driver. special character checking can be turned
  347.  off or on depending on the value of 'check'. also the remin driver can
  348.  be instructed to pass 7 or 8 bit characters to pascal.                
  349.  
  350. var  control_word : cntrl_word_rec;
  351.  
  352. begin
  353.   with control_word do
  354.     begin
  355.       channel := inp;  purpose := control;   special_req := none;
  356.       reserved := 0; filler := 0;
  357.     end;
  358.   unitstatus( inport, check, control_word );
  359. end;  { check_apple_char }
  360.  
  361.  
  362. FUNCTION ctl{ ( ch : char ) : char }; EXTERNAL;
  363.  
  364.  toggles bit 7 of a character: ' controllifies or decontrollifies ' 
  365.  
  366. FUNCTION calc_checksum{ (var packet:packettype; len:integer):char }; EXTERNAL;
  367.  
  368.  calculates one character checksum of a packet 
  369.  
  370.  
  371. begin
  372. end. { kermutil }
  373.  
  374.