/*****************************************************************************
* ratlib -- general ratfor utilities
*
*	This library includes:
*		ati	convert an ascii string to an integer
*		compar	compares two strings
*		comprs	remove a character whenever seen in a string
*		concat	concantenates two strings
*		copy	copy some things from one array to another
*		iindex	determines the position of a character in a string
*		ita	convert integer to ascii
*		length	determines length of a stirng
*		putstr	write out a string with imbedded newlines
*		remove	remove an arbitrary character from a string
*		scopy	copies characters from one string to another
*		upcase	copies from one string to another, making upper case.
*****************************************************************************/
include ratfor.def





/************************************************************************
*	ati	-convert an ascii string to an integer			*
*									*
*	useage:	foo = ati(string)					*
*	where:	string	=the string to convert				*
*		ati	=the integer value of the function		*
************************************************************************/
integer function ati(str)
character str(1)
real temp,j
integer i

for(i = 1;str(i) == SPACE | str(i) == TAB;i = i + 1)
	;				#skip blanks and tabs
if(str(i) == PLUS) {			#a +
	i = i + 1		#skip plus sign
	j = 1
	}
else if(str(i) == MINUS) {		#flag minus
	i = i + 1
	j = -1
	}
else
	j = 1
for(temp = 0;str(i) ^= EOS;i = i + 1) {
	d = iindex('0123456789',str(i))
	if(d == 0)
		break
	temp = 10*temp + (d-1)
	}
ati = temp*j			#fix sign
return
end
/*****************************************************************************
* compar -- compares one string to the other
*
*	useage:	log = compar(str1,str2)
*		where	log	is a logical value,true if the strings are
*				the same, false if they are not
*			str1 & str2 	are ascii character strings
*
* coding: G Beckmann 
*****************************************************************************/
logical function compar(str1,str2)
character str1(MAXTOKEN),str2(MAXTOKEN)

for (j = 1;str1(j) == str2(j) & str1(j) ^= EOS;j = j + 1)
	;
if(str1(j) ^= str2(j))
	compar = .FALSE.
else
	compar = .TRUE.
return
end


/************************************************************************
*	comprs	-remove a character wherever seen in a string		*
*									*
*	useage:	call comprs(str,char)					*
*	where:	str	=the string to search, EOS terminated		*
*		char	=the char to search for				*
************************************************************************/
subroutine comprs(str,char)
character str(1),char

if(char == EOS)return			#can't search for a null
i = 1
for(j = 1;str(j) ^= EOS;j = j + 1) [
	while(str(i) == char)		#skip over char to eliminate
		i = i + 1
	str(j) = str(i)
	i = i + 1
	]
return
end


/************************************************************************
* concat -- concatenates one string onto another			*
*									*
*	useage	call concat(str1,str2)					*
*		where	str2 is concantenated onto str1			*
*									*
* coded by: G Beckmann, 31-Jul-79					*
************************************************************************/
subroutine concat(str1,str2)
character str1(MAXTOKEN),str2(MAXTOKEN)

call scopy(str2,1,str1,iindex(str1,EOS))

return
end

/************************************************************************
* copy -- copy some things from one array to another			*
*									*
*	useage:	call copy(type,num,from,here,to,this_place)		*
*		where	type	is a magic number that indicates how 	*
*				many bytes make up the data type.	*
*				(int = 2 bytes)				*
*			num	is the number of data types to be 	*
*				transfered.				*
*	note:	this routine is very DEC specific in the way it 	*
*		sets up the arrays					*
************************************************************************/
subroutine copy(type,num,from,here,to,this_place)
integer type,num,here,this_place
byte from(1),to(1)

for({i = here * type;j = this_place * type;k = 1};	#set begin pointers
	k <= (num * type);
		{i = i + 1;j = j + 1;k = k + 1})
			to(j) = from(i)
return
end



/************************************************************************
* iindex -- searches a character string for a character and returns an 	*
*	   integer that is equal to the number of characters up to the 	*
*	   character searched						*
*									*
*	useage:	i = iindex(str,char)					*
*	notes:	1)  If the character searched for is not found before	*
*			EOS is encountered, then the function returns 0.*
*									*
* written by: gb 6-July-79						*
************************************************************************/
integer function iindex(str,char)
character str(STRLEN),char

