{

<E>dit, <F>iles, <G>et from PAD, <P>ut to PAD, <T>erminal, e<X>it:

Files - <A>ddresses, <C>onfiguration, e<X>it:

Get - <A>ddresses, <C>onfiguration, e<X>it:

Put - <A>ddresses, <C>onfiguration, e<X>it:

}

program test(input,output,f);

{$i typedefs.pas}

var		padarray:parray;
			menu:marray;
			i:integer;
			x:integer;
			y:integer;
			j:integer;
			checksum	:	integer;
			entries:integer;	{number of entries}
			ch: char;
			cheat:integer;
			rds : intregspec;			{ used for DOS calls }
{			names:nametable;}

{ ***
  Assembly routines that have been linked in to provide buffered I/O
  *** }

procedure prtchr; external ;		{ picks up char from auxiliary port
																  places result in rcstr.charout }
procedure sendbr; external ;		{ send break to aux }
procedure serini; external ;		{ initialise aux }
procedure serrst; external ;		{ resets aux }
procedure beep; external ;
procedure sctprt; external ;		{ sends char in rcstr.charin to aux }
procedure charq; external ;
procedure clrbuf; external ;		{ clears input buffer }
procedure	asemul; external ;		{assembler emulator}
procedure asemte; external ;


procedure editdata(var cfgfile:string20;copyfile:string20); external;

procedure date(var year,month,day:integer); external; 

procedure time(var houts,mns,dsec,huns: integer) ; external ;


procedure syscall(intnumber: byte; var regs : intregspec); external;
					{ used for DOS call }

procedure readstf(var st : string20);

var	i:integer;
		ch:char;
		
begin
	for i:=1 to 20 do	st[i]:= chr(0);
	i:=0;
 	while not eoln(f) and (i<20) do
	begin
		i:=i+1;
		read(f,st[i])
	end;
	read(f,ch);		{ read trailing lf}
end;

procedure readnst(var st : string64);

var	i:integer;
		ch:char;
		
begin
	for i:=1 to 64 do	st[i]:= chr(0);
	i:=0;
 	while not eoln(f) and (i<64) do
	begin
		i:=i+1;
		read(f,st[i]);
	end;
	read(f,ch);		{ read trailing lf}
end;

function slen(st : string64):integer;

var l,i	:	integer;

begin
	l:=0;
	for i:=1 to 64 do
	begin
		if (l=0) and (ord(st[i])=0) then
		begin
			slen:=i-1;
			l:=99;
		end;	
	end;	
end;
		
function kbstat: boolean;	  { returns true if key pressed }

begin
  rds.ah := 6;		  { initialise registered }
  rds.dl := 255;
  syscall(33,rds);	  { DOS call }
  if (not rds.zf) then
    cheat := rds.al;	  { cheat holds char code }
  if cheat > 127 then kbstat := false
    else kbstat := not rds.zf
end;	{  kbstat  }

procedure kbread(var ch : char);  { gets char sensed by kbstat }

begin
  ch := chr(cheat)
end;	{  kbread  }

function lc2uc(ch:char) : char;
begin
	if (ch in ['a'..'z']) then
		ch:=chr(ord(ch)-32);
	lc2uc:=ch;
end;	


procedure savedir;

var i:integer;

begin
	assign(f,'XICON.DAT');	
	rewrite(f);
	for i:=1 to entries do
	begin
		writeln(f,padarray[i].name);
		writeln(f,padarray[i].address);
		writeln(f,padarray[i].changetime);
		writeln(f,padarray[i].cfgfile);
		writeln(f,padarray[i].namfile);
	end;
	close(f);
end;


procedure delentry(i:integer);

var
	j	:	integer;

begin
	if fstat(padarray[i].cfgfile) then
	begin
		assign(fp,padarray[i].cfgfile);
		erase(fp);
	end;	
	if fstat(padarray[i].namfile) then
	begin
		assign(fn,padarray[i].namfile);
		erase(fn);
	end;	
	assign(f,'XICON.DAT');
	rewrite(f);
	for j:=1 to entries do
	begin
		if j<>i then
		begin
			writeln(f,padarray[j].name);
			writeln(f,padarray[j].address);
			writeln(f,padarray[j].changetime);
			writeln(f,padarray[j].cfgfile);
			writeln(f,padarray[j].namfile);
		end;
	end;	
	reset(f);
	i:=1;
	repeat
		readstf(padarray[i].name); 
		readstf(padarray[i].address);
		readstf(padarray[i].changetime);
		readstf(padarray[i].cfgfile);
		readstf(padarray[i].namfile);
		i:=i+1;
  until eof(f);
  close(f);
	entries:=i-1;	{set-up global number of variables}
