home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / turbopas / comdemo.ark / CLIB180.INC < prev    next >
Encoding:
Text File  |  1986-08-24  |  9.3 KB  |  267 lines
  1. (*
  2.    Communications library for Turbo Pascal.  This library is designed to
  3.    simplify porting communications related operations to other micros by
  4.    providing standard communications procedures and functions.
  5.    This library is for DEC VT180 (Robin).  It supports communications on
  6.    the reader/punch port and UC1.  No parity or baud rate settings are
  7.    allowed.
  8.    On the VT180 these routines will allow a connect mode at or near 9600
  9.    baud, if delays are minimized in the calling program.
  10.  
  11.    These routines were written by Jeff Duncan.  If there are problems or
  12.    comments, I can be reached at (617) 839-5673  (evenings) or as
  13.    LSM.DUNCAN at DEC-MARLBORO.
  14. *)
  15.  
  16. (*--------------------------------------------------------------*)
  17.  
  18. type
  19.   c__ports = (c__port_not_set, c__default, c__comm, c__uc1);
  20.          (* possible port settings *)
  21.   c__port_names = array[0..4] of string[10];
  22.     (* number of possible ports + 1 for null terminator *)
  23.   c__bauds = (c__baud_not_set, c__baud_default); (* possible baud rates *)
  24.   c__baud_names = array[0..2] of string[10];
  25.         (* number of possible baud rates + 1 for null terminator *)
  26.   c__parities = (c__parity_not_set, c__parity_default); (* possible parity values *)
  27.   c__parity_names = array[0..2] of string[10]; (* parity names *)
  28.     (* number of possible parity settings + 1 for null terminator *)
  29.   c__port_record = record
  30.                      c_baud : integer;
  31.                      c_parity : integer;
  32.                    end; (* record *)
  33.  
  34. const
  35.  
  36.   c_lib_version = 'DEC VT180 - Rev. 0.5 - 28 April 1985';
  37.     (* changed several internal variable names to avoid collisions
  38.        with external program variables.  No functional changes.
  39.        Added function 'c_send_break', to allow for break generation.
  40.        Returns FALSE, because no code is implemented yet.
  41.     *)
  42.   c_port_str : c__port_names = ('NOT SET', 'DEFAULT', 'COMM', 'UC1', '');
  43.      (* port names + null at end for terminator *)
  44.   c_baud_str : c__baud_names = ('NOT SET', 'DEFAULT', '');
  45.      (* baud rate names + null at end for terminator *)
  46.   c_parity_str : c__parity_names = ('NOT SET', 'DEFAULT', '');
  47.      (* parity names + null at end for terminator *)
  48.  
  49. var
  50.   c__iobyte : byte absolute $0003; (* CP/M standard iobyte *)
  51.   c__base_iobyte, c__port_iobyte : byte; (* inital iobyte, and
  52.                                             comm port iobyte *)
  53.   c__port_var : c__ports; (* list of ports available *)
  54.   c__parity_var : c__parities;
  55.   c__baud_var : c__bauds;
  56.   c__port_values : array[c__ports] of c__port_record;
  57.  
  58.  (* variables available for use by main program. *)
  59.   c_comm_char : char; (* returned comm port character *)
  60.   c_kbd_char : char; (* returned keyboard character *)
  61.   c_current_port : integer; (* number of the currently selected port *)
  62.   c_current_baud : integer; (* baud rate on selected port *)
  63.   c_current_parity : integer; (* parity of selected port *)
  64.  
  65. (*--------------------------------------------------------------*)
  66.  
  67. function c_set_port(port : integer) : boolean;
  68.  
  69.   (* set the communications port to the desired port.
  70.      number of the port is entered.  0 is port not set, for initializing
  71.      reasons, 1 is default port, comm (or reader), also for initializing.
  72.      2 is comm, and 3 is uc1:.  If an invalid port is set, the port does not
  73.      change.  If no port had been previously set, comm is set as port.  With
  74.      and uninitialized iobyte, program is liable to hang.
  75.    *)
  76.  
  77.   var
  78.     good : boolean;
  79.  
  80.   procedure set_reader; (* set port as reader/punch *)
  81.  
  82.       begin
  83.         c__port_var := c__comm;
  84.         c_current_port := 2;
  85.         c__port_iobyte := (c__base_iobyte and $fc) or $02;
  86.         good := true;
  87.       end;
  88.  
  89.   begin
  90.  
  91.     case port of
  92.       1, 2 : set_reader; (* use reader for default or comm *)
  93.       3 : begin
  94.             c__port_var := c__uc1;
  95.             c_current_port := 3;
  96.             c__port_iobyte := (c__base_iobyte and $fc) or $03;
  97.             good := true;
  98.           end;
  99.       else
  100.         good := false;
  101.     end; (* case *)
  102.     if good then
  103.       c_set_port := true
  104.     else
  105.       begin
  106.         if c__port_var = c__port_not_set then
  107.             set_reader;
  108.         c_set_port := false;
  109.       end;
  110.       (* set the current values for baud rate and parity. The two ports may
  111.          have different characteristics. *)
  112.     c_current_baud := c__port_values[c__port_var].c_baud;
  113.     c_current_parity := c__port_values[c__port_var].c_parity;
  114.   end;
  115.  
  116. (*--------------------------------------------------------------*)
  117.  
  118. function c_set_baud( baudrate : integer) : boolean;
  119.  
  120.   begin (* c_setbaud *)
  121.     c__port_values[c__port_var].c_baud := 1; (* force default condition *)
  122.     if baudrate = 1 then
  123.       c_set_baud := true (* default port only is allowed *)
  124.     else
  125.       c_set_baud := false; (* no baud rates settable *)
  126.     c_current_baud := c__port_values[c__port_var].c_baud;
  127.   end; (* c_setbaud *)
  128.  
  129. (*--------------------------------------------------------------*)
  130.  
  131.   function c_set_parity(parity : integer) : boolean;
  132.  
  133.     begin (* c_set_parity *)
  134.       c__port_values[c__port_var].c_parity := 1; (* default value *);
  135.       if parity = 1 then
  136.         c_set_parity := true (* default parity only *)
  137.       else
  138.         c_set_parity := false; (* no other parity allowed *)
  139.       c_current_parity := c__port_values[c__port_var].c_parity;
  140.  
  141.     end; (* c_set_parity *)
  142.  
  143. (*--------------------------------------------------------------*)
  144.  
  145. function c_init(port : integer; baud, parity : integer) : boolean;
  146.  
  147.    (* Set a communications port as selected port.
  148.       This routine must ALWAYS be called at the beginning of a
  149.       program or strange results will occur.
  150.       If the ports have not been set before, and an invalid port is
  151.       selected, the reader/punch port is selected.  This is to
  152.       try to prevent very odd results with initialized variables.
  153.    *)
  154.  
  155.   var
  156.     c_ok : boolean;
  157.     count : integer;
  158.  
  159.   begin (* c_init *)
  160.     for count := 1 to ord(c__uc1) do   (* initialize everthing to defaults *)
  161.       with c__port_values[c__ports(count)] do
  162.         begin
  163.           c_baud := 1;
  164.           c_parity := 1;
  165.         end; (* with *)
  166.     c__port_var := c__port_not_set;
  167.     c_ok := false;
  168.     c__base_iobyte := c__iobyte; (* save the inital iobyte setting *)
  169.     if c_set_port(port) then (* try to set the port *)
  170.       c_ok := true;
  171.     if c_set_baud(baud) then (* try to set the baud rate *)
  172.       c_ok := true;
  173.     if c_set_parity(parity) then (* try to set the parity *)
  174.       c_ok := true;
  175.     if c_ok then  (* was everything ok? *)
  176.       c_init := true
  177.     else c_init := false;
  178.   end; (* c_init *)
  179.  
  180. (*--------------------------------------------------------------*)
  181.  
  182.  function c_reset : boolean; (* reset any parameters required before exiting *)
  183.  
  184.    begin (* c_reset *)
  185.      c_reset := true; (* there's nothing to do for the VT180 *)
  186.    end; (* c_reset *)
  187.  
  188. (*--------------------------------------------------------------*)
  189.  
  190. function c_get_comm_char : boolean;
  191.  
  192.   (* This function will attempt to get a new character from the previously
  193.      selected communications port.  It will return TRUE if a character was
  194.      available, and FALSE if no character was available.  The actual
  195.      character is returned in the global variable 'c_comm_char'.
  196.   *)
  197.  
  198.   begin (* c_get_comm_char *)
  199.     c__iobyte := c__port_iobyte; (* set iobyte to comm port *)
  200.     if bios(1) <> 0 then
  201.       begin
  202.         c_comm_char := chr(bios(2));
  203.         c_get_comm_char := true;
  204.       end
  205.     else
  206.       c_get_comm_char := false;
  207.     c__iobyte := c__base_iobyte; (* reset iobyte to original value *)
  208.   end; (* c_get_comm_char *)
  209.  
  210. (*--------------------------------------------------------------*)
  211.  
  212. procedure c_put_comm_char(c_comm_out_char : char);
  213.  
  214.   (* This procedure will write a byte to the selected comm port. *)
  215.  
  216.   begin (* c_put_comm_char *)
  217.     c__iobyte:= c__port_iobyte;
  218.     case c__port_var of
  219.       c__comm : bios(5,ord(c_comm_out_char));
  220.       c__uc1 : begin
  221.               c__iobyte := c__port_iobyte;
  222.               bios(3, ord(c_comm_out_char));
  223.               c__iobyte := c__base_iobyte;
  224.             end;
  225.     end; (* case *)
  226.   end; (* c_put_comm_char *)
  227.  
  228.  
  229. (*--------------------------------------------------------------*)
  230.  
  231. function c_get_kbd_char : boolean;
  232.  
  233.   (* This function will attempt to get a new character from
  234.      the keyboard.  It will return TRUE if a character was
  235.      available, and FALSE if no character was available.  The actual
  236.      character is returned in the global variable 'c_kbd_char'.
  237.   *)
  238.  
  239.   begin (* c_get_kbd_char *)
  240.     if bios(1) <> 0 then
  241.       begin
  242.         c_kbd_char := chr(bios(2));
  243.         c_get_kbd_char := true;
  244.       end
  245.     else
  246.       c_get_kbd_char := false;
  247.   end; (* c_get_kbd_char *)
  248.  
  249.  
  250. (*--------------------------------------------------------------*)
  251.  
  252. procedure c_put_scr_char(c_scr_out_char : char); (* write char to screen *)
  253.  
  254.   begin (* c_put_scr_char *)
  255.     bios(3, ord(c_scr_out_char));
  256.   end; (* c_put_scr_char *)
  257.  
  258. (*-------------------------------------------------------------*)
  259.  
  260. function c_send_break : boolean;
  261.  
  262.   (* attempt to send a break signal.  No code is implemented yet. *)
  263.  
  264.   begin (* c_send_break *)
  265.     c_send_break := false;
  266.   end; (* c_send_break *)
  267.