home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
CPM
/
TURBOPAS
/
COMDEMO.ARK
/
CLIB180.INC
< prev
next >
Wrap
Text File
|
1986-08-24
|
9KB
|
267 lines
(*
Communications library for Turbo Pascal. This library is designed to
simplify porting communications related operations to other micros by
providing standard communications procedures and functions.
This library is for DEC VT180 (Robin). It supports communications on
the reader/punch port and UC1. No parity or baud rate settings are
allowed.
On the VT180 these routines will allow a connect mode at or near 9600
baud, if delays are minimized in the calling program.
These routines were written by Jeff Duncan. If there are problems or
comments, I can be reached at (617) 839-5673 (evenings) or as
LSM.DUNCAN at DEC-MARLBORO.
*)
(*--------------------------------------------------------------*)
type
c__ports = (c__port_not_set, c__default, c__comm, c__uc1);
(* possible port settings *)
c__port_names = array[0..4] of string[10];
(* number of possible ports + 1 for null terminator *)
c__bauds = (c__baud_not_set, c__baud_default); (* possible baud rates *)
c__baud_names = array[0..2] of string[10];
(* number of possible baud rates + 1 for null terminator *)
c__parities = (c__parity_not_set, c__parity_default); (* possible parity values *)
c__parity_names = array[0..2] of string[10]; (* parity names *)
(* number of possible parity settings + 1 for null terminator *)
c__port_record = record
c_baud : integer;
c_parity : integer;
end; (* record *)
const
c_lib_version = 'DEC VT180 - Rev. 0.5 - 28 April 1985';
(* changed several internal variable names to avoid collisions
with external program variables. No functional changes.
Added function 'c_send_break', to allow for break generation.
Returns FALSE, because no code is implemented yet.
*)
c_port_str : c__port_names = ('NOT SET', 'DEFAULT', 'COMM', 'UC1', '');
(* port names + null at end for terminator *)
c_baud_str : c__baud_names = ('NOT SET', 'DEFAULT', '');
(* baud rate names + null at end for terminator *)
c_parity_str : c__parity_names = ('NOT SET', 'DEFAULT', '');
(* parity names + null at end for terminator *)
var
c__iobyte : byte absolute $0003; (* CP/M standard iobyte *)
c__base_iobyte, c__port_iobyte : byte; (* inital iobyte, and
comm port iobyte *)
c__port_var : c__ports; (* list of ports available *)
c__parity_var : c__parities;
c__baud_var : c__bauds;
c__port_values : array[c__ports] of c__port_record;
(* variables available for use by main program. *)
c_comm_char : char; (* returned comm port character *)
c_kbd_char : char; (* returned keyboard character *)
c_current_port : integer; (* number of the currently selected port *)
c_current_baud : integer; (* baud rate on selected port *)
c_current_parity : integer; (* parity of selected port *)
(*--------------------------------------------------------------*)
function c_set_port(port : integer) : boolean;
(* set the communications port to the desired port.
number of the port is entered. 0 is port not set, for initializing
reasons, 1 is default port, comm (or reader), also for initializing.
2 is comm, and 3 is uc1:. If an invalid port is set, the port does not
change. If no port had been previously set, comm is set as port. With
and uninitialized iobyte, program is liable to hang.
*)
var
good : boolean;
procedure set_reader; (* set port as reader/punch *)
begin
c__port_var := c__comm;
c_current_port := 2;
c__port_iobyte := (c__base_iobyte and $fc) or $02;
good := true;
end;
begin
case port of
1, 2 : set_reader; (* use reader for default or comm *)
3 : begin
c__port_var := c__uc1;
c_current_port := 3;
c__port_iobyte := (c__base_iobyte and $fc) or $03;
good := true;
end;
else
good := false;
end; (* case *)
if good then
c_set_port := true
else
begin
if c__port_var = c__port_not_set then
set_reader;
c_set_port := false;
end;
(* set the current values for baud rate and parity. The two ports may
have different characteristics. *)
c_current_baud := c__port_values[c__port_var].c_baud;
c_current_parity := c__port_values[c__port_var].c_parity;
end;
(*--------------------------------------------------------------*)
function c_set_baud( baudrate : integer) : boolean;
begin (* c_setbaud *)
c__port_values[c__port_var].c_baud := 1; (* force default condition *)
if baudrate = 1 then
c_set_baud := true (* default port only is allowed *)
else
c_set_baud := false; (* no baud rates settable *)
c_current_baud := c__port_values[c__port_var].c_baud;
end; (* c_setbaud *)
(*--------------------------------------------------------------*)
function c_set_parity(parity : integer) : boolean;
begin (* c_set_parity *)
c__port_values[c__port_var].c_parity := 1; (* default value *);
if parity = 1 then
c_set_parity := true (* default parity only *)
else
c_set_parity := false; (* no other parity allowed *)
c_current_parity := c__port_values[c__port_var].c_parity;
end; (* c_set_parity *)
(*--------------------------------------------------------------*)
function c_init(port : integer; baud, parity : integer) : boolean;
(* Set a communications port as selected port.
This routine must ALWAYS be called at the beginning of a
program or strange results will occur.
If the ports have not been set before, and an invalid port is
selected, the reader/punch port is selected. This is to
try to prevent very odd results with initialized variables.
*)
var
c_ok : boolean;
count : integer;
begin (* c_init *)
for count := 1 to ord(c__uc1) do (* initialize everthing to defaults *)
with c__port_values[c__ports(count)] do
begin
c_baud := 1;
c_parity := 1;
end; (* with *)
c__port_var := c__port_not_set;
c_ok := false;
c__base_iobyte := c__iobyte; (* save the inital iobyte setting *)
if c_set_port(port) then (* try to set the port *)
c_ok := true;
if c_set_baud(baud) then (* try to set the baud rate *)
c_ok := true;
if c_set_parity(parity) then (* try to set the parity *)
c_ok := true;
if c_ok then (* was everything ok? *)
c_init := true
else c_init := false;
end; (* c_init *)
(*--------------------------------------------------------------*)
function c_reset : boolean; (* reset any parameters required before exiting *)
begin (* c_reset *)
c_reset := true; (* there's nothing to do for the VT180 *)
end; (* c_reset *)
(*--------------------------------------------------------------*)
function c_get_comm_char : boolean;
(* This function will attempt to get a new character from the previously
selected communications port. It will return TRUE if a character was
available, and FALSE if no character was available. The actual
character is returned in the global variable 'c_comm_char'.
*)
begin (* c_get_comm_char *)
c__iobyte := c__port_iobyte; (* set iobyte to comm port *)
if bios(1) <> 0 then
begin
c_comm_char := chr(bios(2));
c_get_comm_char := true;
end
else
c_get_comm_char := false;
c__iobyte := c__base_iobyte; (* reset iobyte to original value *)
end; (* c_get_comm_char *)
(*--------------------------------------------------------------*)
procedure c_put_comm_char(c_comm_out_char : char);
(* This procedure will write a byte to the selected comm port. *)
begin (* c_put_comm_char *)
c__iobyte:= c__port_iobyte;
case c__port_var of
c__comm : bios(5,ord(c_comm_out_char));
c__uc1 : begin
c__iobyte := c__port_iobyte;
bios(3, ord(c_comm_out_char));
c__iobyte := c__base_iobyte;
end;
end; (* case *)
end; (* c_put_comm_char *)
(*--------------------------------------------------------------*)
function c_get_kbd_char : boolean;
(* This function will attempt to get a new character from
the keyboard. It will return TRUE if a character was
available, and FALSE if no character was available. The actual
character is returned in the global variable 'c_kbd_char'.
*)
begin (* c_get_kbd_char *)
if bios(1) <> 0 then
begin
c_kbd_char := chr(bios(2));
c_get_kbd_char := true;
end
else
c_get_kbd_char := false;
end; (* c_get_kbd_char *)
(*--------------------------------------------------------------*)
procedure c_put_scr_char(c_scr_out_char : char); (* write char to screen *)
begin (* c_put_scr_char *)
bios(3, ord(c_scr_out_char));
end; (* c_put_scr_char *)
(*-------------------------------------------------------------*)
function c_send_break : boolean;
(* attempt to send a break signal. No code is implemented yet. *)
begin (* c_send_break *)
c_send_break := false;
end; (* c_send_break *)