home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
kam401
/
kam-rcv.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-06-10
|
6KB
|
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;