end;


procedure dattim(var temps:string20);

var
	i,j:integer;
	d:array[1..7] of integer;
	st:string;

begin
	for j:=1 to 20 do temps[j]:=chr(0);
	time(d[1],d[2],d[3],d[7]);
	date(d[6],d[5],d[4]);
	for j:=1 to 5 do
	begin
		str(100+d[j],st);
		for i:=1 to 3 do
			temps[(j-1)*3+i]:=st[i];
	end;
	temps[1]:=' ';
	temps[4]:=':';
	temps[7]:=':';
	temps[10]:=' ';
	temps[13]:='/';
	temps[16]:='/';
	str(d[6],st);
	for j:=1 to 4 do
		temps[j+16]:=st[j];
end;
	
function yesno : boolean ;  { returns true if user presses y or Y }

var  ch : char ;

begin
  clrbuf ;
  repeat
    repeat
    until kbstat ;
    kbread(ch)
  until ch in ['y','n','Y','N'] ;
  writeln(' ',ch) ; writeln ; writeln ;
  if ch in ['y','Y'] then yesno := true
    else yesno := false
end ;	 {  yesno  }


procedure poscur(x,y: integer) ;

begin
  write(chr(27),'[',x:1,';',y:1,'H') ;
end ;

procedure hlighton;

begin
	write(chr(27),'[7m');
end;

procedure hlightoff;

begin
	write(chr(27),'[0m');
end;

procedure flashon;

begin
	write(chr(27),'[5m');
end;

procedure flashoff;

begin
	write(chr(27),'[0m');
end;

procedure nread(i:integer;var temp:string20);

var
	j:integer;	
	ch:char;
	finished:boolean;
	
begin
	hlighton;
	for j:=1 to i do write(' '); 
	for j:=1 to i do write(chr(8)); 
	hlightoff;
	j:=1;
	finished:=false;
	repeat
		repeat
			until kbstat;
		kbread(ch);
		if ch=chr(27) then 
		begin
			finished:=true;
			temp[1]:=ch;
		end;
		if ch=chr(13) then finished:=true;
		if (ch=chr(8)) and (j>1) then
		begin
			temp[j]:=chr(0);
			j:=j-1;
			hlighton;
			write(ch,' ',ch);
			hlightoff;
		end	
		else
		begin
		  if (j<i+1) and (ch in ['0'..'9','A'..'Z','a'..'z']) and (not finished) then
			begin
				temp[j]:=lc2uc(ch);
				j:=j+1;
				write(ch);
			end
			else
				if not finished then write(chr(7));
		end;		
	until finished;
end;			 					


procedure fnread(i:integer;var temp:string64);

var
	j:integer;	
	ch:char;
	finished:boolean;
	
begin
	hlighton;
	for j:=1 to i do write(' '); 
	for j:=1 to i do write(chr(8)); 
	hlightoff;
	for j:=1 to 64 do
		temp[j]:=chr(0);
	j:=1;
	finished:=false;
	repeat
		repeat
			until kbstat;
		kbread(ch);
		if ch=chr(27) then 
		begin
			finished:=true;
			temp[1]:=ch;
		end;
		if (ch=chr(13)) and (j>1) then finished:=true;
		if (ch=chr(8)) and (j>1) then
		begin
			temp[j]:=chr(0);
			j:=j-1;
			hlighton;
			write(ch,' ',ch);
			hlightoff;
		end	
		else
		begin
		  if (j<i+1) and (ch in ['.','0'..'9','A'..'Z','a'..'z']) and (not finished) then
			begin
				temp[j]:=lc2uc(ch);
				j:=j+1;
				write(ch);
			end
			else
				if not finished then write(chr(7));
		end;		
	until finished;
end;			 					

function valname(i:integer):integer;

begin
	if i=0 then
		valname:=0
	else
	begin	
		if padarray[i].changetime[1]='<' then
			valname:=0
		else
			valname:=1;	  	
	end;
end;	

procedure nuread(i:integer;var temp:string20);

var
	j:integer;	
	ch:char;
	finished:boolean;
	
begin
	hlighton;
	for j:=1 to i do write(' '); 
	for j:=1 to i do write(chr(8)); 
	hlightoff;
	j:=1;
	finished:=false;
	repeat
		repeat
			until kbstat;
		kbread(ch);
		if ch=chr(27) then 
		begin
			finished:=true;
			temp[1]:=ch;
		end;
		if ch=chr(13) then finished:=true;
		if (ch=chr(8)) and (j>1) then
		begin
			temp[j]:=chr(0);
			j:=j-1;
			hlighton;
			write(ch,' ',ch);
			hlightoff;
		end	
		else
		begin
		  if (j<i+1) and (ch in ['0'..'9']) and (not finished) then
			begin
				temp[j]:=ch;
				j:=j+1;
				write(ch);
			end
			else
				if not finished then write(chr(7));
		end;		
	until finished;
