home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / cw / kamrtty / kam-rcv.pas < prev    next >
Pascal/Delphi Source File  |  1988-04-06  |  3KB  |  147 lines
  1. procedure capture_on;
  2. begin
  3.   check_if_in_help;
  4.   prompt_color;
  5.   get_file_name(capture_file_name,
  6.                 20,aux_line,'Capture',1,1,80,24,3);
  7.   if (capture_file_name = '')
  8.   then
  9.     begin
  10.       gotoxy(20,aux_line); aux_color; ClrEol;
  11.     end
  12.   else
  13.   begin
  14.     assign(capture_file,capture_file_name);
  15.     {$I-}
  16.     rewrite(capture_file);
  17.     if (IOresult <> 0)
  18.     then begin
  19.            gotoxy(20,aux_line); status_color;
  20.            write('Unable to open ',capture_file_name,^G^G^G);
  21.            delay(2000);
  22.            gotoxy(20,aux_line); aux_color; ClrEol;
  23.            close(capture_file);
  24.          end;
  25.     capture := TRUE;
  26.     sho_status;
  27.     capture_pointer := 0;
  28.   end;
  29. end;
  30.  
  31. procedure write_capture_block;
  32. var write_result : integer;
  33. begin
  34.   {$I-}
  35.   blockwrite(capture_file,capture_buffer,16,write_result);
  36.   capture_pointer := 0;
  37.   if write_result = 0 then
  38.   begin
  39.     close(capture_file);
  40.     gotoxy(20,aux_line);status_color;
  41.     write('File Write Error !!!');
  42.     delay(2000);
  43.     gotoxy(20,aux_line); aux_color; ClrEol;
  44.     capture := FALSE;
  45.   end;
  46. end;
  47.  
  48. procedure capture_off;
  49. begin
  50.   capture_buffer[capture_pointer] := ^Z;
  51.   write_capture_block;
  52.   close(capture_file);
  53.   capture := FALSE;
  54.   gotoxy(20,aux_line); aux_color; ClrEol;
  55.   sho_status;
  56. end;
  57.  
  58. procedure capture_char(c : char);
  59. begin
  60.   capture_buffer[capture_pointer] := c;
  61.   capture_pointer := capture_pointer + 1;
  62.   if capture_pointer > 2047 then
  63.     write_capture_block;
  64. end;
  65.  
  66. procedure update_buffer(c : char);
  67. begin
  68.   rcv_buffer[rcv_cnt] := c;
  69.   rcv_cnt := (rcv_cnt + 1) AND $7FF;
  70. end;
  71.  
  72. procedure show_inp(st: char);
  73. var n,p: integer;
  74. begin
  75.   if st = #00 then exit;
  76.   window(1, inp_start_line, 80, inp_end_line );
  77.   receive_color;
  78.   if (xin > scrn_width) OR (st = #13) then
  79.   begin
  80.     n := 0;
  81.     if (st in ['!'..'z']) then
  82.     begin
  83.       p := rcv_cnt;
  84.       repeat
  85.         n := n + 1;
  86.         p := (p-1) AND $7FF;
  87.       until (rcv_buffer[p] = ' ');
  88.       p := p + 1;
  89.       n := n - 1;
  90.       if (xin > scrn_width) AND (yin = rcv_bottom)
  91.       then begin
  92.              gotoxy(scrn_width - n, yin-1);
  93.              ClrEol;
  94.            end
  95.       else begin
  96.              gotoxy(scrn_width - n, yin);
  97.              ClrEol;
  98.            end;
  99.     end;
  100.     xin := 1;
  101.     yin := yin + 1;
  102.     if (yin > rcv_bottom) then
  103.     begin
  104.       yin := rcv_bottom;
  105.       if (st = #13) then writeln;
  106.     end;
  107.     gotoxy(xin,yin);
  108.     while (n > 0) do
  109.     begin
  110.       write(rcv_buffer[p]);
  111.       p := (p+1) AND $7FF;
  112.       n := n - 1;
  113.       xin := xin + 1;
  114.     end;
  115.     if (capture = TRUE) then
  116.     begin
  117.       capture_char(#13);
  118.       capture_char(#10);
  119.     end;
  120.     update_buffer(#13);
  121.     update_buffer(#10);
  122.   end;
  123.   gotoxy(xin,yin);
  124.   if (NOT (st in [#10,#13])) then
  125.   begin
  126.     write(st);
  127.     if (capture = TRUE) then capture_char(st);
  128.   end;
  129.   if (st in [' '..'z']) then
  130.   begin
  131.     xin := xin + 1;
  132.     update_buffer(st);
  133.   end;
  134.   reset_cursor;
  135.   if (st = #32) AND (mode = CW)
  136.   then begin
  137.          rcv_stat;
  138.          disp_rcv_wpm;
  139.        end;
  140. end;
  141.  
  142. procedure rcvg;
  143. begin
  144.   if char_ready then show_inp(kam_in);
  145. end;
  146.  
  147.