{The address of the server must be known to all clients wishing to access
it.  If the server has a registered domain-name, the address may be extracted
from the DNS server.  IP does not support a method of broadcasting to all
nodes to search for a specific server.  IP does support broadcasting for
a particular LAN.  The Broadcast address can be obtained by calling
GET_CONFIGURATION_INFORMATION and examining the field IP_BROADCAST_ADR.  The
broadcast must be sent using IP, UDP, or TCP;  connections cannot be
established to the broadcast address (any attempt hangs the host).
This is a simple chat program.  The schat program must be run first, and the
hchat program must be compiled with the ip address of the host running the
schat program.}
program server;
uses pctcp,crt;

var d:word;
    as:addr;
    e:word;
    sa,aa:word;
    w,temp:word;
    buffer:array[1..17] of char;
    dat:char;
    done:boolean;

begin
net_releaseall;  {release all local descriptors}
if not pctcp_installed then begin writeln('PCTCP not installed'); halt; end;
as.local_socket := $6666; {Must be "well-known" to all clients}
as.protocol := protocol_stream; {Specifies TCP as protocol}

net_getdesc(d,e); {Allocate descriptor for use}
if e<>0 then begin writeln('net_getdesc:',e); halt; end;

{d:=$ffff; {Forces automatic allocation of descriptor on call to net_listen}
net_getdesc(d,e);{automatic allocation doesn't appear to work}
net_listen(d,protocol_stream,as,e);
if e<>0 then begin writeln('net_listen:',e); halt; end
 else
  begin
   {These fields are automatically filled in by the call to net_listen}
   write('Connected to host ',as.IP_addr.a,'.',as.IP_addr.b,'.',
           as.IP_addr.c,'.',as.IP_addr.d);
   writeln('.  On port ',as.remote_socket);
   writeln('Using descriptor ',d);
  end;

dat := ' '; e:=0;
sa:=seg(buffer); aa:=ofs(buffer); {Set up pointers to data}
while (dat <> 'Z') and (not done) do
 begin
  if keypressed then
  begin
   dat := readkey;
   buffer[1] := dat; {Data to send}
   net_write(d,1,0,sa,aa,w,e); {Send data}
   if e<>0 then begin writeln('net_write:',e); done:=true; end
   else write(dat);
  end;
  net_read(d,1,no_block,sa,aa,as,w,e);
  if e=0 then
   for temp:=1 to w do write(buffer[temp])
  else if e <> net_err_wouldblock then done := true;
 end;

net_eof(d,e); {Close send side of connection}
if e<>0 then begin writeln('net_eof:',e); halt; end;

net_release(d,e); {Release the descriptor}
if e<>0 then begin writeln('net_release:',e); halt; end;

writeln('Done.');
end.