end;			 					


procedure setpromptline;

begin
	hlighton;
	poscur(25,1);
	write('Alt-X when finished                 XiCON Version 1.2, (C) Netcomm Limited 1987');
	poscur(1,1);
	hlightoff;
end;

procedure cls;

begin
	write(chr(27),'[H',chr(27),'[2J');
	hlighton;
	poscur(25,1);
	write('                                    XiCON Version 1.2, (C) Netcomm Limited 1987');
	poscur(1,1);
	hlightoff;
end;

function bitset(bit_num : integer ; data : byte) : boolean ;

var num , divide_num : integer ;

begin
  num := data ;
  divide_num := bit_num ;
  while divide_num <> 0 do
    begin
      num := num div 2 ;
      divide_num := divide_num - 1 ;
    end ;
  if (num mod 2) = 1 then bitset := true
    else bitset := false ;
end ;


procedure setbit(bit_num : integer ; var data : byte) ;

var num : 0..255 ;
    mult_num : integer ;

begin
  if not bitset(bit_num,data) then
    begin
      num := 1 ;
      mult_num := bit_num ;
      while mult_num <> 0 do
	begin
	  num := num * 2 ;
	  mult_num := mult_num - 1 ;
	end ;
      data := data + num ;
    end
end ;

procedure resetbit(bit_num : integer ; var data : byte) ;

var num : 0..255 ;
    mult_num : integer ;

begin
  if bitset(bit_num,data) then
    begin
      num := 1 ;
      mult_num := bit_num ;
      while mult_num <> 0 do
	begin
	  num := num * 2 ;
	  mult_num := mult_num - 1 ;
	end ;
      data := data - num ;
    end
end ;


procedure wait(stophun : integer) ;

var hours,mins,sec,hun,hun2 : integer ;

begin
  time(hours,mins,sec,hun) ;
  repeat
    time(hours,mins,sec,hun2) ;
    if hun2 < hun then hun2 := hun2 + 60 ;
  until hun2 >= hun + stophun
end;   { wait }


procedure sendtofile(i:integer) ;	{ save data to file }

var
filenameok : boolean ;
alldone : ptr ;
temps:string20;

begin
	filenameok:=true;
  if fstat(padarray[i].cfgfile) then	{ if already exists }
    begin
      write('Filename already exists, do ') ;
      write('you wish to overwrite (Y/N): ') ;
      if not yesno then filenameok := false
    end ;
  if filenameok then
    begin
      alldone := list_header ;
      assign(fp,padarray[i].cfgfile) ;
      rewrite(fp) ;
      while alldone <> nil do	    { write store }
			begin
			  write(fp,alldone^) ;
			  alldone := alldone^.next
			end ;
			dattim(temps);			
			padarray[i].changetime:=temps;
			savedir;
			close(fp);
    end
end ; { sendtofile }

procedure chkdel(var i	:	integer);

begin
	cls;
	if padarray[i].name[1]<>'<' then 
	begin
		poscur(3,1);
		write('OK to delete ',padarray[i].name,'(Y/N): ')	;
		if (not yesno) then i:=0;
	end
	else
		i:=0;
end;	
		


procedure clraux ;   { clears the aux buffer of all stored and incoming
		       data }
begin
  repeat
    charq ;
    if rcstr.charst <> 0 then prtchr
    else
      begin
	wait(50) ;  { wait to see if anymore data arriving }
	charq
      end
  until rcstr.charst = 0
end ; { clraux }


procedure setupbuf ;  { sets up aux buffer so can be guaranteed that it
			contains a prompt }
begin
  rcstr.charin := 16 ; { Ctrl P }
  sctprt ;
  rcstr.charin := 16 ;
  sctprt ;
  rcstr.charin := 17 ; { XON }
  sctprt ;
  clraux ;
  rcstr.charin := 13 ;
  sctprt
end ; { setupbuff }

procedure pause;
begin
	poscur(14,1);
	write('Any key when ready: ');
	repeat until kbstat;
end;


procedure startupscreen ;

	var st : string20 ;

