#			R A T L B 2
#
#		     RATFOR LIBRARY 2
#	     MORE STRING PROCESSING ROUTINES
#
#		   RICHARD L. MICHAUD
#		   BRIDGEPORT CONTROLS
#		   200 PRECISION ROAD
#		       HORSHAM,PA.
#		       18-JUL-78
#
#	RATLB2 CONTAINS SEVERAL STRING PROCESSING FUNCTIONS WRITTEN
# IN RATFOR.  EACH FUNCTION MUST BE DECLARED AS INTEGER BY THE
# CALLING PROGRAM.  STRINGS ARE THE STANDARD RATFOR STRING - BYTE
# ARRAYS WITH AN OCTAL ZERO AS THE LAST CHARACTER IN THE STRING.
 
INCLUDE DEFN/L

# * - SPAN - SPAN ACROSS (REMOVE) LONGEST STRING IN S1 CONTAINED IN S2.
#	ON SUCCESS, SPAN WILL STORE SPANNED SUBSTRING IN S3 AND
#	THE FUNCTION WILL RETURN THE NEW SIZE OF S1.
#
#	SPAN WILL FAIL IF ALL CHARACTERS IN S1 ARE CONTAINED IN S2.
#	THE FUNCTION WILL RETURN -1 AND S3 WILL BECOME A NULL STRING.
#
#	SPAN WILL ALSO FAIL IF THE FIRST CHARACTER IN S1 IS NOT CONTAINED
#	IN S2.  THE FUNCTION WILL RETURN 0 AND S3 WILL BECOME A NULL STRING.
 
#	SPAN MUST BE DECLARED INTEGER BY THE CALLING PROGRAM AND S1,S2 AND
#	S3 MUST BE RATFOR STRINGS. S1 AND S2 MAY BE LITERAL, BUT S3 MUST
#	BE A STRING VARIABLE.
 
INTEGER FUNCTION SPAN(S1,S2,S3)
 
CHAR S1(ARB), S2(ARB), S3(ARB)
INTEGER D,INDEX,LENGTH
 
