home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / packet / kam300 / kam-aux.pas < prev    next >
Pascal/Delphi Source File  |  1988-04-06  |  7KB  |  373 lines
  1. procedure full_window;
  2. begin
  3.   window(1,1,80,25);
  4. end;
  5.  
  6. procedure reset_cursor;
  7. begin
  8.   full_window;
  9.   gotoxy(1,status_line);
  10. end;
  11.  
  12. procedure show_time;
  13. begin
  14.   full_window;
  15.   status_color;
  16.   gotoxy(66,status_line);
  17.   write(' ',date,' ',time);
  18.   reset_cursor;
  19. end;
  20.  
  21. procedure disp_time;
  22. begin
  23.   full_window;
  24.   if time <> old_time then
  25.   begin
  26.     old_time := time;
  27.     show_time;
  28.   end;
  29. end;
  30.  
  31. procedure disp_xmt_wpm;
  32. begin
  33.   full_window;
  34.   gotoxy(6,status_line);
  35.   status_color;
  36.   write(xmt_wpm:2);
  37.   reset_cursor;
  38. end;
  39.  
  40. procedure disp_rcv_wpm;
  41. begin
  42.   full_window;
  43.   gotoxy(16,status_line);
  44.   status_color;
  45.   write(rcv_wpm:2);
  46.   reset_cursor;
  47. end;
  48.  
  49. procedure cw_status_line;
  50. begin
  51.   write('CW      xmt,      rcv ');
  52.   disp_xmt_wpm;
  53.   disp_rcv_wpm;
  54. end;
  55.  
  56. procedure rtty_ascii_line;
  57. begin
  58.   write(baud_rate[baud]:3,' baud, ',rtty_shift[shift]:5,' shift ');
  59.   gotoxy(55,status_line);
  60.   case invert of
  61.     TRUE          : write(' INVERT ');
  62.     FALSE         : write(' NORMAL ');
  63.   end;
  64.   reset_cursor;
  65. end;
  66.  
  67. procedure rtty_status_line;
  68. begin
  69.   write('RTTY ');
  70.   rtty_ascii_line;
  71. end;
  72.  
  73. procedure ascii_status_line;
  74. begin
  75.   write('ASCII ');
  76.   rtty_ascii_line;
  77. end;
  78.  
  79. procedure sho_status;
  80. begin
  81.   full_window;
  82.   gotoxy(1,status_line);
  83.   status_color; ClrEol;
  84.   case mode of
  85.     CW    : cw_status_line;
  86.     RTTY  : rtty_status_line;
  87.     ASCII : ascii_status_line;
  88.   end;
  89.   Gotoxy(33,status_line);
  90.   case state of
  91.     transmit      : write(' TRANSMIT ');
  92.     receive       : write(' RECEIVE  ');
  93.   end;
  94.   case auto_switch of
  95.     TRUE          : write('AUTO T/R ');
  96.     FALSE         : write('MAN  T/R ');
  97.   end;
  98.   show_time;
  99.   gotoxy(1,aux_line); aux_color; ClrEol;
  100.   write('Msgs:',msg_file_name:14);
  101.   if (capture = TRUE) then
  102.   begin
  103.     gotoxy(70,aux_line);
  104.     write('CAPTURE ON');
  105.   end;
  106.   reset_cursor;
  107. end;
  108.  
  109. procedure check_if_in_help;
  110. begin
  111.   if viewing_help then
  112.   begin
  113.     restore_screen;
  114.     viewing_help := FALSE;
  115.   end;
  116. end;
  117.  
  118. procedure new_rtty_baud;
  119. begin
  120.   check_if_in_help;
  121.   baud := baud + 1;
  122.   if baud = 9 then
  123.     case mode of
  124.       RTTY  : baud := 0;
  125.       ASCII : baud := 5;
  126.     end;
  127.   set_rtty_baud;
  128.   sho_status;
  129. end;
  130.  
  131. procedure new_rtty_shift;
  132. begin
  133.   check_if_in_help;
  134.   shift := shift + 1;
  135.   if shift = 4 then shift := 0;
  136.   set_rtty_shift;
  137.   sho_status;
  138. end;
  139.  
  140. procedure flip_invert;
  141. begin
  142.   mod_rtty_invert;
  143.   sho_status;
  144. end;
  145.  
  146. procedure change_speed;
  147. var err, old_wpm: integer;
  148. begin
  149.   check_if_in_help;
  150.   xmt_wpm := rcv_wpm;
  151.   val(xmt_wpm, int_wpm, err);
  152.   if err <> 0 then
  153.   begin
  154.     int_wpm := old_wpm;
  155.     str(int_wpm, xmt_wpm);
  156.   end;
  157.   kam_xmt_wpm;
  158.   sho_status;
  159. end;
  160.  
  161. procedure set_speed;
  162. begin
  163.   full_window;
  164.   check_if_in_help;
  165.   prompt_color;
  166.   {$I-}
  167.   repeat
  168.     gotoxy(5,status_line);
  169.     write('    <==');
  170.     gotoxy(6,status_line);
  171.     read(int_wpm);
  172.   until (IOresult = 0) AND (int_wpm > 4) and (int_wpm < 81);
  173.   str(int_wpm,xmt_wpm);
  174.   kam_xmt_wpm;
  175.   sho_status;
  176. end;
  177.  
  178. procedure clear_transmit_screen;
  179. begin
  180.   check_if_in_help;
  181.   window(1,out_start_line,80,out_end_line);
  182.   transmit_color; clrscr;
  183.   full_window;
  184.   xkbd := 1; ykbd := out_start_line;
  185.   attr_pos := ((80*(yout - 1) + xout) SHL 1) - 1;
  186.   halt_xmt;
  187. end;
  188.  
  189. procedure clear_receive_screen;
  190. begin
  191.   check_if_in_help;
  192.   window(1,inp_start_line,80,inp_end_line);
  193.   receive_color;  clrscr;
  194.   xin  := 1; yin  := 1;
  195.   full_window;
  196. end;
  197.  
  198. procedure clear_screen;
  199. begin
  200.   check_if_in_help;
  201.   clear_receive_screen;
  202.   clear_transmit_screen;
  203.   sho_status;
  204.   full_window;
  205.   gotoxy(1,25); aux_color; ClrEol;
  206.   case mode of
  207.     CW    :
  208.   write(' ^P pause   AS %    AR +     <<< F1 for Help >>>    BT =   SK #   KN (  ^T T/R ');
  209.     RTTY  :
  210.   write(' ^P pause                    <<< F1 for Help >>>                        ^T T/R ');
  211.     ASCII :
  212.   write(' ^P pause                    <<< F1 for Help >>>                        ^T T/R ');
  213.   end;
  214.   reset_cursor;
  215. end;
  216.  
  217. procedure msg_load;
  218. var i : integer;
  219.     msgfile: text;
  220. begin
  221.   check_if_in_help;
  222.   assign(msgfile,msg_file_name);
  223.   {$I-}
  224.   reset(msgfile);
  225.   {$I+}
  226.   if (IOresult = 0) then
  227.   begin
  228.     for i := 0 to 9 do
  229.       readln(msgfile,msg[i]);
  230.     close(msgfile);
  231.   end
  232.   else
  233.   begin
  234.     msg_file_name := '';
  235.     for i := 0 to 9 do
  236.       msg[i] := '';
  237.   end;
  238. end;
  239.  
  240. procedure save_buffer;
  241. label save_fault;
  242. var i : integer;
  243.     rcv_file_name : file_type;
  244.     rcvfile: text;
  245. begin
  246.   if state = transmit then halt_xmt;
  247.   check_if_in_help;
  248.   prompt_color;
  249.   get_file_name(rcv_file_name,
  250.                 20,aux_line,'Receive',1,1,80,24,3);
  251.   if (rcv_file_name <> '') then
  252.   begin
  253.     assign(rcvfile,rcv_file_name);
  254.     {$I-}
  255.     rewrite(rcvfile);
  256.     if (IOresult = 0)
  257.     then
  258.       for i := 0 to $7FF do
  259.         begin
  260.           write(rcvfile,rcv_buffer[i]);
  261.           if (IOresult <> 0) then goto save_fault;
  262.         end
  263.     else
  264.       begin
  265.         gotoxy(20,aux_line); ClrEol;
  266.         write('ERROR');
  267.         delay(2000);
  268.       end;
  269. save_fault:
  270.     close(rcvfile);
  271.   end;
  272.   sho_status;
  273. end;
  274.  
  275. procedure view_modify_msgs;
  276. var i : integer;
  277.     nbr, index : integer;
  278.     input_str : string[79];
  279.     nbr_chr : char;
  280. begin
  281.   if state = transmit then halt_xmt;
  282.   check_if_in_help;
  283.   save_screen;
  284.   aux_color;
  285.   clrscr;
  286.   writeln('Contents of message file: ',msg_file_name);
  287.   writeln;
  288.   for i := 0 to 9 do
  289.   begin
  290.     writeln('Buffer # ',i:1);
  291.     writeln(msg[i]);
  292.   end;
  293.   repeat
  294.     gotoxy(1,24);
  295.     write('Modify message number <0..9><ESC> ...  ',chr(8));
  296.     repeat
  297.       nbr_chr := readkey
  298.     until (nbr_chr in ['0'..'9',#27 ]);
  299.     if (nbr_chr in ['0'..'9']) then
  300.     begin
  301.       write(nbr_chr);
  302.       nbr := ord(nbr_chr) - $30;
  303.       gotoxy(1,4+2*nbr); ClrEol;
  304.       msg[nbr] := '';
  305.       readln(msg[nbr]);
  306.       msg[nbr][length(msg[nbr])+1] := null;
  307.     end;
  308.   until (nbr_chr = #27);
  309.   restore_screen;
  310. end;
  311.  
  312. procedure load_messages;
  313. begin
  314.   if state = transmit then halt_xmt;
  315.   check_if_in_help;
  316.   prompt_color;
  317.   get_file_name(msg_file_name,
  318.                 20,aux_line,'Message',1,1,80,24,3);
  319.   if (msg_file_name <> '') then msg_load;
  320.   sho_status;
  321. end;
  322.  
  323. procedure save_messages;
  324. label save_fault;
  325. var i : integer;
  326.     msgfile: text;
  327. begin
  328.   if state = transmit then halt_xmt;
  329.   check_if_in_help;
  330.   prompt_color;
  331.   get_file_name(msg_file_name,
  332.                 20,aux_line,'Dest',1,1,80,24,3);
  333.   if (msg_file_name <> '') then
  334.   begin
  335.     assign(msgfile,msg_file_name);
  336.     {$I-}
  337.     rewrite(msgfile);
  338.     if (IOresult = 0)
  339.     then
  340.       begin
  341.         for i := 0 to 9 do
  342.           begin
  343.             writeln(msgfile,msg[i]);
  344.             if (IOresult <> 0) then goto save_fault;
  345.           end;
  346. save_fault:
  347.         close(msgfile);
  348.       end
  349.     else
  350.       begin
  351.         gotoxy(20,aux_line); ClrEol;
  352.         write('ERROR');
  353.         delay(2000);
  354.       end;
  355.   end;
  356.   sho_status;
  357. end;
  358.  
  359. procedure exit_request;
  360. begin
  361.   save_screen;
  362.   prompt_color;
  363.   frame(5,5,30,9);
  364.   window(6,6,29,8);
  365.   clrscr;
  366.   gotoxy(1,2);
  367.   write('Exit to DOS <Y/N> ..');
  368.   repeat key := readkey until key in ['y','n','Y','N'];
  369.   if key in ['y','Y'] then
  370.     quit_flag := true;
  371.   restore_screen;
  372. end;
  373.