begin


	cls;
	poscur(3,20); write('º²²²²²²²²²²²²²²²²²²²²²²²²²²²²²º');
	poscur(2,20); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
	poscur(8,20); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ');
	poscur(4,20); write('º² ²² ²²   ²²   ²²    ²²  ²² ²º');
	poscur(6,20); write('º² ²² ²²   ²²   ²²    ²² ²²  ²º');
	poscur(7,20); write('º²²²²²²²²²²²²²²²²²²²²²²²²²²²²²º');
	poscur(5,20); write('º²²  ²²²² ²²² ²²²² ²² ²² ² ² ²º');
	pause;
end;


function menuf : integer;	{select option from menu}

var chint,i,j:integer;
		ch: char;
		finished:boolean;
		
begin
	cls;
	menu[1]:=' Edit Config ';
	menu[2]:='Load from PAD';		
	menu[3]:=' Send to PAD ';		
	menu[4]:='Terminal mode';	
	menu[5]:='  File Menu  ';
	menu[6]:=' Warm  start ';
	menu[7]:='     EXIT    ';	
	poscur(2,32); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
	poscur(10,32); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ');
	poscur(7,32); write('º             º');
	poscur(6,32); write('º             º');
	poscur(5,32); write('º             º');
	poscur(4,32); write('º             º');
	poscur(9,32); write('º             º');
	poscur(8,32); write('º             º');
	poscur(3,32); write('º             º');
	for i:=2 to 7 do 
	begin
		poscur(i+2,33);
		write(menu[i])
	end;
	j:=1;
	finished:=false;
	repeat
		if j<1 then j:=7;
		if j>7 then j:=1;
		if chint<>0 then
		begin
			poscur(2+j,33);
			hlighton;
			write(menu[j]);
			hlightoff;
		end;
		repeat
		until kbstat;
		kbread(ch);			{get character}
		poscur(2+j,33);
		write(menu[j]);
		chint:=ord(ch);
		if chint=13 then finished:=true;
		if chint=32 then finished:=true;
		if chint=27 then begin finished:=true; j:=0; end;
		if chint=72 then j:=j-1;
		if chint=80 then j:=j+1;
	until finished;
	menuf:=j;
end;

function namecon : integer;	{select option from menu}

var chint,i,j:integer;
		ch: char;
		finished:boolean;
		
begin
	cls;
	menu[1]:='    Names    ';
	menu[2]:='Configuration';		
	menu[3]:='             ';		
	menu[4]:='             ';	
	menu[5]:='             ';
	menu[6]:='     EXIT    ';	
	poscur(2,32); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
	poscur(9,32); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ');
	poscur(7,32); write('º             º');
	poscur(6,32); write('º             º');
	poscur(5,32); write('º             º');
	poscur(4,32); write('º             º');
	poscur(8,32); write('º             º');
	poscur(3,32); write('º             º');
	for i:=2 to 6 do 
	begin
		poscur(i+2,33);
		write(menu[i])
	end;
	j:=1;
	finished:=false;
	repeat
		if j<1 then j:=6;
		if j>6 then j:=1;
		if chint<>0 then
		begin
			poscur(2+j,33);
			hlighton;
			write(menu[j]);
			hlightoff;
		end;
		repeat
		until kbstat;
		kbread(ch);			{get character}
		poscur(2+j,33);
		write(menu[j]);
		chint:=ord(ch);
		if chint=13 then finished:=true;
		if chint=32 then finished:=true;
		if chint=27 then begin finished:=true; j:=0; end;
		if chint=72 then j:=j-1;
		if chint=80 then j:=j+1;
	until finished;
	namecon:=j;
end;


function fmenuf : integer;	{select option from file menu}

var chint,i,j:integer;
		ch: char;
		finished:boolean;
		
begin
	cls;
	menu[1]:='Import Names ';
	menu[2]:='Export Names ';		
	menu[3]:='Delete Entry ';		
	menu[4]:='             ';	
	menu[5]:='             ';
	menu[6]:='     EXIT    ';	
	poscur(2,32); write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
	poscur(9,32); write('ÈÍÍÍÍÍÍÍÍÍÍÍÍͼ');
	poscur(7,32); write('º             º');
	poscur(6,32); write('º             º');
	poscur(5,32); write('º             º');
	poscur(4,32); write('º             º');
	poscur(8,32); write('º             º');
	poscur(3,32); write('º             º');
	for i:=2 to 6 do 
	begin
		poscur(i+2,33);
		write(menu[i])
	end;
	j:=1;
	finished:=false;
	repeat
		if j<1 then j:=6;
		if j>6 then j:=1;
		if chint<>0 then
		begin
			poscur(2+j,33);
			hlighton;
			write(menu[j]);
			hlightoff;
		end;
		repeat
		until kbstat;
		kbread(ch);			{get character}
		poscur(2+j,33);
		write(menu[j]);
		chint:=ord(ch);
		if chint=13 then finished:=true;
		if chint=32 then finished:=true;
		if chint=27 then begin finished:=true; j:=0; end;
		if chint=72 then j:=j-1;
		if chint=80 then j:=j+1;
	until finished;
	fmenuf:=j;
