home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / archives / ucsdpecan.zip / kermenus.text < prev    next >
Text File  |  1990-08-05  |  12KB  |  359 lines
  1. unit kermenus;
  2.  
  3. interface
  4.  
  5.   {Change log:
  6.   14 May 89, V1.1: Added Parameters menu   RTC
  7.   02 May 89, V1.1: Added menu to control log files   RTC
  8.   30 Apr 89, V1.1: Originally written   RTC
  9.   }
  10.  
  11.   procedure menu_interface;
  12.  
  13.   procedure mnu_version;
  14.  
  15. implementation
  16.  
  17.   uses screenops,
  18.        {$U kermglob.code} kermglob,
  19.        {$U kermutil.code} kermutil,
  20.        {$U sender.code}   sender,
  21.        {$U receiver.code} receiver,
  22.        {$U client.code}   client;
  23.  
  24.   const
  25.     my_version = '   Kermenus Unit V1.1, 14 May 89';
  26.  
  27.   procedure transfer_files;
  28.  
  29.     var
  30.       ch : char;
  31.  
  32.     begin {transfer_files}
  33.       ch := SC_prompt(concat('Kermit-UCSD File Transfer: ',
  34.                              'S(end, R(eceive, G(et, P(ut, A(bort'),
  35.                       -1,-1,0,menu_line,
  36.                       ['S','R','G','P','A',' '],
  37.                       false,',');
  38.       SC_clr_line(menu_line);
  39.       case ch of
  40.         'G', 'R' : begin
  41.                 if ch = 'G' then
  42.                   begin
  43.                     gotoxy(file_pos,file_line);
  44.                     readln(xfilename); uppercase(xfilename)
  45.                   end;
  46.                 recsw(rec_ok,ch = 'G');
  47.                 gotoxy(0,debugline);
  48.                 write(chr(bell));
  49.                 if rec_ok then
  50.                     writeln('successful receive')
  51.                 else
  52.                     writeln('unsuccessful receive');
  53.                 (*$I-*) (* set i/o checking off *)
  54.                 if f_is_binary
  55.                   then close(b_file)
  56.                   else close(t_file);
  57.                 (*$I+*) (* set i/o checking back on *)
  58.               end; (* recsym *)
  59.         'P', 'S' : begin
  60.                 gotoxy(file_pos,file_line);
  61.                 readln(xfilename); uppercase(xfilename);
  62.                 sendsw(send_ok);
  63.                 gotoxy(0,debugline);
  64.                 write(chr(bell));
  65.                 if send_ok then
  66.                     writeln('successful send')
  67.                 else
  68.                     writeln('unsuccessful send');
  69.                 (*$I-*) (* set i/o checking off *)
  70.                 if f_is_binary
  71.                   then close(b_file)
  72.                   else close(t_file);
  73.                 (*$I+*) (* set i/o checking back on *)
  74.               end; (* sendsym *)
  75.         'A', ' ' : begin
  76.                 gotoxy(0,debugline);
  77.                 write('file transfer aborted');
  78.               end; {abort transfer}
  79.       end {case ch}
  80.     end {transfer_files};
  81.  
  82.   procedure logs;
  83.  
  84.     var
  85.       ch_cmd,ch_log : char;
  86.       log_message : string;
  87.  
  88.     begin {logs}
  89.       ch_cmd := SC_prompt(concat('Kermit-UCSD Logs: ',
  90.                              'O(pen, C(lose, A(bort'),
  91.                       -1,-1,0,menu_line,
  92.                       ['O','C','A',' '],
  93.                       false,',');
  94.       case ch_cmd of
  95.         'O' : log_message := 'Open';
  96.         'C' : log_message := 'Close';
  97.         'A',' ' : exit(logs)
  98.       end {case ch_cmd};
  99.       ch_log := SC_prompt(concat('Kermit-UCSD ',log_message,' Log: ',
  100.                              'D(ebug, A(bort'),
  101.                       -1,-1,0,menu_line,
  102.                       ['D','A',' '],
  103.                       false,',');
  104.       case ch_log of
  105.         'D' : log_message := concat(log_message,' for Debug');
  106.         'A',' ' : exit(logs)
  107.       end {case ch_log};
  108.       if ch_cmd = 'O' then {command was to open log}
  109.         begin
  110.           SC_clr_line(menu_line);
  111.           write('File to ',log_message,' Logging>');
  112.           readln(xfilename); uppercase(xfilename);
  113.           {$I-}
  114.           case ch_log of
  115.             'D' :
  116.               begin
  117.                 close(debf,lock);
  118.                 rewrite(debf,xfilename)
  119.               end;
  120.           end {case ch_log};
  121.           if ioresult <> 0 then
  122.             begin
  123.               writeln('Unable to open ',xfilename);
  124.               case ch_log of
  125.                 'D' :
  126.                   begin
  127.                     close(debf);
  128.                     rewrite(debf,'CONSOLE:')
  129.                   end;
  130.               end {case ch_log};
  131.             end
  132.           else {$I+}
  133.             case ch_log of
  134.               'D' : write(debf,
  135.                   ker_version,' -- Debug log...');
  136.             end
  137.         end
  138.       else {command was to close log}
  139.         begin
  140.           {$I-}
  141.           case ch_log of
  142.             'D' : close(debf,lock);
  143.           end {case ch_log};
  144.           if ioresult <> 0 then
  145.             begin
  146.               writeln('Unable to close file');
  147.             end;
  148.           case ch_log of
  149.             'D' : rewrite(debf,'CONSOLE:');
  150.           end {case ch_log};
  151.           {$I+}
  152.         end;
  153.     end {logs};
  154.  
  155.   procedure menu_interface;
  156.  
  157.     var
  158.       done : boolean;
  159.       ch : char;
  160.  
  161.     procedure write_bool(b: boolean);
  162.  
  163.       {writes 'True' or 'False'}
  164.  
  165.       begin {write_bool}
  166.         if b
  167.           then write('True ')
  168.           else write('False')
  169.       end {write_bool};
  170.  
  171.     procedure read_bool(var b: boolean);
  172.  
  173.       var ch : char;
  174.  
  175.       begin {read_bool}
  176.         SC_getc_ch(ch,['T','F']);
  177.         b := ch = 'T'
  178.       end {read_bool};
  179.  
  180.     procedure parameters;
  181.  
  182.       const
  183.         name_line = 9;
  184.         type_line = 10;
  185.         warn_line = 11;
  186.         baud_line = 12;
  187.         parity_line = 13;
  188.         echo_line = 14;
  189.         ibm_line = 15;
  190.         em_line = 16;
  191.         esc_line = 17;
  192.         debug_line = 18;
  193.         sys_line = 19;
  194.         opt_pos = 4;
  195.         val_pos = 25;
  196.  
  197.       begin {parameters}
  198.         SC_eras_eos(0,pred(name_line));
  199.         repeat
  200.           gotoxy(opt_pos,name_line); write('File N(ames');
  201.           gotoxy(val_pos,name_line);
  202.           if lit_names
  203.             then write('Literal  ')
  204.             else write('Converted');
  205.           gotoxy(opt_pos,type_line); write('File T(ype');
  206.           gotoxy(val_pos,type_line);
  207.           if f_is_binary
  208.             then write('Binary')
  209.             else write('Text  ');
  210.           gotoxy(opt_pos,warn_line); write('File W(arning');
  211.           gotoxy(val_pos,warn_line); write_bool(f_warn);
  212.           gotoxy(opt_pos,baud_line); write('B(aud rate');
  213.           gotoxy(val_pos,baud_line); write(baud);
  214.           gotoxy(opt_pos,parity_line); write('P(arity');
  215.           gotoxy(val_pos,parity_line);
  216.           case parity of
  217.             evenpar: write('Even');
  218.             markpar: write('Mark');
  219.             nopar: write('None');
  220.             oddpar: write('Odd');
  221.             spacepar: write('Space');
  222.           end {case parity};
  223.           gotoxy(opt_pos,echo_line); write('L(ocal echo');
  224.           gotoxy(val_pos,echo_line); write_bool(half_duplex);
  225.           gotoxy(opt_pos,ibm_line); write('I(BM mode');
  226.           gotoxy(val_pos,ibm_line); write_bool(ibm);
  227.           gotoxy(opt_pos,em_line); write('eM(ulate Datamedia');
  228.           gotoxy(val_pos,em_line); write_bool(emulating);
  229.           gotoxy(opt_pos,esc_line); write('E(scape Character');
  230.           gotoxy(val_pos,esc_line); write('^',ctl(esc_char));
  231.           gotoxy(opt_pos,debug_line); write('D(ebugging');
  232.           gotoxy(val_pos,debug_line); write_bool(debug);
  233.           gotoxy(opt_pos,sys_line); write('S(ystem ID');
  234.           gotoxy(val_pos,sys_line); write(system_id);
  235.           ch := SC_prompt(concat('Kermit Parameters: {options} ',
  236.                                '<space> to leave, ',
  237.                                'switch to K(ermit style interface, V(ersion'),
  238.                           -1,-1,0,menu_line,
  239.                 ['D','E','N','T','W','I','L','M','B','P','S','K','V',' '],
  240.                           false,',');
  241.           case ch of
  242.             'D' : begin
  243.                     SC_erase_to_EOL(val_pos,debug_line); read_bool(debug)
  244.                   end;
  245.             'E' : repeat
  246.                     SC_erase_to_EOL(val_pos,esc_line);
  247.                     read(keyboard,esc_char)
  248.                   until esc_char in [chr(0)..chr(31)];
  249.             'N' : begin
  250.                     SC_erase_to_EOL(val_pos,name_line);
  251.                     SC_getc_ch(ch,['L','C']);
  252.                     lit_names := ch = 'L'
  253.                   end;
  254.             'T' : begin
  255.                     SC_erase_to_EOL(val_pos,type_line);
  256.                     SC_getc_ch(ch,['B','T']);
  257.                     f_is_binary := ch = 'B'
  258.                   end;
  259.             'W' : begin
  260.                     SC_erase_to_EOL(val_pos,warn_line); read_bool(f_warn)
  261.                   end;
  262.             'I' : begin
  263.                     SC_erase_to_EOL(val_pos,ibm_line); read_bool(ibm);
  264.                     if ibm then
  265.                       begin
  266.                         parity := markpar;
  267.                         half_duplex := true
  268.                       end
  269.                     else
  270.                       begin
  271.                         parity := nopar;
  272.                         half_duplex := false
  273.                       end;
  274.                     fill_parity_array
  275.                   end;
  276.             'L' : begin
  277.                     SC_erase_to_EOL(val_pos,echo_line); read_bool(halfduplex)
  278.                   end;
  279.             'M' : begin
  280.                     SC_erase_to_EOL(val_pos,em_line); read_bool(emulating)
  281.                   end;
  282.             'B' : repeat
  283.                     SC_erase_to_EOL(val_pos,baud_line); {$I-} read(baud); {$I+}
  284.                     SC_erase_to_EOL(0,menu_line)
  285.                   until setup_comm;
  286.             'P' : begin
  287.                     SC_erase_to_EOL(val_pos,parity_line);
  288.                     SC_getc_ch(ch,['E','O','M','S','N']);
  289.                     case ch of
  290.                       'E' : parity := evenpar;
  291.                       'M' : parity := markpar;
  292.                       'N' : parity := nopar;
  293.                       'O' : parity := oddpar;
  294.                       'S' : parity := spacepar;
  295.                     end {case ch};
  296.                     fill_parity_array
  297.                   end;
  298.             'S' : begin
  299.                     SC_erase_to_EOL(val_pos,sys_line); readln(system_id)
  300.                   end;
  301.             'K' : begin
  302.                     done := true; {switch back to KERMIT style interface}
  303.                     SC_clr_screen; exit(parameters)
  304.                   end;
  305.             'V' : begin
  306.                     SC_eras_eos(0,name_line);
  307.                     noun := versionsym; show_parms;
  308.                     exit(parameters)
  309.                   end;
  310.             ' ' : exit(parameters);
  311.           end {case ch}
  312.         until false
  313.       end {parameters};
  314.  
  315.     begin {menu_interface}
  316.       done := false;
  317.       writescreen('');
  318.       repeat
  319.         ch := SC_prompt(concat('Kermit-UCSD: ',
  320.                                'C(onnect, T(ransfer Files, Q(uit, ',
  321.                                'S(et Parameters, L(ogs, B(ye, F(inish'),
  322.                         -1,-1,0,menu_line,
  323.                         ['C','T','Q','S','L','B','F'],
  324.                         false,',');
  325.         SC_clr_line(status_line); SC_clr_line(debug_line);
  326.         case ch of
  327.           'C' : begin SC_clr_screen; connect; writescreen('') end;
  328.           'T' : transfer_files;
  329.           'L' : logs;
  330.           'F', 'B' : begin
  331.                   case ch of
  332.                     'F' : line := 'F';
  333.                     'B' : line := 'L';
  334.                   end {case};
  335.                   clientsw(send_ok,'G',line);
  336.                   gotoxy(0,debugline);
  337.                   write(chr(bell));
  338.                   if send_ok then
  339.                       writeln('successful transaction')
  340.                   else
  341.                       writeln('unsuccessful transaction');
  342.                   (*$I-*) (* set i/o checking off *)
  343.                   close(t_file);
  344.                   (*$I+*) (* set i/o checking back on *)
  345.                 end; {generic server command}
  346.           'S' : parameters;
  347.           'Q' : begin done := true; verb := quitsym end;
  348.         end {case ch}
  349.       until done
  350.     end {menu_interface};
  351.  
  352.   procedure mnu_version;
  353.  
  354.     begin {mnu_version}
  355.       writeln(my_version)
  356.     end {mnu_version};
  357.  
  358. end {kermenus}.
  359.