home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
cw
/
kamrtty
/
kam-aux.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1988-04-06
|
7KB
|
373 lines
procedure full_window;
begin
window(1,1,80,25);
end;
procedure reset_cursor;
begin
full_window;
gotoxy(1,status_line);
end;
procedure show_time;
begin
full_window;
status_color;
gotoxy(66,status_line);
write(' ',date,' ',time);
reset_cursor;
end;
procedure disp_time;
begin
full_window;
if time <> old_time then
begin
old_time := time;
show_time;
end;
end;
procedure disp_xmt_wpm;
begin
full_window;
gotoxy(6,status_line);
status_color;
write(xmt_wpm:2);
reset_cursor;
end;
procedure disp_rcv_wpm;
begin
full_window;
gotoxy(16,status_line);
status_color;
write(rcv_wpm:2);
reset_cursor;
end;
procedure cw_status_line;
begin
write('CW xmt, rcv ');
disp_xmt_wpm;
disp_rcv_wpm;
end;
procedure rtty_ascii_line;
begin
write(baud_rate[baud]:3,' baud, ',rtty_shift[shift]:5,' shift ');
gotoxy(55,status_line);
case invert of
TRUE : write(' INVERT ');
FALSE : write(' NORMAL ');
end;
reset_cursor;
end;
procedure rtty_status_line;
begin
write('RTTY ');
rtty_ascii_line;
end;
procedure ascii_status_line;
begin
write('ASCII ');
rtty_ascii_line;
end;
procedure sho_status;
begin
full_window;
gotoxy(1,status_line);
status_color; ClrEol;
case mode of
CW : cw_status_line;
RTTY : rtty_status_line;
ASCII : ascii_status_line;
end;
Gotoxy(33,status_line);
case state of
transmit : write(' TRANSMIT ');
receive : write(' RECEIVE ');
end;
case auto_switch of
TRUE : write('AUTO T/R ');
FALSE : write('MAN T/R ');
end;
show_time;
gotoxy(1,aux_line); aux_color; ClrEol;
write('Msgs:',msg_file_name:14);
if (capture = TRUE) then
begin
gotoxy(70,aux_line);
write('CAPTURE ON');
end;
reset_cursor;
end;
procedure check_if_in_help;
begin
if viewing_help then
begin
restore_screen;
viewing_help := FALSE;
end;
end;
procedure new_rtty_baud;
begin
check_if_in_help;
baud := baud + 1;
if baud = 9 then
case mode of
RTTY : baud := 0;
ASCII : baud := 5;
end;
set_rtty_baud;
sho_status;
end;
procedure new_rtty_shift;
begin
check_if_in_help;
shift := shift + 1;
if shift = 4 then shift := 0;
set_rtty_shift;
sho_status;
end;
procedure flip_invert;
begin
mod_rtty_invert;
sho_status;
end;
procedure change_speed;
var err, old_wpm: integer;
begin
check_if_in_help;
xmt_wpm := rcv_wpm;
val(xmt_wpm, int_wpm, err);
if err <> 0 then
begin
int_wpm := old_wpm;
str(int_wpm, xmt_wpm);
end;
kam_xmt_wpm;
sho_status;
end;
procedure set_speed;
begin
full_window;
check_if_in_help;
prompt_color;
{$I-}
repeat
gotoxy(5,status_line);
write(' <==');
gotoxy(6,status_line);
read(int_wpm);
until (IOresult = 0) AND (int_wpm > 4) and (int_wpm < 81);
str(int_wpm,xmt_wpm);
kam_xmt_wpm;
sho_status;
end;
procedure clear_transmit_screen;
begin
check_if_in_help;
window(1,out_start_line,80,out_end_line);
transmit_color; clrscr;
full_window;
xkbd := 1; ykbd := out_start_line;
attr_pos := ((80*(yout - 1) + xout) SHL 1) - 1;
halt_xmt;
end;
procedure clear_receive_screen;
begin
check_if_in_help;
window(1,inp_start_line,80,inp_end_line);
receive_color; clrscr;
xin := 1; yin := 1;
full_window;
end;
procedure clear_screen;
begin
check_if_in_help;
clear_receive_screen;
clear_transmit_screen;
sho_status;
full_window;
gotoxy(1,25); aux_color; ClrEol;
case mode of
CW :
write(' ^P pause AS % AR + <<< F1 for Help >>> BT = SK # KN ( ^T T/R ');
RTTY :
write(' ^P pause <<< F1 for Help >>> ^T T/R ');
ASCII :
write(' ^P pause <<< F1 for Help >>> ^T T/R ');
end;
reset_cursor;
end;
procedure msg_load;
var i : integer;
msgfile: text;
begin
check_if_in_help;
assign(msgfile,msg_file_name);
{$I-}
reset(msgfile);
{$I+}
if (IOresult = 0) then
begin
for i := 0 to 9 do
readln(msgfile,msg[i]);
close(msgfile);
end
else
begin
msg_file_name := '';
for i := 0 to 9 do
msg[i] := '';
end;
end;
procedure save_buffer;
label save_fault;
var i : integer;
rcv_file_name : file_type;
rcvfile: text;
begin
if state = transmit then halt_xmt;
check_if_in_help;
prompt_color;
get_file_name(rcv_file_name,
20,aux_line,'Receive',1,1,80,24,3);
if (rcv_file_name <> '') then
begin
assign(rcvfile,rcv_file_name);
{$I-}
rewrite(rcvfile);
if (IOresult = 0)
then
for i := 0 to $7FF do
begin
write(rcvfile,rcv_buffer[i]);
if (IOresult <> 0) then goto save_fault;
end
else
begin
gotoxy(20,aux_line); ClrEol;
write('ERROR');
delay(2000);
end;
save_fault:
close(rcvfile);
end;
sho_status;
end;
procedure view_modify_msgs;
var i : integer;
nbr, index : integer;
input_str : string[79];
nbr_chr : char;
begin
if state = transmit then halt_xmt;
check_if_in_help;
save_screen;
aux_color;
clrscr;
writeln('Contents of message file: ',msg_file_name);
writeln;
for i := 0 to 9 do
begin
writeln('Buffer # ',i:1);
writeln(msg[i]);
end;
repeat
gotoxy(1,24);
write('Modify message number <0..9><ESC> ... ',chr(8));
repeat
nbr_chr := readkey
until (nbr_chr in ['0'..'9',#27 ]);
if (nbr_chr in ['0'..'9']) then
begin
write(nbr_chr);
nbr := ord(nbr_chr) - $30;
gotoxy(1,4+2*nbr); ClrEol;
msg[nbr] := '';
readln(msg[nbr]);
msg[nbr][length(msg[nbr])+1] := null;
end;
until (nbr_chr = #27);
restore_screen;
end;
procedure load_messages;
begin
if state = transmit then halt_xmt;
check_if_in_help;
prompt_color;
get_file_name(msg_file_name,
20,aux_line,'Message',1,1,80,24,3);
if (msg_file_name <> '') then msg_load;
sho_status;
end;
procedure save_messages;
label save_fault;
var i : integer;
msgfile: text;
begin
if state = transmit then halt_xmt;
check_if_in_help;
prompt_color;
get_file_name(msg_file_name,
20,aux_line,'Dest',1,1,80,24,3);
if (msg_file_name <> '') then
begin
assign(msgfile,msg_file_name);
{$I-}
rewrite(msgfile);
if (IOresult = 0)
then
begin
for i := 0 to 9 do
begin
writeln(msgfile,msg[i]);
if (IOresult <> 0) then goto save_fault;
end;
save_fault:
close(msgfile);
end
else
begin
gotoxy(20,aux_line); ClrEol;
write('ERROR');
delay(2000);
end;
end;
sho_status;
end;
procedure exit_request;
begin
save_screen;
prompt_color;
frame(5,5,30,9);
window(6,6,29,8);
clrscr;
gotoxy(1,2);
write('Exit to DOS <Y/N> ..');
repeat key := readkey until key in ['y','n','Y','N'];
if key in ['y','Y'] then
quit_flag := true;
restore_screen;
end;