end;


procedure readfromfile(var filename:string20) ;	{ pick up data from file }

var
leader , follower : ptr ;

begin
  assign(fp,filename) ;
  reset(fp) ;
  new(list_header) ;	 { generate space }
	
  read(fp,list_header^) ; { get header }

  follower := list_header ;
  while not eof(fp) do	   { get rest of file }
    begin
      new(leader) ;
      read(fp,leader^) ;
      follower^.next := leader ;
      follower := leader
    end;
  close(fp); 
end ; { readfromfile }

procedure readcopyfile(var filename:string20) ;	{ pick up data from file }

var
leader , follower : ptr ;

begin
  assign(fc,filename) ;
  reset(fc) ;
  new(copy_header) ;	 { generate space }
	
  read(fc,copy_header^) ; { get header }

  follower := copy_header ;
  while not eof(fc) do	   { get rest of file }
    begin
      new(leader) ;
      read(fc,leader^) ;
      follower^.next := leader ;
      follower := leader
    end;
	close(fc);	
end ; { readcopyfile }


	
procedure dnames;	{procedure sorts and displays names}

	var	i:integer;
			x:integer;
			y:integer;
			tempp : padinfo;
			finished : boolean;

	begin
		repeat
		begin
			finished:=true;
			for i:= 1 to entries-1 do
			begin
				if padarray[i].name>padarray[i+1].name then
				begin
					tempp := padarray[i];
					padarray[i] := padarray[i+1];
					padarray[i+1] := tempp;
					finished:=false;
				end;
			end;
		end;
		until finished;

	{ thats sorted the array, now display it:-}

		for i:= 1 to entries do
		begin
			x:=1+((i-1) mod 5)*14;
			y:=2+((i-1) div 5);
			poscur(y,x);
			write(padarray[i].name);
		end;
	end;



procedure daddresses;	{procedure sorts and displays addresses}

	var	i:integer;
			x:integer;
			y:integer;
			tempp : padinfo;
			finished : boolean;

	begin
		repeat
		begin
			finished:=true;
			for i:= 1 to entries-1 do
			begin
				if padarray[i].address>padarray[i+1].address then
				begin
					tempp := padarray[i];
					padarray[i] := padarray[i+1];
					padarray[i+1] := tempp;
					finished:=false;
				end;
			end;
		end;
		until finished;

	{ thats sorted the array, now display it:-}

		for i:= 1 to entries do
		begin
			x:=1+((i-1) mod 5)*14;
			y:=2+((i-1) div 5);
			poscur(y,x);
			write(padarray[i].address);
		end;
	end;


function addentry : integer;	{add entry to xicon.dat file}

var temps : string20;
		i,j : integer;
		abort,valid : boolean; 
		hb,lb: char;
		
begin
	cls;
	valid := false;
	while not valid do
	begin
		valid:=true;
		abort:=false;
		poscur(3,1);
		write('Enter mnemonic name for the new SuperPAD:    ');
		for i:=1 to 20 do	temps[i]:= chr(0);
		i:=1;
		nread(12,temps);
		if temps[1]=chr(27) then abort:=true;
		for i:= 1 to entries do
			if temps = padarray[i].name then valid :=false;
  	if not valid then 
  	begin
  		poscur(4,1);
  		write('--> ',temps,'already used.');
  	end;	
	end;
	if not abort then
	begin
		padarray[entries+1].name:=temps;
		valid :=false;
		while not valid do
		begin
			valid:=true;
			writeln;
			poscur(5,1);
			write('Enter X.29 address for ',padarray[entries+1].name,': ');
			for i:=1 to 20 do	temps[i]:= chr(0);
			nuread(12,temps);
			if temps[1] = chr(27) then abort :=true;
			if not abort then
			begin	
			for i:= 1 to entries do
					if (temps = padarray[i].address) and (valid) then
					begin
						writeln;
						writeln('That address has already been used for ',padarray[i].name);
						writeln;
						write('Do you also want to use it for ',padarray[entries+1].name,'(Y/N): ');
						valid :=yesno;
					end;
					if valid then
						padarray[entries+1].address:=temps;
			end;	
		end;
	end;
	if not abort then
	begin 
		for i:=1 to 20 do	temps[i]:= chr(0);
		for i:=1 to 6 do
		begin
			temps[i]:=padarray[entries+1].name[i];
			if temps[i]=chr(0) then temps[i]:='A';
		end;	
		lb:='0';
		hb:='0';
		repeat
			valid := true;
			temps[7]:=hb;
			temps[8]:=lb;
			temps[9]:='.';
			temps[10]:='C';
			temps[11]:='F';
			temps[12]:='G';
			for i:=1 to entries do
				if temps = padarray[i].cfgfile then valid := false; 
			if not (valid) then
			begin
				lb:=succ(lb);
				if lb=succ('9') then
				begin
					lb:='0';
					hb:=succ(hb);
					if hb = succ('9') then hb:='A';
				end;
			end;	
		until valid;
		padarray[entries+1].cfgfile:=temps;
		temps[10]:='N';
		temps[11]:='A';
		temps[12]:='M';
		padarray[entries+1].namfile:=temps;
		padarray[entries+1].changetime:='<UNCHANGED>         ';
	end;
	addentry:=entries+1;
	entries:=entries+1;			
	if not abort then savedir;
	if abort then addentry:=0;
