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(' 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 ...'); 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;