home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HAM Radio 1
/
HamRadio.cdr
/
misc
/
kam401
/
kam-xmt.pas
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-08-25
|
5KB
|
193 lines
procedure send_ch(ch:char);
var was_sent : char;
count : integer;
begin
if (mode = CW) AND (ch = #13) then ch := #32;
if (mode = CW) OR (mode = RTTY) OR (mode = AMTOR)
then ch := UpCase(ch);
send_interrupt := FALSE;
kam_out(ch);
COUNT := TIMEOUT;
repeat
repeat
delay(10);
chk_kbd;
DEC(COUNT);
until (send_interrupt = TRUE) OR
(char_ready = TRUE) OR
(COUNT = 0) OR
(state = receive);
if (char_ready = TRUE)
then was_sent := kam_in
else was_sent := ch;
until was_sent = ch;
end;
procedure send_char(ch: char);
begin
attr_pos := 80*(yout - 1) + xout - 1;
if (attr_pos > lead_attr ) then
video^[attr_pos].a := xmt_attrib;
xout := xout + 1;
if xout > scrn_width then
begin
xout := 1;
yout := yout + 1;
end;
attr_pos := 80*(yout - 1) + xout - 1;
if (yout in [out_start_line .. out_end_line]) then
video^[attr_pos].a := status_attrib;
if (ch <> #13)
then send_ch(ch)
else if ((mode = PACKET) OR
(mode = RTTY) OR
(mode = AMTOR) )
then send_ch(ch);
if ch = #13 then
begin
attr_pos := 80*(yout - 1) + xout - 1;
if (attr_pos > lead_attr ) then
video^[attr_pos].a := xmt_attrib;
yout := yout + 1;
xout := 0;
end;
end;
procedure send_file;
label file_done;
var filename : string;
filespec : file of byte;
filebuff : array[1..2048] of byte;
chr_pntr,nbr_chr : integer;
file_chr : char;
Escape : boolean;
anykey,EscKey : char;
diskIOresult : integer;
procedure more_data;
begin
nbr_chr := 0;
while (NOT Eof(filespec) AND (nbr_chr < 2048)) do
begin
inc(nbr_chr);
read(filespec,filebuff[nbr_chr]);
end;
chr_pntr := 0;
end;
procedure next_char;
begin
chr_pntr := chr_pntr + 1;
if (chr_pntr > nbr_chr) then more_data;
if keypressed then EscKey := readkey;
if EscKey = #27 then
if keypressed then EscKey := readkey
else Escape := TRUE;
end;
begin
Escape := FALSE;
stop_flag := FALSE;
EscKey := ' ';
filename := '';
Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
SayGet(25,aux_line,'Text File (or ?) ',filename,_S,24,1);
WatchKeys := ['?'];
ReadGets;
if LastKey = '?' then filename := PickFile('*.*');
gotoxy(25,aux_line); aux_color; ClrEol;
if filename <> '' then
begin
write('FILE XMT : ',filename,' <ESC> to abort');
assign(filespec,filename);
{$I-}
reset(filespec);
diskIOresult := IOresult;
{$I+}
if (diskIOresult > 1)
then begin
gotoxy(25,aux_line); aux_color; ClrEol;
write('File I/O Error ',filename);
delay(3000);
end
else
repeat
more_data;
if (Escape = TRUE) OR (nbr_chr = 0)
then goto file_done;
repeat
inc(chr_pntr);
file_chr := chr(filebuff[chr_pntr]);
if (Escape = TRUE) OR (file_chr = ^Z) then goto file_done;
if (file_chr in [#07,#13,' '..'z']) then
begin
add_char(file_chr);
out_ptr := (out_ptr + 1) AND buf_size;
send_char(kbd_buffer[out_ptr]);
end;
if (Escape = TRUE) then goto file_done;
until chr_pntr = nbr_chr;
until Escape = TRUE;
file_done:
close(filespec);
end;
gotoxy(25,aux_line); aux_color; ClrEol;
end;
procedure halt_xmt;
begin
stop_flag := TRUE;
clean_up_display;
if (attr_pos > lead_attr ) then
video^[attr_pos].a := xmt_attrib;
inp_ptr := out_ptr;
xout := xkbd - 1;
yout := ykbd;
{ clear_buffer; }
rcv_mode;
case state of
transmit : state := receive;
transceive : ;
end;
sho_status;
end;
procedure xmtg;
begin
if (xmt_ON = FALSE) then
if mode in [CW,RTTY,ASCII] then
begin
xmt_mode;
sho_status;
end;
if (inp_ptr = out_ptr) AND (auto_switch = TRUE) then
begin
case mode of
CW : xmt_time_out := cw_off_delay;
AMTOR,
ASCII,
RTTY,
PACKET : xmt_time_out := xmt_off_delay;
end;
while ( (xmt_time_out > 0)
AND (out_ptr = inp_ptr)
AND (send_INTERRUPT = FALSE) ) do
begin
delay(100);
xmt_time_out := xmt_time_out - 1;
chk_kbd;
end;
if (out_ptr = inp_ptr) then
begin
halt_xmt;
exit;
end;
end;
if (out_ptr <> inp_ptr) then
begin
out_ptr := (out_ptr + 1) AND buf_size;
send_char(kbd_buffer[out_ptr]);
end;
end;