end;	
		
function snames : integer;		{select name from displayed list}

var i:integer;
	x:integer;
	y:integer;
	j:integer;
	chint:integer;
	ch:char;
	finished:boolean;
	
begin
	cls;
	poscur(1,1);
	hlighton;
	write('Use cursor keys to move, ENTER to select SuperPAD for action, ESC to abort      ');
	hlightoff;
	poscur(24,1); write('Address:');
	poscur(24,40); write('Saved:');
	dnames;
	x:=1;y:=2;i:=1;finished:=false;chint:=32;
	repeat
		x:=1+((i-1) mod 5)*14;
		y:=2+((i-1) div 5);
		poscur(y,x);
		if chint <> 0 then 
		begin
			hlighton;
			for j:= 1 to 14 do
				write(padarray[i].name[j]);
			hlightoff;
			if not kbstat then begin
	  		poscur(24,10);
	  		write(padarray[i].address);
				poscur(24,46); 
				write(padarray[i].changetime);
			end;
		end;
		repeat
		until kbstat;
		kbread(ch);			{get character}
		poscur(y,x);
		for j:= 1 to 14 do write(padarray[i].name[j]);
		chint:=ord(ch);
		if chint=13 then finished:=true;
		if chint=27 then finished:=true;
		if chint=72 then i:=i-5;
		if chint=75 then i:=i-1;
		if chint=77 then i:=i+1;
		if chint=80 then i:=i+5;
		if (not finished) and (i<1) then i:=1;
		if i>entries then i:=entries;
	until finished;
	if chint=27 then i:=0;
	if i<>0 then 
	begin
		if padarray[i].name[1] = '<' then 
			i:=addentry;
	end;	
	snames:=i;
end;

function scopyp:integer;

begin
	cls;
	poscur(3,1);
	write('Do you want to copy some data from another PAD (Y/N): ');
	if not yesno then
		scopyp:=0
	else
		scopyp:=snames;
end;			
	 


procedure waitchaux ;	{ waits for a char to be received at aux port
			  note : this routine DOES NOT timeout so can
			  stop program }
begin
  repeat
    charq ;
  until rcstr.charst <> 0
end ; { waitchaux }


procedure sendhexpair(num : byte) ;   { translates number to hex pair and
					sends to aux port }
var
  firsthex , secondhex : 0..255 ;

begin
	checksum := checksum+num;
	if checksum>255 then checksum:=checksum-256;
  firsthex := 0 ;
  secondhex := 0 ;
  while num > 15 do		 { convert to hex }
    begin
      firsthex := firsthex + 1 ;
      num := num - 16
    end ;
  secondhex := num ;
  if firsthex < 10 then rcstr.charin := firsthex + 48  { convert to chars }
    else rcstr.charin := firsthex + 55 ;
  sctprt ;
  if secondhex < 10 then rcstr.charin := secondhex + 48
    else rcstr.charin := secondhex + 55 ;
  sctprt
end ; { sendhexpair }


procedure receivehexpair(var num : byte) ;  { receives two chars and converts
					      decimal }
var
   firsthex , secondhex : 0..255 ;

begin
  waitchaux ;
  prtchr ;
  firsthex := rcstr.charout ;  { receive first char }
  waitchaux ;
  prtchr ;
	if firsthex < 48 then
	begin
		writeln('Illegal character received');
		firsthex := 48;
	end;
  secondhex := rcstr.charout ; { receive second char }
	if secondhex < 48 then
	begin
		writeln('Illegal character received');
		secondhex := 48;
	end;
	if firsthex > 95 then firsthex:=firsthex-32;
	if secondhex > 95 then secondhex:=secondhex-32;
  if firsthex > 64 then num := 16 * (firsthex - 55)
    else num := 16 * (firsthex - 48) ;
  if secondhex > 64 then num := num + secondhex - 55
    else num := num + secondhex - 48;
