home *** CD-ROM | disk | FTP | other *** search
/ HAM Radio 1 / HamRadio.cdr / packet / kam300 / kam-xmt.pas < prev    next >
Pascal/Delphi Source File  |  1988-04-05  |  5KB  |  193 lines
  1. procedure send_ch(ch:char);
  2. var was_sent : char;
  3.     count : integer;
  4. begin
  5.   case mode of
  6.     CW : if (ch = #13) then ch := #32;
  7.     RTTY,ASCII : ;
  8.   end;
  9.   ch := UpCase(ch);
  10.   send_interrupt := FALSE;
  11.   kam_out(ch);
  12.   repeat
  13.     repeat
  14.       delay(10);
  15.       chk_kbd;
  16.     until (send_interrupt = TRUE) OR
  17.           (char_ready = TRUE)     OR
  18.           (state = receive);
  19.     if (char_ready = TRUE)
  20.     then was_sent := kam_in
  21.     else begin
  22.            was_sent := ch;
  23.            clear_buffer;
  24.          end;
  25.   until was_sent = ch;
  26.   if pause_flag then
  27.   begin
  28.     wait_for_key;
  29.     pause_flag := false;
  30.   end;
  31. end;
  32.  
  33. procedure send_char(ch: char);
  34. begin
  35.   attr_pos := 80*(yout - 1) + xout - 1;
  36.   if (attr_pos > lead_attr ) then
  37.     case vid_type of
  38.       0 : mono_screen[attr_pos].a := xmt_attrib;
  39.       1 : color_screen[attr_pos].a := xmt_attrib;
  40.     end;
  41.   xout := xout + 1;
  42.   if xout > scrn_width then
  43.   begin
  44.     xout := 1;
  45.     yout := yout + 1;
  46.   end;
  47.   attr_pos := 80*(yout - 1) + xout - 1;
  48.   if (yout in [out_start_line .. out_end_line]) then
  49.     case vid_type of
  50.       0 : mono_screen[attr_pos].a := status_attrib;
  51.       1 : color_screen[attr_pos].a := status_attrib;
  52.     end;
  53.   if (ch <> #13)
  54.     then send_ch(ch)
  55.     else if (last_char_sent <> #13)
  56.            then send_ch(ch);
  57.   if ch = #13 then
  58.   begin
  59.     attr_pos := 80*(yout - 1) + xout - 1;
  60.     if (attr_pos > lead_attr ) then
  61.     case vid_type of
  62.       0 : mono_screen[attr_pos].a := xmt_attrib;
  63.       1 : color_screen[attr_pos].a := xmt_attrib;
  64.     end;
  65.     yout := yout + 1;
  66.     xout := 0;
  67.   end;
  68.   last_char_sent := ch;
  69. end;
  70.  
  71. procedure send_file;
  72. label file_done,
  73.       send_read_error;
  74. var filename : file_type;
  75.     filespec : file;
  76.     recsread : integer;
  77.     filebuff : array[0..2047] of byte;
  78.     chr_pntr,nbr_chr : integer;
  79.     file_chr : char;
  80.  
  81.   procedure more_data;
  82.   var i : integer;
  83.   begin
  84.     blockread(filespec,filebuff,16,recsread);
  85.     if (recsread = 0) OR (IOresult <> 0)  then stop_flag := TRUE;
  86.     nbr_chr := 128*recsread-1;
  87.     chr_pntr := 0;
  88.   end;
  89.  
  90.   procedure next_char;
  91.   begin
  92.     chr_pntr := chr_pntr + 1;
  93.     if (chr_pntr > nbr_chr) then more_data;
  94.     chk_kbd;
  95.   end;
  96.  
  97. begin
  98.   file_mode := TRUE;
  99.   prompt_color;
  100.   get_file_name(filename,
  101.                 20,aux_line,'Text',1,1,80,24,3);
  102.   gotoxy(20,aux_line); aux_color; ClrEol;
  103.   write('FILE XMT MODE : ',filename);
  104.   if filename <> '' then
  105.   begin
  106.     assign(filespec,filename);
  107.     {$I-} reset(filespec);
  108.     if (IOresult <> 0) then goto send_read_error;
  109.     clear_transmit_screen;
  110.     state := transmit;
  111.     if (xmt_ON = FALSE) then xmt_mode;
  112.     stop_flag := FALSE;
  113.     repeat
  114.       more_data;
  115.       if (state = receive) then goto file_done;
  116.       repeat
  117.         file_chr := chr(filebuff[chr_pntr]);
  118.         if (state = receive) OR (file_chr = ^Z) then goto file_done;
  119.         if (file_chr in [#07,#13,' '..'z']) then
  120.         begin
  121.           add_char(file_chr);
  122.           send_char(file_chr);
  123.         end;
  124.         chr_pntr := chr_pntr + 1;
  125.         if (state = receive) then goto file_done;
  126.       until chr_pntr > nbr_chr;
  127.     until  state = receive;
  128. file_done:
  129.     close(filespec);
  130.   end;
  131. send_read_error:
  132.     {$I+}
  133.     file_mode := FALSE;
  134.     out_ptr := inp_ptr;
  135.     clean_up_display;
  136.     gotoxy(20,aux_line); aux_color; ClrEol;
  137.     sho_status;
  138. end;
  139.  
  140. procedure halt_xmt;
  141. begin
  142.   stop_flag := TRUE;
  143.   clean_up_display;
  144.   if (attr_pos > lead_attr ) then
  145.     case vid_type of
  146.       0 : mono_screen[attr_pos].a := xmt_attrib;
  147.       1 : color_screen[attr_pos].a := xmt_attrib;
  148.     end;
  149.   inp_ptr := out_ptr;
  150.   xout := xkbd - 1;
  151.   yout := ykbd;
  152.   clear_buffer;
  153.   rcv_mode;
  154.   state := receive;
  155.   sho_status;
  156. end;
  157.  
  158. procedure xmtg;
  159. begin
  160.   if (xmt_ON = FALSE) then
  161.   begin
  162.     xmt_mode;
  163.     sho_status;
  164.   end;
  165.   if (inp_ptr = out_ptr) AND (auto_switch = TRUE) then
  166.     begin
  167.       case mode of
  168.         CW  :  xmt_time_out := cw_off_delay;
  169.         ASCII,
  170.         RTTY : 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.