FOR (I=0; S1(I+1) <> EOS; I=I+1)[
  IF(INDEX(S2,S1(I+1)) == EOS)
    IF(I == 0)[
      S3(1)= EOS
      RETURN (0)
  ENDIF
 
  ELSE[
    K=I+1
    CALL SCOPY(S1,1,S3,1,K)		# COPY SPANNED CHARS INTO S3
    CALL SCOPY(S1,K,S1,1,ARB)		# S1 INTO S1, REMOVING K CHARS.
    K=LENGTH(S1)			# FIND NEW LENGTH OF S1.
    RETURN (K)				# RETURN NEW SIZE OF S1.
  ENDELSE
 
ENDFOR
S3(1) = EOS				# FINISH FOR LOOP IF ALL S1 IN S2.
RETURN (-1)
END
# * - BRAKE - SKIP ACROSS LONGEST SUBSTRING IN S1 NOT CONTAINED IN S2.
#
#	ON SUCCESS, BRAKE WILL TRANSFER TO S3 ALL CHARS UP TO THE FIRST BREAK
#	CHARACTER AND RETURN THE NEW SIZE OF S1.
#
#	BRAKE WILL FAIL IF THE FIRST CHAR IN S1 IS A BREAK CHARACTER, S3
#	WILL BE MADE A NULL STRING, AND THE FUNCTION WILL RETURN 0.
#
#	BRAKE WILL FAIL IF S1 CONTAINS NO CHARACTERS IN S2, S3 WILL BE 
#	MADE A NULL STRING AND THE FUNCTION WILL RETURN -1.
#
#	BRAKE MUST BE DECLARED AS INTEGER, S1,S2, AND S3 AS CHAR.
#	S2 MAY BE LITERAL.
 
INTEGER FUNCTION BRAKE(S1,S2,S3)
 
INTEGER INDEX,I,K
CHAR S1(ARB), S2(ARB), S3(ARB)
 
FOR (I=0; S1(I+1) <> EOS; I=I+1)[
 
  IF(INDEX(S2,S1(I+1)) <> EOS)		# IF CAN FIND A MATCH-
 
    IF (I== 0)[				#   IF S1(1) HAS A BREAK CHAR-
      S3(1)=EOS				#   MAKE S3 A NULL STRING-
      RETURN (0)			#   AND RETURN 0.
    ENDIF
 
    ELSE[
      K=I+1
      CALL SCOPY(S1,1,S3,K)		# SAVE SKIP INTO S3
      CALL SCOPY(S1,K,S1,1,ARB)		# AND SKIP TO BREAK CHAR,
      K=LENGTH(S1)			# FIND NEW LENGTH-
      RETURN (K)			# AND RETURN IT.
    ENDELSE
 
ENDFOR					# GET HERE IF NO BREAK CHARS.
 
S3(1)=EOS
RETURN (-1)				# RETURN FAILURE CODE.
END
# * - ANY - RETURN FIRST POSITION IN S1 MATCHED BY ANY CHAR IN S2
#
# ON SUCCESS, FUNCTION RETURNS FIRST MATCH POSITION
# ON FAILURE RETURN EOS.
#
# ANY MUST BE DECLARED INTEGER, S1 AND S2 DECLARED CHAR.  S1 AND S2
# MAY BE LITERAL.
 
INTEGER FUNCTION ANY(S1,S2)
 
CHAR S1(ARB), S2(ARB)
INTEGER INDEX,I
 
FOR (I=1; S1(I) <> EOS; I=I+1)
  IF(INDEX(S2,S1(I)) <> EOS)		# IF HAVE A MATCH-
    RETURN (I)				# RETURN POS OF MATCH
RETURN (EOS)				# RETURN EOS IF NO MATCH
END
# * - NOTANY - RETURN FIRST POSITION IN S1 NOT MATCHED BY ANY CHAR IN S2.
# FUNCTION RETURNS EOS IF ALL CHARS IN S1 MATCH WITH ANY CHAR IN S2.
# NOTANY MUST BE DECLARED INTEGER.
# S1 AND S2 MUST BE STRING OF CHAR, AND MAY BE LITERAL.
 
INTEGER FUNCTION NOTANY(S1,S2)
 
CHAR S1(ARB),S2(ARB)
INTEGER INDEX,I
 
FOR (I=1; S1(I) <> EOS; I=I+1)
  IF(INDEX(S2,S1(I)) == EOS)
    RETURN (I)
 
RETURN(EOS)			# HERE IF ALL MATCH
END
# * - SHIFT - SHIFT FIRST N CHARACTERS FROM STRING S1
#
# FUNCTION RETURNS NUMBER OF CHARACTERS IN S1 AFTER SHIFT.
#
# SHIFT		 MUST BE DECLARED INTEGER.
# N 		MUST BE INTEGER OR INTEGER VARIABLE
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED.
 
INTEGER FUNCTION SHIFT(S1,N)
 
INTEGER LENGTH,I,J,N
CHAR S1(ARB)
 
I=LENGTH(S1)			# GET SIZE
J=N+1				# START POS OF COPY
I=(I-N)+1			# NUMBER OF CHARS TO COPY
CALL SCOPY(S1,J,S1,I)		# REMOVE SHIFTED CHARS VIA OVERLAY.
I=LENGTH(S1)			# GET NEW LENGTH
RETURN(I)
END
# * - RPLACE - REPLACE ALL OCCURRENCES OF CHARACTER <A> BY CHARACTER <B>
#	FUNCTION WILL REPLACE ALL <A> WITH <B> IN S1 AND RETURN NUMBER
#	OF REPLACEMENTS.
#
#	FUNCTION WILL FAIL IF S1 DOES NOT COINTAIN <A> OR IF <A>=<B>  - 
#	RETURN 0.
#
# RPLACE	MUST BE DECLARED INTEGER
# A AND B	MUST BE SINGLE CHARACTER STRING OF CHAR OR LITERAL
 
INTEGER FUNCTION RPLACE(S1,A,B)
 
CHAR S1(ARB),A,B
INTEGER INDEX,I
 
IF(A==B)			# QUIT IF A=B
  RETURN(0)
 
I=0
REPEAT[
  I=INDEX(S1,A)			# FIND A
  IF(I==EOS)			# IF NO A
    BREAK			# DONE OR NONE
  S1(I)=B			# REPLACE ONE
  I=I+1
ENDREPEAT
 
RETURN(I)			# RETURN NUMBER OF REPLACEMENTS
END
# * - TRIM - REMOVE TRAILING BLANKS OR TABS
# FUNCTION REMOVES TRAILING BLANKS OR TABS AND RETURNS NEW LENGTH OF S1.
#
# TRIM		MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR, NO LITERAL ALLOWED.
 
INTEGER FUNCTION TRIM(S1)
 
CHAR S1(ARB)
INTEGER LENGTH,I
 
FOR (I=LENGTH(S1); I >> 0; I=I-1)[
  IF(S1(I) == BLANK ! S1(I) == TAB)	# IF BLANK OR TAB, TRIM IT.
    S1(I) = EOS
  ELSE
    BREAK				# DONE IF NONE
ENDFOR
 
I=LENGTH(S1)
RETURN (I)
END
# * - ITOC - CONVERT INTEGER TO CHAR STRING OF RADIX <BASE>.
#
# FUNCTION TO CONVERT INTEGER <NUMBR> TO STRING <S1> OF RADIX <BASE>
# ON SUCCESS, FUNCTION RETURNS SIZE OF CONVERTED STRING <S1>.
# FUNCTION WILL FAIL IF BASE IS LT 2. OR GT 16. AND WILL MAKE
# S1 A NULL STRING AND RETURN 0.
#
# ITOC		MUST BE DECLARED INTEGER 
# NUMBR		MUST BE INTEGER OR INTEGER VARIABLE
# S1		MUST BE STRING OF CHAR.
# BASE		MUST BE INTEGER OR INTEGER VARIABLE GE 2 AND LE 16.
#
# EXAMPLE:
#
# ITOC(10,S1,16)	WILL PRODUCE 'A' IN S1 WITH EOS IN S1(2) AND
#			RETURN 1
 
INTEGER FUNCTION ITOC(NUMBR,S1,BASE)
 
INTEGER BASE,NUMBR,I,J,K
CHAR S1(ARB),JUNK(ARB),TABLE(16)
DATA TABLE /'0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F'/
 
IF (BASE .LT. 2 .OR. BASE .GT. 16)[
  S1(1)=EOS				# BAD BASE IF HERE
  RETURN (0)				# SO SET FAILURE AND RETURN
ENDIF
 
I=1
REPEAT[
J=MOD(NUMBR,BASE)+1			# GET REMAINDER AND MAKE POINTER
JUNK(I)=TABLE(J)			# FIND THE CHAR
I=I+1					# INC INDEX
NUMBR=NUMBR/BASE			# QUOTIENT BECOMES DIVISOR
ENDREPEAT UNTIL (NUMBR <=0 )		# DONE WHEN NUMBR =0.
 
I=I-1					# BACK UP JUMP INDEX
K=1					# RESULT INDEX
 
FOR (J=1; J >= 0; J=J-1)[		# REVERSE ORDER
  S1(K)=JUNK(J)
  K=K+1
ENDFOR
 
S1(K)=EOS				# MARK END OF STRING
RETURN (I)				# RETURN SIZE OF S1
END
# * - CHEXTI - CONVERT ASCII NUMERIC SUBSTRING TO INTEGER OF RADIX <BASE>.
#
# NOTE: CHEXTI IS A SUPERSET OF CTOI THAT INCLUDES HEXADECIMAL AS A LEGAL
#	BASE.  THEREFORE A-F ARE LEGAL NUMERIC CHARACTERS IF <BASE> IS GT 10.
#
# CHEXTI WILL CONVERT NUMERIC CHARACTERS IN S1 STARTING AT POSITION I UNTIL
# FIRST NON-NUMERIC CHARACTER OF RADIX <BASE> TO INTEGER.
#
# CHEXTI		MUST BE DECLARED INTEGER
# S1			STRING OF CHAR OR LITERAL STRING
# I			INTEGER VARIABLE. MUST NOT BE A CONSTANT (SEE CTOI).
# BASE			INTEGER CONSTANT OR INTEGER VARIABLE.
#
# EXAMPLE:
#
# I=1
# CHEXTI('A',I,16)		WILL RETURN THE INTEGER 10.
 
INTEGER FUNCTION CHEXTI(S1,I,BASE)
 
CHAR S1(ARB),DIGITS(17)
INTEGER BASE,I,J,INDEX
 
DATA DIGITS /'0','1','2','3','4','5','6','7','8','9','A','B',
 'C','D','E','F',EOS/
 
WHILE (S1(I) == BLANK ! S1(I) == TAB)	# SKIP LEADING BLANKS AND TABS
  I=I+1
 
FOR (CHEXTI=0; S1(I) <> EOS; I=I+1)[
  J = INDEX(DIGITS,S1(I))		# INDEX INTO <DIGIT> FOR DIGIT AT S1(I)
  IF(J == 0)				# IF CAN'T FIND ONE-
    BREAK				# DONE OR NONE.
  CHEXTI = BASE*CHEXTI + J - 1		# CONVERT TO INTEGER OF RADIX <BASE>
ENDFOR
 
RETURN
END
# * - MATCH - FIND MATCH ANYWHERE ON LINE
#
# FUNCTION WILL RETURN POSITION IN <LIN> OF THE FIRST IDENTICAL OCCURRENCE
# OF THE STRING IN <PAT> WITHIN <LIN>. IF MATCH FAILS, FUNCTION WILL
# RETURN <NO>.
#
#	FROM KERNIGHAN AND PLAUGER 'SOFTWARE TOOLS' PAGE 140.
#
# MATCH		MUST BE DECLARED INTEGER BY CALLING PROGRAM
# LIN		MUST BE STRING OF CHAR OR LITERAL
# PAT		MUST BE STRING OF CHAR OR LITERAL
 
INTEGER FUNCTION MATCH(LIN,PAT)
 
CHAR LIN(ARB),PAT(ARB)
INTEGER AMATCH,I
 
FOR (I=1; LIN(I) <> EOS; I=I+1)
  IF(AMATCH(LIN,I,PAT) >> 0)
    RETURN (I)			# RETURN POSITION IN LIN OF MATCH
  
RETURN (NO)			# IF FALL THRU FORLOOP, NO MATCH.
END
# * - AMATCH - WORK ROUTINE FOR MATCH WITH NO METACHARACTERS
#
# FROM KERNIGHAN AND PLAUGER 'SOFTWARE TOOLS' PAGE 140.
 
INTEGER FUNCTION AMATCH(LIN,FROM,PAT)
 
CHAR LIN(ARB),PAT(ARB)
INTEGER FROM,I,J
 
I=FROM
FOR (J =1; PAT(J) <> EOS; J=J+1)[
  IF(LIN(I) <> PAT(J))
    RETURN (0)				# WITH NO MATCH
  I=I+1
ENDFOR
 
RETURN (I)				# WITH MATCH
END
# * - APPEND - APPEND S2 ONTO END OF S1
#
# FUNCTION WILL CONCATENATE S2 ON THE END OF S1 <COUNT> TIMES AND
# RETURN THE NEW LENGTH OF S1.
#
# APPEND	MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR.  LITERAL NOT ALLOWED
#		NOTE THAT S1 MUST BE LARGE ENOUGH TO CONTAIN THE RESULT.
# S2		MUST BE STRING OF CHAR OR LITERAL.
# COUNT		MUST BE INTEGER OR INTEGER VARIABLE.
 
INTEGER FUNCTION APPEND(S1,S2,COUNT)
 
CHAR S1(ARB),S2(ARB)
INTEGER LENGTH,I,J,K
 
J=LENGTH(S2) +1			# FIND END OF S2
IF (COUNT <= 0)			# IF BAD COUNT PARAM
  RETURN (0)			# RETURN FAILURE
 
FOR (K=1; K <= COUNT; K=K+1)[	# DO COUNT TIMES
  I=LENGTH(S1) +1		# GET LENGTH OF S1
  CALL SCOPY(S2,1,S1,I,J)	# DO AN APPEND
ENDFOR
END
# * - REMOVE - REMOVE SUBSTRING FROM STRING <S1>
#
# FUNCTION WILL REMOVE A SUBSTRING FROM <S1> BEGINNING AT POSITION <FROM>
# THROUGH POSITION <TO>, AND RETURN THE NEW SIZE OF <S1>
#
# FUNCTION WILL FAIL IF <TO> IS LE <FROM> AND RETURN <EOS>
# FUNCTION WILL FAIL IF <FROM> IS GE LENGTH(S1) AND RETURN <EOS>
# IF <FROM> IS LE 1, <TO> CHARS WILL BE REMOVED FROM <S1> STARTING
# AT S1(1).
# IF <TO> GE LENGTH(S1), <S1> WILL BE TRUNCATED AT <FROM>
#
# REMOVE	MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED.
# FROM		MUST BE INTEGER OR INTEGER VARIABLE
# TO		MUST BE INTEGER OR INTEGER VARIABLE
 
INTEGER FUNCTION REMOVE(S1,FROM,TO)
 
CHAR S1(ARB)
INTEGER LENGTH,I,FROM,TO,SHIFT
 
I=LENGTH(S1)			# GET LENGTH
IF(TO <= FROM)			# IF TO TOO LOW
  RETURN (EOS)
ELSE IF (FROM >= I)		# IF FROM TOO BIG
  RETURN (EOS)
 
IF(TO >= I)			# IF REALLY WANT TO TRUNCATE
  S1(FROM)=EOS
ELSE IF (FROM <= 1)		# IF REALLY WANT TO SHIFT
  I=SHIFT(S1,TO)
ELSE[
  I=TO+1
  CALL SCOPY(S1,I,S1,FROM,ARB)
ENDELSE
I=LENGTH(S1)			# GET NEW LENGTH
RETURN (I)
END
# * - INSERT - INSERT <S2> INTO <S1> AFTER <FROM>.
#
# FUNCTION WILL INSERT STRING <S2> INTO <S1> AFTER S1(FROM) AND RETURN
# NEW LENGTH OF <S1>.
#
# IF <FROM> GE LENGTH(S1), <S2> WILL BE APPENDED TO <S1>
# IF <FROM> LT 1, <S2> WILL BE PREPENDED TO <S1>
#
# INSERT	MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED.
# S2		MUST BE STRING OF CHAR OR LITERAL.
# FROM		MUST BE INTEGER OR INTEGER VARIABLE.
 
INTEGER FUNCTION INSERT(S1,FROM,S2)
 
CHAR S1(ARB),S2(ARB),JUNK(ARB)
INTEGER FROM,I,APPEND,LENGTH
 
IF(FROM >= LENGTH(S1))[		# IF WANT TO APPEND
  I=APPEND(S1,S2,1)	# LET APPEND DO IT
  RETURN (I)
ENDIF
 
IF(FROM << 1)	# IF WANT TO PREPEND
  I=1
ELSE
  I=FROM+1
CALL SCOPY(S1,I,JUNK,1,ARB)	# COPY 2ND PART OF S1
CALL SCOPY(S2,1,S1,I,ARB)	# STICK IN S2
I=APPEND(S1,JUNK,1)		# AND REPLACE 2ND PART OF S1
RETURN (I)
END
# * - LPAD - LEFT PAD <N> BLANKS IN STRING <S1>
#
# FUNCTION INSERTS <N> BLANKS AT THE BEGINNING OF <S1> (PREPENDS),
# AND RETURNS NEW LENGTH OF <S1>.  IF <N> LT 1, NO BLANKS ARE
# PREPENDED AND LENGTH(S1) IS UNCHANGED.
#
# LPAD		MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED.
# N		MUST BE INTEGER OR INTEGER VARIABLE.
 
INTEGER FUNCTION LPAD(S1,N)
 
CHAR S1(ARB),JUNK(ARB)
INTEGER N,APPEND,LENGTH
IF (N << 1)			# IF N IS 0 OR LESS
  LPAD=LENGTH(S1)		# JUST RETURN SIZE OF S1
ELSE[
  CALL SCOPY(S1,1,JUNK,1,ARB)		# SAVE S1
  S1(1) = EOS				# NULL OUT S1
  LPAD=APPEND(S1,BLANK,N)			# MAKE N BLANKS
  LPAD=APPEND(S1,JUNK,1)			# AND ADD ORIGINAL S1
ENDELSE
 
RETURN
END
# * - RPAD - PAD END OF <S1> WITH BLANKS
#
# FUNCTION APPENDS <S1> WITH <N> SPACES AND RETURNS NEW SIZE OF S1.
# IF <N> LT 1, FUNCTION RETURNS ORIGINAL SIZE OF <S1> WITH NO PADDING DONE.
#
# RPAD		MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED
# N		MUST BE INTEGER OR INTEGER VARIABLE.
 
INTEGER FUNCTION RPAD(S1,N)
 
CHAR S1(ARB)
INTEGER APPEND,LENGTH
 
IF (N << 1)
  RPAD=LENGTH(S1)
ELSE
  RPAD=APPEND(S1,BLANK,N)		# PAD N TIMES
 
RETURN
END
# * - ALIGN - ALIGN <S1> TO RIGHT, LEFT, OR CENTER OF <FIELD>
#
# FUNCTION LEFT JUSTIFIES, RIGHT JUSTIFIES OR CENTERS <S1> IN A FIELD
# OF LENGTH <FIELD> DEPENDING ON VALUE OF <POS> AND RETURNS NEW LENGTH
# OF <S1>.  THIS IS ACCOMPLISHED BY PREPENDING THE CORRECT NUMBER OF
# SPACES ONTO <S1>.
#
# IF <FIELD> IS LE LENGTH(S1) FUNCTION WILL FAIL AND RETURN EOS
# IF <POS> IS LT 0 <S1> WILL BE LEFT JUSTIFIED (ANY LEADING BLANKS OR TABS
# WILL BE REMOVED.
# IF <POS> IS EQ 0 <S1> WILL BE CENTERED ON <FIELD>.
# IF <POS> IS GT 0 <S1> WILL BE RIGHT JUSTIFIED.
#
# ALIGN		MUST BE DECLARED INTEGER
# S1		MUST BE STRING OF CHAR - LITERAL NOT ALLOWED
# FIELD		MUST BE INTEGER OR INTEGER VARIABLE
# POS		MUST BE INTEGER OR INTEGER VARIABLE
 
INTEGER FUNCTION ALIGN(S1,POS,FIELD)
 
CHAR S1(ARB)
INTEGER LPAD,I,J,POS,FIELD,LENGTH,SHIFT
 
IF(FIELD <= LENGTH(S1))			# IF FIELD IS TOO SHORT
  RETURN (EOS)
 
IF (POS << 0)[				# IF WANT LEFT JUSTIFICATION
  REPEAT[				# GET RID OF LEADING BLANKS AND TABS
    IF(S1(1) <> BLANK .OR. S1(1) <> TAB)
      BREAK				# DONE IF NOT BLANK OR TAB
    ELSE
      I=SHIFT(S1,1)			# GET RID OF BLANK OR TAB
  ENDREPEAT UNTIL(S1(1) == EOS)		# IF FALL THRU - ENTIRE STRING WAS BLANK
ENDIF
 
ELSE IF (POS == 0)[			# IF WANT CENTER
  I=LENGTH(S1)/2			# FIND MIDPOINT OF S1
  I=(FIELD/2) - I			# FIND OUT HOW MANY LPADS
  J=LPAD(S1,I)				# CENTER S1
ENDELSE
 
ELSE[					# HERE IF WANT RIGHT JUSTIFICATION
  I=FIELD - LENGTH(S1)			# FIND OUT HOW MANY LPADS.
  J=LPAD(S1,I)
ENDELSE
 
ALIGN=LENGTH(S1)			# RETURN NEW LENGTH OF S1
RETURN
END