end ; { receivehexpair }



procedure rec(i:integer) ;  { main calling procedure for saving data }

var
notex , first , netok : boolean ;
loop : integer ;
num , termno , number , chcksum : byte ;
currrec , lastrec : ptr ;

begin
  first := true ;
  cls ;
	hlighton;
	write('    Set up call to manager port, SuperPAD address is:     ',padarray[i].address);
	setpromptline;
	setupbuf ;
	clrbuf ;
	asemul;
	cls;
	poscur(3,1);
	write('Ok to start receiving (Y/N): ') ;
	if yesno then
	  begin
	  	poscur(5,1);
	  	write('Receiving terminal:'); 
	    rcstr.charin := ord('b') ;  { using b command }
	    sctprt ;
	    notex := true ;
	    termno := 0 ;
	    while notex do
				begin
	  		clraux ;
	  		rcstr.charin := ord(':') ;
	  		sctprt ;
	  		sendhexpair(3) ;
    	  sendhexpair(1) ;
    	  sendhexpair(termno) ;    { terminal number }
    	  sendhexpair(252-termno) ;  { checksum }
    	  waitchaux ;		{ wait for :  MODIFY - ADD TIMEOUT}
    	  prtchr ;
    	  receivehexpair(number) ;
    	  receivehexpair(num) ;  { receive condition }
  	    if num = 2 then    { if o.k. }
	      begin
	        receivehexpair(chcksum) ;
	        waitchaux ;    { wait for : from second packet }
	        prtchr ;
	        receivehexpair(number) ;	{ receive number and condition}
	        receivehexpair(num) ;	{ for second packet }
	        if num <> 5 then		{ if o.k. }
					begin
						poscur(5,20);
						hlighton;
						write(termno:2);
						hlightoff;
		  			if first then     { if first packet to be saved }
		    			begin
		      			new(currrec) ;
		      			list_header := currrec ; { establish list }
		      			first := false
		    			end
		  			else		     { else join to foot of list }
		    			begin
		      			lastrec := currrec ;
		      			new(currrec) ;
		      			lastrec^.next := currrec
		    			end ;
		  			with currrec^ do
		    			begin
		      			numitems := number ;    { save data }
		      			con := num ;
		      			for loop := 1 to number-1 do
									begin
			  						receivehexpair(num) ;
			  						code[loop] := num
									end ;
		    				end ;
		  				termno := termno + 1	 { get ready to look for }
						end			 { next terminal  <>5 if test}
	    		else
						begin
							receivehexpair(chcksum) ;
		  			notex := false   { no more terminals }
					end			{<>5 if test}
	  		end				{num=2 if test}
	  		else
	    		begin
	      	receivehexpair(chcksum) ;  { first packet not received
																	   correctly }
					poscur(7,1);
	      	write('--> Error in receive configuration. ABORTING.') ;
	      	notex := false
	    	end							{Num <> 2 test end}
			end ;				{matches while notex}
	    if not first then
				currrec^.next := nil ;	{ end list }
				writeln;writeln;
	    write('Do you wish to save the data (Y/N): ') ;
	    if yesno then sendtofile(i);
	  end														{matches start receiving yes}
		else
		begin
			poscur(7,1); 
	    write('--> No action occured')    { error conditions }
		end; 
end ; { rec }


procedure trans(i:integer); {main calling procedure for transmitting configs }

var
alldone : ptr ;
netok : boolean ;
number , num , con , termno : byte ;
loop : integer ;

