HAM Radio 1/HamRadio.cdr/misc/kam401/kam-rcv.pas

Pascal/Delphi Source File | 1989-06-10 | 6.1 KB | 241 lines

procedure capture_on;
begin
  check_if_in_help;
  prompt_color;
  capture_file_name := 'CAPTURE.TMP';
  Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  SayGet(20,status_line,'Capture File (or ?) ',capture_file_name,_S,24,1);
  WatchKeys := ['?'];
  ReadGets;
  if LastKey = '?' then capture_file_name := PickFile('*.*');
  if (capture_file_name <> '')
  then
  begin
    assign(capture_file,capture_file_name);
    {$I-}
    rewrite(capture_file);
    if (IOresult <> 0)
    then begin
           gotoxy(20,status_line); status_color;
           write('Unable to open ',capture_file_name,^G^G^G);
           delay(1000);
           close(capture_file);
         end;
    capture := TRUE;
    sho_status;
    capture_pointer := 0;
  end;
end;

procedure write_capture_block;
var i : integer;
begin
  for i := 0 to 2047 do
    write(capture_file,capture_buffer[i]);
  capture_pointer := 0;
end;

procedure capture_off;
begin
  capture_buffer[capture_pointer] := ^Z;
  write_capture_block;
  close(capture_file);
  capture := FALSE;
  sho_status;
end;

procedure capture_char(c : char);
begin
  capture_buffer[capture_pointer] := c;
  capture_pointer := capture_pointer + 1;
  if capture_pointer > 2047 then
    write_capture_block;
end;

procedure init_rcv_buffers;
var i : integer;
begin
  for i := 0 to max_rcv_buffers do
    rcv_buffer[i]^[0] := chr(0);
  rcv_cnt := 1;
end;

procedure update_buffer(c : char);
var i : integer;
begin
  if c <> #13 then
  begin
    rcv_buffer[max_rcv_buffers]^[rcv_cnt] := c;
    rcv_buffer[max_rcv_buffers]^[0] := chr(rcv_cnt);
    inc(rcv_cnt);
  end;
  if (rcv_cnt = 81) OR (c = #13) then
  begin
    for i := 0 to max_rcv_buffers - 1 do
      rcv_buffer[i]^ := rcv_buffer[i+1]^;
    rcv_cnt := 1;
    rcv_buffer[max_rcv_buffers]^[0] := chr(0);
  end;
end;

procedure next_line;
begin
  if yin = inp_end_line
    then begin
           window(1, inp_start_line, 80, inp_end_line );
           gotoxy(1,1); DelLine;
           full_window;
           xin := 1;
           gotoxy(xin,yin);
         end
    else begin
           yin := yin + 1;
           xin := 1;
           gotoxy(xin,yin);
         end;
end;

procedure show_inp(st: char);
var i,n,p: integer;
begin
  if st = #00 then exit;
  receive_color;
  if (xin > scrn_width) then
  case st of
    '!'..'z': begin
                n := 0;
                p := rcv_cnt;
                repeat
                        n := n + 1;
                  p := (p-1);
                until (rcv_buffer[max_rcv_buffers]^[p] = ' ') OR
                      (p = 0);
                p := p + 1;
                n := n - 1;
                if n in [1..10]
                then
                  begin
                    tmpstr := '';
                    gotoxy(xin - n, yin);
                    ClrEol;
                    next_line;
                    while (n > 0) do
                    begin
                      rcv_buffer[max_rcv_buffers]^[0] := chr(rcv_cnt - n);
                      tmpstr := tmpstr + rcv_buffer[max_rcv_buffers]^[p];
                      write(rcv_buffer[max_rcv_buffers]^[p]);
                      inc(p);
                      dec(n);
                      inc(xin);
                    end;
                    update_buffer(#13);
                    for i := 1 to length(tmpstr) do
                      update_buffer(tmpstr[i]);
                  end
                else
                  begin
                    next_line;
                    update_buffer(#13);
                  end;
              end;
    ' ' : begin
            next_line;
            update_buffer(#13);
          end;
  end;
  gotoxy(xin,yin);
  case st of
    #13 : begin
            update_buffer(#13);
            next_line;
            if (capture = TRUE) then
            begin
              capture_char(#13);
              capture_char(#10);
            end;
          end;
    #10 : ;
    else begin
           write(st);
           xin := xin + 1;
           update_buffer(st);
           if (capture = TRUE) then capture_char(st);
         end;
  end;
  if (st = #32) AND (mode = CW)
  then begin
         rcv_stat;
         disp_rcv_wpm;
       end;
end;

procedure rcvg;
begin
  if char_ready then show_inp(kam_in);
end;

procedure show_page;
begin
  clrscr;
  if show_line < first then show_line := first;
  line_count := 1;
  repeat
    write(rcv_buffer[show_line]^);
    if (length(rcv_buffer[show_line]^) < 80) AND
       (line_count < (nlines))
      then writeln;
    inc(show_line);
    inc(line_count);
  until (line_count = nlines) OR (show_line > max_rcv_buffers);
end;

procedure review_rcv_buffer;
var i : integer;
    OldVideo : array[1..2000] of word;
    RevKey : char;
begin
  nlines := inp_end_line - inp_start_line + 1;
  first := -1;
  repeat
    inc(first);
  until (length(rcv_buffer[first]^) > 0) OR (first = max_rcv_buffers);
  if (first = max_rcv_buffers) AND (rcv_cnt = 1) then exit;
  FillPage(@OldVideo);
  gotoxy(1,status_line);
  status_color;
  ClrEol;
  write('             <HOME> beginning   <END> end   <PgUp>   <PgDwn>  <ESC>ape');
  window(1,inp_start_line,80,inp_end_line);
  receive_color;
  show_line := first;
  show_page;
  repeat
    repeat
      RevKey := readkey;
    until RevKey in [#0,#27];
    if RevKey = #0 then  RevKey := readkey;
    case RevKey of
      #71 : begin            { HOME }
              show_line := first;
              show_page;
            end;
      #79 : begin            { END }
              show_line := max_rcv_buffers - nlines + 1;
              show_page;
            end;
      #73 : begin            { PGUP }
              show_line := show_line - 2*(nlines) - 1;
              show_page;
            end;
      #81 : begin            { PGDWN }
              if show_line > (max_rcv_buffers - nlines + 1) then
                 show_line := max_rcv_buffers - nlines + 1;
              show_page;
            end;
    end;
  until RevKey = #27;
  DisPlayPage(@OldVideo);
  window(1,1,80,25);
end;