home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
cw
/
kam-car
/
kam-set.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-08-25
|
17KB
|
666 lines
procedure set_attributes;
begin
xmt_attrib := b_clr[0] SHL 4 + f_clr[0];
rcv_attrib := b_clr[1] SHL 4 + f_clr[1];
status_attrib := b_clr[2] SHL 4 + f_clr[2];
prompt_attrib := b_clr[3] SHL 4 + f_clr[3];
aux_attrib := b_clr[4] SHL 4 + f_clr[4];
help_attrib := b_clr[5] SHL 4 + f_clr[5];
end;
procedure mod_image;
var i : integer;
begin
set_attributes;
for i := 0 to 1999 do
begin
help_scr[i].a := help_attrib;
qsig_scr[i].a := help_attrib;
rst_scr[i].a := help_attrib;
end;
for i := 0 to 79 do image[i].a := status_attrib;
for i := 80*(out_start_line-1) to 80*out_end_line - 1 do
image[i].a := xmt_attrib;
for i := 80*(inp_start_line-1) to 80*inp_end_line - 1 do
image[i].a := rcv_attrib;
for i := 1840 to 1999 do image[i].a := aux_attrib;
lead_attr := 80*(out_start_line - 1) - 1;
end;
procedure load_init(file_name: file_type);
var init_file : text;
dummy : string[20];
flag : integer;
begin
assign(init_file, file_name);
{$I-}
reset(init_file);
if (IOresult = 0) then
begin
read(init_file,dummy); readln(init_file, b_clr[0]);
read(init_file,dummy); readln(init_file, f_clr[0]);
read(init_file,dummy); readln(init_file, b_clr[1]);
read(init_file,dummy); readln(init_file, f_clr[1]);
read(init_file,dummy); readln(init_file, b_clr[2]);
read(init_file,dummy); readln(init_file, f_clr[2]);
read(init_file,dummy); readln(init_file, b_clr[3]);
read(init_file,dummy); readln(init_file, f_clr[3]);
read(init_file,dummy); readln(init_file, b_clr[4]);
read(init_file,dummy); readln(init_file, f_clr[4]);
read(init_file,dummy); readln(init_file, b_clr[5]);
read(init_file,dummy); readln(init_file, f_clr[5]);
read(init_file,dummy); readln(init_file, status_line);
read(init_file,dummy); readln(init_file, inp_start_line);
read(init_file,dummy); readln(init_file, inp_end_line);
read(init_file,dummy); readln(init_file, aux_line);
read(init_file,dummy); readln(init_file, out_start_line);
read(init_file,dummy); readln(init_file, out_end_line);
read(init_file,dummy); readln(init_file, xmt_port);
read(init_file,dummy); readln(init_file, kam_baud_rate);
read(init_file,dummy); readln(init_file, packet_mark);
read(init_file,dummy); readln(init_file, packet_space);
read(init_file,dummy); readln(init_file, int_wpm);
read(init_file,dummy); readln(init_file, cw_off_delay);
read(init_file,dummy); readln(init_file, xmt_on_delay);
read(init_file,dummy); readln(init_file, xmt_off_delay);
read(init_file,dummy); readln(init_file, time_zone);
read(init_file,dummy); readln(init_file, msg_file_0);
read(init_file,dummy); readln(init_file, kam_log_file);
read(init_file,dummy); readln(init_file, SW_HF);
read(init_file,dummy); readln(init_file, SW_VHF);
close(init_file);
end;
end;
procedure load_config;
var file_name : file_type;
i : integer;
begin
halt_xmt;
save_screen;
aux_color;
clrscr;
file_name := 'KAM.CFG';
Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
SayGet(20,aux_line,'Config File (or ?) ',file_name,_S,24,1);
WatchKeys := ['?'];
ReadGets;
if LastKey = '?' then file_name := PickFile('*.CFG');
load_init(file_name);
set_date_time;
mod_image;
end;
procedure get_init;
var i : integer;
imagefile : file of screen;
anykey : char;
begin
b_clr[0] := clr_xmt_b; f_clr[0] := clr_xmt_f;
b_clr[1] := clr_rcv_b; f_clr[1] := clr_rcv_f;
b_clr[2] := clr_sts_b; f_clr[2] := clr_sts_f;
b_clr[3] := clr_prm_b; f_clr[3] := clr_prm_f;
b_clr[4] := clr_aux_b; f_clr[4] := clr_aux_f;
b_clr[5] := clr_hlp_b; f_clr[5] := clr_hlp_f;
status_line := 17;
inp_start_line := 1;
inp_end_line := 16;
aux_line := 24;
out_start_line := 18;
out_end_line := 23;
xmt_port := 1;
kam_baud_rate := 1200;
packet_mark := '1600';
packet_space := '1800';
int_wpm := nominal_xmt_wpm;
cw_off_delay := 2;
xmt_on_delay := 5;
xmt_off_delay := 50;
time_zone := nominal_time_zone;
msg_file_0 := nominal_msg_file;
kam_log_file := 'HAMLOG';
SW_HF := '$';
SW_VHF := '%';
load_init('KAM.CFG');
str(int_wpm,xmt_wpm);
if (msg_file_0 <> 'NIL') then
begin
msg_file_name := msg_file_0;
msg_load;
end
else
begin
msg_file_name := '';
for i := 0 to 9 do msg[i] := '';
end;
assign(imagefile,'KAM.IMG');
{$I-}
ReSet(imagefile);
if (IOresult = 0)
then
begin
Read(imagefile, help_scr);
Read(imagefile, qsig_scr);
Read(imagefile, rst_scr);
Read(imagefile, param_scr);
Close(imagefile);
mod_image;
end
else
begin
textcolor(15);
textbackground(0);
clrscr;
writeln('File KAM.IMG must be on default disk & in default directory.');
delay (5000);
halt;
end;
end;
procedure save_init;
var init_file : text;
init_name : file_type;
flag : integer;
begin
init_name := 'KAM.CFG';
Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
SayGet(20,aux_line,'Config File (or ?) ',init_name,_S,24,1);
WatchKeys := ['?'];
ReadGets;
if LastKey = '?' then init_name := PickFile('*.*');
gotoxy(5,24); write(' ');
gotoxy(5,24); write('Writing File ',init_name);
assign(init_file,init_name);
{$I-}
rewrite(init_file);
if (IOresult = 0) then
begin
write(init_file,'Xmt background .....');
writeln(init_file,b_clr[0]:5);
write(init_file,'Xmt foreground .....');
writeln(init_file,f_clr[0]:5);
write(init_file,'Rcv background .....');
writeln(init_file,b_clr[1]:5);
write(init_file,'Rcv foreground .....');
writeln(init_file,f_clr[1]:5);
write(init_file,'Status background ..');
writeln(init_file,b_clr[2]:5);
write(init_file,'Status foreground ..');
writeln(init_file,f_clr[2]:5);
write(init_file,'Prompt background ..');
writeln(init_file,b_clr[3]:5);
write(init_file,'Prompt foreground ..');
writeln(init_file,f_clr[3]:5);
write(init_file,'Aux background .....');
writeln(init_file,b_clr[4]:5);
write(init_file,'Aux foreground .....');
writeln(init_file,f_clr[4]:5);
write(init_file,'Help background ....');
writeln(init_file,b_clr[5]:5);
write(init_file,'Help foreground ....');
writeln(init_file,f_clr[5]:5);
write(init_file,'Status_line ........');
writeln(init_file,status_line:5);
write(init_file,'Rcv_start_line .....');
writeln(init_file,inp_start_line:5);
write(init_file,'Rcv_end_line .......');
writeln(init_file,inp_end_line:5);
write(init_file,'Aux_line ...........');
writeln(init_file,aux_line:5);
write(init_file,'Xmt_start_line .....');
writeln(init_file,out_start_line:5);
write(init_file,'Xmt_end_line .......');
writeln(init_file,out_end_line:5);
write(init_file,'Transmit port ......');
writeln(init_file,xmt_port:5);
write(init_file,'Interface baud rate.');
writeln(init_file,kam_baud_rate:5);
write(init_file,'Packet MARK freq....');
writeln(init_file,packet_mark);
write(init_file,'Packet SPACE freq...');
writeln(init_file,packet_space);
write(init_file,'CW Xmt WPM .........');
writeln(init_file,int_wpm:5);
write(init_file,'CW turn-off delay...');
writeln(init_file,cw_off_delay:5);;
write(init_file,'Xmt turn-on delay...');
writeln(init_file,xmt_on_delay:5);
write(init_file,'Xmt turn-off delay..');
writeln(init_file,xmt_off_delay:5);
write(init_file,'Time Zone ..........');
writeln(init_file,time_zone:5);
write(init_file,'Initial msg file ...');
writeln(init_file,msg_file_0);
write(init_file,'Log Path/File.......');
writeln(init_file,kam_log_file);
write(init_file,'HF switch char .....');
writeln(init_file,SW_HF);
write(init_file,'VHF switch char ....');
writeln(init_file,SW_VHF);
end;
close(init_file);
end;
procedure set_color(i:integer);
var vidpos, attrbyte, n : integer;
begin
case i of
0 : vidpos := 332;
1 : vidpos := 492;
2 : vidpos := 652;
3 : vidpos := 812;
4 : vidpos := 972;
5 : vidpos := 1132;
end;
attrbyte := b_clr[i] SHL 4 + f_clr[i];
for i := 0 to 8 do
video^[vidpos + i].a := attrbyte;
end;
procedure set_new_color(which, clrkey : char);
var clr : integer;
begin
clr := ord(which)-ord('A');
case clrkey of
#72 : b_clr[clr] := (b_clr[clr] + 1) MOD 8;
#80 : begin
b_clr[clr] := b_clr[clr] - 1;
if (b_clr[clr] < 0) then b_clr[clr] := 7;
end;
#77 : f_clr[clr] := (f_clr[clr] + 1) MOD 16;
#75 : begin
f_clr[clr] := f_clr[clr] - 1;
if (f_clr[clr] < 0) then f_clr[clr] := 15;
end;
end;
set_color(clr);
end;
procedure new_color(which : char);
var clrkey: char;
begin
write(' ',#17,' ',#16,' forgnd, ',#30,' ',#31,' bckgnd ..');
repeat
clrkey := readkey;
if (clrkey = #0) then
begin
clrkey := readkey;
set_new_color(which,clrkey);
end;
until clrkey = #27;
end;
procedure sho_xmt_space;
begin
gotoxy(36,5); write(out_start_line:2);
gotoxy(44,5); write(out_end_line:2);
end;
procedure sho_rcv_space;
begin
gotoxy(36,7); write(inp_start_line:2);
gotoxy(44,7); write(inp_end_line:2);
end;
procedure sho_status_line;
begin
gotoxy(36,9); write(status_line:2);
end;
procedure sho_aux_line;
begin
gotoxy(36,13); write(aux_line:2);
end;
procedure sho_comms_port;
begin
gotoxy(74,5);
case xmt_port of
1 : write('COM1');
2 : write('COM2');
end;
end;
procedure sho_comms_baud_rate;
begin
gotoxy(74,7);
write(kam_baud_rate:4);
end;
procedure sho_CW_WPM;
begin
gotoxy(74,9);
write(int_wpm : 2);
end;
procedure sho_CW_off_delay;
begin
gotoxy(74,11);
write(cw_off_delay : 2);
end;
procedure sho_RTTY_on_delay;
begin
gotoxy(74,13);
write(xmt_on_delay:2);
end;
procedure sho_RTTY_off_delay;
begin
gotoxy(74,15);
write(xmt_off_delay:2);
end;
procedure sho_time_zone;
begin
gotoxy(26,17);
write(time_zone:3);
end;
procedure sho_default_msg_file;
begin
gotoxy(58,17);
write(msg_file_0);
end;
procedure sho_kam_log_file;
begin
gotoxy(43,19);
write(' ');
gotoxy(43,19);
write(kam_log_file);
end;
procedure param_screen;
var i : integer;
begin
DisplayPage(@param_scr);
for i := 0 to 5 do
set_color(i);
textcolor(15);
textbackground(0);
sho_xmt_space;
sho_rcv_space;
sho_status_line;
sho_aux_line;
sho_comms_port;
sho_comms_baud_rate;
sho_CW_WPM;
sho_CW_off_delay;
sho_RTTY_on_delay;
sho_RTTY_off_delay;
sho_time_zone;
sho_default_msg_file;
sho_kam_log_file;
end;
procedure clear_select_line;
begin
gotoxy(5,21);
Write(' ');
gotoxy(5,21);
end;
function select: char;
var ok : boolean;
begin
clear_select_line;
write('<ESC> done ... Select Parameter...');
repeat
repeat
key := readkey;
until key in [#0,#27,'A'..'U','a'..'v'];
if keypressed
then
begin
key := readkey;
ok := FALSE;
end
else
ok := TRUE;
until ok;
if key <> #27 then write(UpCase(key));
select := UpCase(key);
end;
procedure xmt_space;
begin
repeat
{$I-}
clear_select_line;
write('Transmit start line : ');
read(out_start_line);
until (IOresult = 0);
sho_xmt_space;
repeat
{$I-}
clear_select_line;
write('Transmit end line : ');
read(out_end_line);
until (IOresult = 0);
sho_xmt_space;
end;
procedure rcv_space;
begin
repeat
{$I-}
clear_select_line;
write('Receive start line : ');
read(inp_start_line);
until (IOresult = 0);
sho_rcv_space;
repeat
{$I-}
clear_select_line;
write('Receive end line : ');
read(inp_end_line);
until (IOresult = 0);
sho_rcv_space;
end;
procedure status_space;
begin
repeat
{$I-}
clear_select_line;
write('Status line : ');
read(status_line);
until (IOresult = 0);
sho_status_line;
end;
procedure aux_space;
begin
repeat
{$I-}
clear_select_line;
write('Auxiliary line : ');
read(aux_line);
until (IOresult = 0);
sho_aux_line;
end;
procedure set_comms_port;
begin
case xmt_port of
1 : xmt_port := 2;
2 : xmt_port := 1;
end;
sho_comms_port;
end;
procedure set_comms_baud_rate;
begin
case kam_baud_rate of
110 : kam_baud_rate := 150;
150 : kam_baud_rate := 300;
300 : kam_baud_rate := 600;
600 : kam_baud_rate := 1200;
1200 : kam_baud_rate := 2400;
2400 : kam_baud_rate := 4800;
4800 : kam_baud_rate := 9600;
9600 : kam_baud_rate := 110;
end;
sho_comms_baud_rate;
end;
procedure set_CW_WPM;
begin
repeat
{$I-}
clear_select_line;
write('Initial CW WPM [5..80] : ');
readln(int_wpm);
until (IOresult = 0) AND (int_wpm in [5..80]);
sho_CW_WPM;
end;
procedure set_CW_off_delay;
begin
repeat
{$I-}
clear_select_line;
write('CW automatic turn-off delay (1/10s of secs) [1..25] : ');
readln(cw_off_delay);
until (IOresult = 0) AND (cw_off_delay in [1..25]);
sho_CW_off_delay;
end;
procedure set_RTTY_on_delay;
begin
repeat
{$I-}
clear_select_line;
write('RTTY automatic turn-on delay (1/10s of secs) [1..10] : ');
readln(xmt_on_delay);
until (IOresult = 0) AND (xmt_on_delay in [1..10]);
sho_RTTY_on_delay;
end;
procedure set_RTTY_off_delay;
begin
repeat
{$I-}
clear_select_line;
write('RTTY automatic turn-off delay (1/10s of secs) [1..50] : ');
readln(xmt_off_delay);
until (IOresult = 0) AND (xmt_off_delay in [1..50]);
sho_RTTY_off_delay;
end;
procedure set_time_zone;
begin
repeat
{$I-}
clear_select_line;
write('Local Time Zone [-11..+11] : ');
readln(time_zone);
until (IOresult = 0) AND (abs(time_zone) in [ 0..11 ]);
sho_time_zone;
end;
procedure set_default_msg_file;
begin
clear_select_line;
write('On program startup read line buffers from : ');
readln(msg_file_0);
sho_default_msg_file;
end;
procedure set_default_kam_log;
begin
clear_select_line;
write('Default LOG File : ');
readln(kam_log_file);
sho_kam_log_file;
end;
procedure set_parameters;
var param : char;
begin
halt_xmt;
save_screen;
param_screen;
repeat
param := select;
case param of
'A'..'F' : new_color(param);
'G' : xmt_space;
'H' : rcv_space;
'I' : status_space;
'J' : aux_space;
'K' : set_comms_port;
'L' : set_comms_baud_rate;
'M' : set_CW_WPM;
'N' : set_CW_off_delay;
'O' : set_RTTY_on_delay;
'P' : set_RTTY_off_delay;
'Q' : set_time_zone;
'R' : set_default_msg_file;
'S' : set_default_kam_log;
end;
until param = #27;
clear_select_line;
write('Save to Disk <Y/N> ...');
repeat key := readkey until key in ['y','Y','n','N'];
if key in ['y','Y'] then save_init;
set_date_time;
mod_image;
restore_screen;
clear_screen;
end;
procedure initialize;
VAR i : integer;
fillstring : string;
begin
textcolor(video^[1999].a AND $0F);
textbackground((video^[1999].a SHR 4) AND $0F);
viewing_help := FALSE;
clrscr;
writeln('======================== KAM-CAR ===========================');
writeln('Kantronics (tm) All Mode CW/ASCII/RTTY Terminal Program ',version:4);
writeln('Courtesy: Dave Freese, W1HKJ');
writeln(' 29 N. Ravenwood Drive');
writeln(' Cape May Court House, NJ 08210');
writeln(' (609) 624 0076');
writeln;
get_init;
baud := 0;
shift := 0;
set_date_time;
key := null;
old_time := ' ';
xmt_ON := FALSE;
pause_flag := FALSE;
stop_flag := FALSE;
quit_flag := FALSE;
invert := FALSE;
capture := FALSE;
auto_switch := FALSE;
kbd_buffer[0] := null;
kbd_buffer[1] := null;
inp_ptr := 0;
out_ptr := 0;
qso_nbr := 0;
station := '';
PKCall := '';
for i := 0 to max_rcv_buffers do
new(rcv_buffer[i]);
fillstring := REPLICATE(' ',80);
for i := 0 to max_rcv_buffers do
rcv_buffer[i]^ := fillstring;
init_rcv_buffers;
init_interface;
window(1,1,25,80);
InitializeDataBase;
WHERE := '';
end;