begin
  cls ;
  poscur(1,29);
  hlighton;
  write('Transmit Configurations') ;
  hlightoff; 
	if fstat(padarray[i].cfgfile) then 
	begin
		cls;
		readfromfile(padarray[i].cfgfile) ;	 { read data }
	  writeln;	
		poscur(1,1);
		hlighton;
		write('    Set up call to manager port, data saved from SuperPAD ',padarray[i].address);
		setpromptline;
		setupbuf ;
		clrbuf ;
		asemul;
		cls;
		poscur(3,1);
	  write('Start transmission (Y/N): ') ;
	  if yesno then
		begin
		  alldone := list_header ;
		  rcstr.charin := ord('b') ;   { get into correct mode }
		  sctprt ;
		  wait(10) ;
		  clraux ;
		  termno := 0 ;
		  poscur (5,1);
		  write('Transmitting terminal: ') ;
		  while alldone <> nil do
			begin
		   	poscur(5,23);
		   	hlighton;
		   	write(termno:2);
		   	hlightoff;
		    rcstr.charin := ord(':') ;  { send first char of packet }
		    checksum := 0;
		    sctprt ;
		    with alldone^ do
				begin
					if numitems <> 214 then
					begin
						writeln('--> Corruption in file? Attempting correction.') ;
						numitems := 214;
					end ;
			  	sendhexpair(numitems) ;  { send packet }
			  	sendhexpair(con) ;
			  	for loop := 1 to numitems-2 do
			    	sendhexpair(code[loop]) ;
			  	sendhexpair(256-checksum)
				end ;
		    waitchaux ;	       { receive confirmation }
		    prtchr ;
		    receivehexpair(number) ;
		    receivehexpair(num) ;
		    receivehexpair(con) ;
		    if num <> 2 then 
		    begin
		    	writeln;
		    	writeln('--> Unexpected response, connection fail') ;
		    	alldone:=nil;
		  	end
		  	else 
		  	begin
		  		alldone := alldone^.next ;
		 			clraux;		  			  	
		 		end;	
		  	termno := termno + 1   { next terminal }
			end					{while alldone <> nil}
		end						{file not there?}
	end
	else
	  writeln('--> cannot find ',padarray[i].cfgfile);
	  pause;	
end ; { trans }

{$i names.pas}

procedure wstart ;

var
xiname : string4 ;
number , num , con : byte ;
netok : boolean ;

begin
  cls;
	poscur(1,1);
	hlighton;
	write('    Set up call to manager port of SuperPAD to warm start            ');
	setpromptline;
	setupbuf ;
	clrbuf ;
	asemul;
	cls;
	poscur(3,1);
  write('Commence warm start? (Y/N)') ;
  if yesno then
  begin
    rcstr.charin := ord('b') ;   { send out warm start packet }
    sctprt ;
    wait(10) ;
    clraux ;
    rcstr.charin := ord(':') ;
    sctprt ;
    sendhexpair(3) ;
    sendhexpair(6) ;
    sendhexpair(6) ;
    sendhexpair(241) ;
    waitchaux ;
    prtchr ;
    receivehexpair(number) ;	 { receive confirmation }
    receivehexpair(num) ;
    receivehexpair(con) ;
    if num <> 2 then writeln('Packet not received') ;
    clraux;
  end;
end; 

begin
	startupscreen;
	if fstat('XICON.DAT') then
	begin
		serini;
		assign(f,'XICON.DAT');
		reset(f);
 		i:=1;
		cls;
		repeat
			readstf(padarray[i].name); 
			readstf(padarray[i].address);
			readstf(padarray[i].changetime);
			readstf(padarray[i].cfgfile);
			readstf(padarray[i].namfile);
			i:=i+1;
    until eof(f);
		close(f);
		entries:=i-1;	{set-up global number of variables}
		i:=0;
		repeat
			i:=menuf;					{try out menu selection}
			if i = 3 then
			begin
				i:=snames;
				if i<>0 then
				begin
					if padarray[i].changetime[1]<>'<' then 
					begin
						j:=namecon;
						if j=1 then tranname(i);
						if j=2 then trans(i);
					end;	
				end;			
				i:=0;
			end;	
			if i = 2 then
			begin
				i:=snames;
				if i<>0 then
				begin
					j:=namecon;
					if j=1 then recname(i);
					if j=2 then rec(i);	
				end;
				i:=0;
			end;	
			if i = 4 then 
			begin
				cls;
				setpromptline;
			  setupbuf ;
			  clrbuf ;
				asemte
			end;
			if i = 1 then
			begin
				i :=snames;
				if valname(i)<>0 then
				begin
					j:=scopyp;
					if j<>0 then
						editdata(padarray[i].cfgfile,padarray[j].cfgfile)
					else
						editdata(padarray[i].cfgfile,'                    ');
				end;	
				i:=0
			end;
			if i = 5 then
			begin
				i :=fmenuf;
				if i=1 then
				begin
					i :=snames;
					if i<>0 then import(i);
					i:=0;
				end;
				if i=2 then
				begin
					i :=snames;
					if	i<>0 then export(i);
					i:=0;
				end;			
				if i=3 then
				begin
					i :=snames;
					if i<>0 then chkdel(i);
					if i<>0 then delentry(i); 
				end;	
				i:=0;
			end;
			if i=6 then
			begin
				wstart;
				i:=0;
			end;
		until i=7;
		cls;
		serrst ;
	end
	else
		writeln('--> Fatal error. XICON.DAT not present on drive/directory.');
end.