for (i = 1;char ^= str(i) & str(i) ^= EOS;i = i + 1)
	;
if (str(i) == char)
	iindex = i
else
	iindex = 0
return
end




/****************************************************************
*	ita	-integer to ascii conversion			*
*								*
*	useage:	call ita(i,string)				*
*	where:	i	=the number to convert.			*
*		string	=the converted string.			*
*	note:							*
*		ita uses the DEC FORTRAN encode statement and	*
*	may not be portable to other systems.			*
****************************************************************/
subroutine ita(i,strand)
character strand(1),str(7)

encode(6,1000,str)i		#convert the string
1000	format(i6)
str(7)=EOS			#append eos
for(j = 1;j <= 5;j = j+1)	#strip leading blanks
	if(str(j) ^= blank)break
call scopy(str,j,strand,1)
return
end



/************************************************************************
* length -- calculates the length of a string				*
*									*
*	useage	i = length(str)						*
*		where	str	is the string				*
*	note	This routine uses iindex to determine position of EOS.	*
*		Then subtracts 1 from that.				*
*									*
* coded by: G Beckmann,7-Aug-79						*
************************************************************************/
integer function length(str)
character str(MAXTOKEN)

for(length = 0;str(length+1) != 0;length = length + 1)
	;
return
end


/************************************************************************
*	putstr	-write out a string with imbedded newlines		*
*									*
*	useage:	call putstr(str)					*
*	where:	str	=the string to write				*
*	note:	Writes to logical unit 6				*
************************************************************************/
subroutine putstr(str)
character str(1)

j = 1
for(i = 1;str(i) ^= EOS;i = j+1) [
	j = j + 1
	while(str(j) ^= NEWLINE & str(j) ^= EOS)
		j = j + 1
	if((j-i) == 1)
		write(6,90)
	else
		write(6,100)(str(ii),ii=i,j-1)
	100	format(' ',80a1)
	90	format(' ')
	]
return
end

/************************************************************************
*	remove	-remove a character from a string			*
*									*
*	useage:	call remove(string,char)				*
*	where:	string	=the string to remove characters from		*
*		char	=the character to remove.			*
*	notes:	remove removes all occurences of the given character	*
*		from the string. It checks that char is not EOS		*
************************************************************************/
subroutine remove(str,char)
character str(1),char

if(char == EOS) return			#dumb idea
for(i = 1;str(i) <> EOS & str(i) ^= char;i = i + 1)
	;				#look for first occurence of char
for(j = i;str(i) ^= EOS;{i = i + 1;j = j + 1}) {
	while(str(i) == char)
		i = i + 1
	str(j) = str(i)
	}
str(j) = EOS				#terminate
return
end

/************************************************************************
* scopy -- copies characters from one array to another			*
*									*
*	useage:	call scopy(from,i,to,j)					*
*	where:	from	=the source character array.			*
*		i	=the character in 'from' to start with		*
*		to	=the character array to copy into		*
*		j	=the position in 'to' to start with		*
*	notes:	scopy copies characters until an EOS is found.		*
*		There probably are system dependant methods of doing 	*
*			this that would be faster (for example RT-11	*
*			has a systems subroutine by this name).		*
*			Users are encouraged to	explore the		*
*			possibilities. . . . . . . . .			*
*		As can be seen this routine is taken almost character by*
*			character from the software tools book.		*
*									*
* written by: gb 6-July-79						*
************************************************************************/
subroutine scopy(from,i,to,j)
character from(STRLEN),to(STRLEN)
integer i,j,k1,k2

k2 = j
for(k1 = i;from(k1)^=EOS;k1 = k1 +1)[
	to(k2) = from(k1)
	k2 = k2 + 1
	]
to(k2) = EOS
return
end







/************************************************************************
*	upcase	-convert a string to upper case				*
*									*
*	usage:	call upcase(from,to)					*
*	where:	from	=the string to convert				*
*		to	=the converted string				*
************************************************************************/
subroutine upcase(from,to)
character from(1),to(1)
integer i

for(i = 1;from(i) ^= EOS;i = i + 1)
	if(from(i) >= LET_A & from(i) <= LET_Z)
		to(i) = from(i) - (LET_A-BIG_A)
	else
		to(i) = from(i)
to(i) = EOS
return
end