home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / cpm / turbopas / comdemo.ark / COMDEMO.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1986-08-24  |  6.2 KB  |  265 lines
  1. (* Rev 1 - re-shuffled control-\ commands to make room for BREAK B.E. *)
  2. type
  3.  string20 = string[20];
  4.  string80= string[80];
  5.  
  6. const
  7.  revision = 1;
  8.  maxbuffer = 32767;
  9.  cr = ^m^j;
  10.  online_msg = '*** Connected to remote port ***'^m^j;
  11.  offline_msg = '*** At micro ***'^m^j;
  12.  escape_char = ^\;
  13.  
  14. var
  15.  abort, logging, file_open, connect_end : boolean;
  16.  initport : string[10];
  17.  line_buffer : string[100];
  18.  buffer : array[0..maxbuffer] of char;
  19.  bufptr, cr_delay : integer;
  20.  file_var : text;
  21.  filename : string[20];
  22.  previous_char : char;
  23.  
  24. {$I commlib.inc}
  25.  
  26. procedure menu;
  27.  begin
  28.   writeln;
  29.   write(offline_msg);
  30.   writeln('Current port is ',c_port_str[c_current_port]);
  31.   writeln('Current baud rate is ', c_baud_str[c_current_baud]);
  32.   writeln('Current parity is ', c_parity_str[c_current_parity]);
  33.   writeln;
  34.   Writeln('^\-B - Transmit BREAK.');
  35.   writeln('^\-D - Set delay after carriage return');
  36.   writeln('^\-E - Exit program.');
  37.   writeln('^\-G - Get (receive) a file.');
  38.   writeln('^\-H - Menu.');
  39.   writeln('^\-P - Set port.');
  40.   writeln('^\-Q - Exit program.');
  41.   writeln('^\-R - Set baud Rate.');
  42.   writeln('^\-S - Send a file.');
  43.   writeln('^\-W - Write buffer and close file.');
  44.   write(online_msg);
  45.  end;
  46.  
  47.  procedure close_file;
  48.   var
  49.    count : integer;
  50.   begin
  51.    if file_open and (bufptr > 0) then
  52.     begin
  53.      for count := 0 to bufptr - 1 do
  54.       write(file_var,buffer[count]);
  55.      close(file_var);
  56.      file_open := false;
  57.     end;
  58.    logging := false;
  59.    bufptr := 0;
  60.   end;
  61.  
  62.  procedure writescr(message : string80);
  63.   var
  64.    count : integer;
  65.   begin
  66.    for count := 1 to length(message) do
  67.     c_put_scr_char(message[count]);
  68.   end;
  69.  
  70.  procedure set_port;
  71.  
  72.   var count, port : integer;
  73.  
  74.   begin
  75.    writescr(cr);
  76.    writescr(offline_msg);
  77.    writeln;
  78.    writeln('Current port is ',c_port_str[c_current_port]);
  79.    writeln('Possible ports are:');
  80.    count := 1;
  81.    while c_port_str[count] <> '' do
  82.     begin
  83.      writeln(count, ' - ',c_port_str[count]);
  84.       count := count + 1;
  85.     end;
  86.    write('Type the number of the desired port: ');
  87.    readln(port);
  88.    if c_set_port(port) then
  89.     writeln('Port set to: ',c_port_str[c_current_port])
  90.    else
  91.     writeln('Invalid port select, port remains ', c_port_str[c_current_port]);
  92.    writescr(cr);
  93.    writescr(online_msg);
  94.   end;
  95.  
  96.  procedure set_baud;
  97.  
  98.   var count, baud : integer;
  99.  
  100.   begin
  101.    writescr(offline_msg);
  102.    writeln;
  103.    writeln('Current baud rate is ',c_baud_str[c_current_baud]);
  104.    writeln('Possible baud rates are:');
  105.    count := 1;
  106.    while c_baud_str[count] <> '' do
  107.     begin
  108.      writeln(count, ' - ',c_baud_str[count]);
  109.       count := count + 1;
  110.     end;
  111.    write('Type the number of the desired baud rate: ');
  112.    readln(baud);
  113.    if c_set_baud(baud) then
  114.     writeln('Baud rate set to: ',c_baud_str[c_current_baud])
  115.    else
  116.     begin
  117.      write('Invalid baud rate select, baud rate remains ');
  118.      writeln(c_baud_str[c_current_baud]);
  119.     end;
  120.    writescr(online_msg);
  121.   end;
  122.  
  123.  procedure send;
  124.   var
  125.    count : integer;
  126.    line : string[100];
  127.   begin
  128.    writescr(offline_msg);
  129.    writescr('Filename to send: ');
  130.    readln(filename);
  131.    assign(file_var, filename);
  132.    {$i-} reset(file_var); {$i+}
  133.    if ioresult = 0 then
  134.     begin
  135.      file_open := true;
  136.      bufptr := 1;
  137.       while (not eof(file_var)) and (not c_get_kbd_char) do
  138.        begin
  139.         read(file_var,line);
  140.          for count := 1 to  length(line) do
  141.           begin
  142.            c_put_comm_char(line[count]);
  143.            while c_get_comm_char do
  144.            c_put_scr_char(c_comm_char);
  145.           end;
  146.            c_put_comm_char(^m);
  147.            for count := 0 to (10 * cr_delay) do
  148.             while c_get_comm_char do
  149.              c_put_scr_char(c_comm_char);
  150.            readln(file_var);
  151.        end;
  152.     end
  153.    else
  154.     writescr('File not found'^m^j);
  155.    if file_open then
  156.     begin
  157.      close(file_var);
  158.      file_open := false;
  159.     end;
  160.    writescr(online_msg);
  161.   end;
  162.  
  163.  procedure receive;
  164.   var
  165.    count : integer;
  166.    filename : string[20];
  167.    open_ok,connect_end : boolean;
  168.  
  169.   begin
  170.    writescr(offline_msg);
  171.    write('Filename: ');
  172.    readln(filename);
  173.    assign(file_var,filename);
  174.    {$I-}
  175.    rewrite(file_var);
  176.    {$I+}
  177.    if ioresult <> 0 then
  178.     writeln('File could not be opened!')
  179.    else
  180.     begin
  181.      file_open := true;
  182.      bufptr := 0;
  183.      logging := true;
  184.     end;
  185.    writescr(online_msg);
  186.   end;
  187.  
  188.  procedure set_delay;
  189.  
  190.   begin
  191.    writescr(offline_msg);
  192.    write('Current delay value is: ',cr_delay,'. Enter new value: ');
  193.    readln(cr_delay);
  194.    writescr(online_msg);
  195.   end;
  196.  
  197.  procedure connect;
  198.   begin
  199.    menu;
  200.    connect_end := false;
  201.    previous_char := ' ';
  202.    repeat
  203.     if c_get_kbd_char then
  204.      begin
  205.       if (previous_char = escape_char) or (c_kbd_char = escape_char) then
  206.         begin
  207.          case chr(ord(c_kbd_char) and $9f) of
  208.           ^b : if NOT c_send_break then writeln('** BREAK not implemented **');
  209.           ^d : set_delay;
  210.           ^g : receive;
  211.           ^h : menu;
  212.           ^p : set_port;
  213.           ^s : send;
  214.           ^r : set_baud;
  215.           ^q,^e : begin
  216.                    close_file;
  217.                    abort := c_reset;
  218.                    halt;
  219.                   end;
  220.           ^w : close_file;
  221.           escape_char : ;
  222.          end;
  223.          previous_char := c_kbd_char;
  224.         end
  225.       else
  226.        begin
  227.         c_put_comm_char(c_kbd_char);
  228.         previous_char := c_kbd_char;
  229.        end;
  230.      end;
  231.       if c_get_comm_char then
  232.        begin
  233.         c_comm_char := chr(ord(c_comm_char) and $7f);
  234.         c_put_scr_char(c_comm_char);
  235.         if logging then
  236.          begin
  237.           buffer[bufptr] := c_comm_char;
  238.           bufptr := bufptr + 1;
  239.          end;
  240.       end;
  241.    until connect_end;
  242.  end;
  243.  
  244. begin
  245.  lowvideo;
  246.  cr_delay := 0;
  247.  bufptr := 0;
  248.  logging := false;
  249.  file_open := false;
  250.  writeln('Communications Demo Program Rev. ', revision);
  251.  writeln('Comm Library version ',c_lib_version);
  252.  if not c_init(1,1,1) then
  253.   begin
  254.     writeln('Initialization failed!');
  255.     abort := true;
  256.   end
  257.  else
  258.   abort := false;
  259.  if not abort then
  260.   repeat
  261.    connect;
  262.   until connect_end;
  263.  abort := c_reset;
  264. end.
  265.