home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / misc / kam401 / kam-xmt.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1989-08-25  |  4.6 KB  |  193 lines
  1. procedure send_ch(ch:char);
  2. var was_sent : char;
  3.     count : integer;
  4. begin
  5.   if (mode = CW) AND (ch = #13) then ch := #32;
  6.   if (mode = CW) OR (mode = RTTY) OR (mode = AMTOR)
  7.     then ch := UpCase(ch);
  8.   send_interrupt := FALSE;
  9.   kam_out(ch);
  10.   COUNT := TIMEOUT;
  11.   repeat
  12.     repeat
  13.       delay(10);
  14.       chk_kbd;
  15.       DEC(COUNT);
  16.     until (send_interrupt = TRUE) OR
  17.           (char_ready = TRUE)     OR
  18.           (COUNT = 0)             OR
  19.           (state = receive);
  20.     if (char_ready = TRUE)
  21.       then was_sent := kam_in
  22.       else was_sent := ch;
  23.   until was_sent = ch;
  24. end;
  25.  
  26. procedure send_char(ch: char);
  27. begin
  28.   attr_pos := 80*(yout - 1) + xout - 1;
  29.   if (attr_pos > lead_attr ) then
  30.     video^[attr_pos].a := xmt_attrib;
  31.   xout := xout + 1;
  32.   if xout > scrn_width then
  33.   begin
  34.     xout := 1;
  35.     yout := yout + 1;
  36.   end;
  37.   attr_pos := 80*(yout - 1) + xout - 1;
  38.   if (yout in [out_start_line .. out_end_line]) then
  39.     video^[attr_pos].a := status_attrib;
  40.   if (ch <> #13)
  41.     then send_ch(ch)
  42.     else if ((mode = PACKET) OR
  43.              (mode = RTTY) OR
  44.              (mode = AMTOR) )
  45.            then send_ch(ch);
  46.   if ch = #13 then
  47.   begin
  48.     attr_pos := 80*(yout - 1) + xout - 1;
  49.     if (attr_pos > lead_attr ) then
  50.       video^[attr_pos].a := xmt_attrib;
  51.     yout := yout + 1;
  52.     xout := 0;
  53.   end;
  54. end;
  55.  
  56. procedure send_file;
  57. label  file_done;
  58. var filename : string;
  59.     filespec : file of byte;
  60.     filebuff : array[1..2048] of byte;
  61.     chr_pntr,nbr_chr : integer;
  62.     file_chr : char;
  63.     Escape : boolean;
  64.     anykey,EscKey : char;
  65.     diskIOresult : integer;
  66.  
  67.   procedure more_data;
  68.   begin
  69.     nbr_chr := 0;
  70.     while (NOT Eof(filespec) AND (nbr_chr < 2048)) do
  71.     begin
  72.       inc(nbr_chr);
  73.       read(filespec,filebuff[nbr_chr]);
  74.     end;
  75.     chr_pntr := 0;
  76.   end;
  77.  
  78.   procedure next_char;
  79.   begin
  80.     chr_pntr := chr_pntr + 1;
  81.     if (chr_pntr > nbr_chr) then more_data;
  82.     if keypressed then EscKey := readkey;
  83.     if EscKey = #27 then
  84.       if keypressed then EscKey := readkey
  85.                     else Escape := TRUE;
  86.   end;
  87.  
  88. begin
  89.   Escape := FALSE;
  90.   stop_flag := FALSE;
  91.   EscKey := ' ';
  92.   filename := '';
  93.   Set_PickWindow_To(10,5,25,22,SingleLine,'Files');
  94.   SayGet(25,aux_line,'Text File (or ?) ',filename,_S,24,1);
  95.   WatchKeys := ['?'];
  96.   ReadGets;
  97.   if LastKey = '?' then filename := PickFile('*.*');
  98.   gotoxy(25,aux_line); aux_color; ClrEol;
  99.   if filename <> '' then
  100.   begin
  101.     write('FILE XMT : ',filename,'   <ESC> to abort');
  102.     assign(filespec,filename);
  103.     {$I-}
  104.     reset(filespec);
  105.     diskIOresult := IOresult;
  106.     {$I+}
  107.     if (diskIOresult > 1)
  108.     then begin
  109.         gotoxy(25,aux_line); aux_color; ClrEol;
  110.         write('File I/O Error ',filename);
  111.         delay(3000);
  112.       end
  113.     else
  114.     repeat
  115.       more_data;
  116.       if (Escape = TRUE) OR (nbr_chr = 0)
  117.         then goto file_done;
  118.       repeat
  119.         inc(chr_pntr);
  120.         file_chr := chr(filebuff[chr_pntr]);
  121.         if (Escape = TRUE) OR (file_chr = ^Z) then goto file_done;
  122.         if (file_chr in [#07,#13,' '..'z']) then
  123.         begin
  124.           add_char(file_chr);
  125.           out_ptr := (out_ptr + 1) AND buf_size;
  126.           send_char(kbd_buffer[out_ptr]);
  127.         end;
  128.         if (Escape = TRUE) then goto file_done;
  129.       until chr_pntr = nbr_chr;
  130.     until  Escape = TRUE;
  131. file_done:
  132.     close(filespec);
  133.   end;
  134.   gotoxy(25,aux_line); aux_color; ClrEol;
  135. end;
  136.  
  137. procedure halt_xmt;
  138. begin
  139.   stop_flag := TRUE;
  140.   clean_up_display;
  141.   if (attr_pos > lead_attr ) then
  142.     video^[attr_pos].a := xmt_attrib;
  143.   inp_ptr := out_ptr;
  144.   xout := xkbd - 1;
  145.   yout := ykbd;
  146. { clear_buffer; }
  147.   rcv_mode;
  148.   case state of
  149.     transmit : state := receive;
  150.     transceive : ;
  151.   end;
  152.   sho_status;
  153. end;
  154.  
  155. procedure xmtg;
  156. begin
  157.   if (xmt_ON = FALSE) then
  158.     if mode in [CW,RTTY,ASCII] then
  159.     begin
  160.       xmt_mode;
  161.       sho_status;
  162.     end;
  163.   if (inp_ptr = out_ptr) AND (auto_switch = TRUE) then
  164.     begin
  165.       case mode of
  166.         CW     :  xmt_time_out := cw_off_delay;
  167.         AMTOR,
  168.         ASCII,
  169.         RTTY,
  170.         PACKET : xmt_time_out := xmt_off_delay;
  171.       end;
  172.       while (   (xmt_time_out > 0)
  173.             AND (out_ptr = inp_ptr)
  174.             AND (send_INTERRUPT = FALSE) ) do
  175.         begin
  176.           delay(100);
  177.           xmt_time_out := xmt_time_out - 1;
  178.           chk_kbd;
  179.         end;
  180.       if (out_ptr = inp_ptr) then
  181.       begin
  182.         halt_xmt;
  183.         exit;
  184.       end;
  185.     end;
  186.   if (out_ptr <> inp_ptr) then
  187.   begin
  188.     out_ptr := (out_ptr + 1) AND buf_size;
  189.     send_char(kbd_buffer[out_ptr]);
  190.   end;
  191. end;
  192.  
  193.