File: GETIN.FT of Disk: V50/Source/Source-Listing-FORTRAN-2

(Source file text) 

---

C WAS SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)
C OS/8 version returns 4 chars in the first word of each command entity
C
C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH
C  BLANKS, AND RETURN IT IN WORD1 AND WORD1A. (for OS/8, WORD1)
C  CHARS 5  AND 6 ARE RETURNED IN WORD1X, IN
C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF
C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN
C  WORD2 AND WORD2A (CHARS 5 AND 68 IN WORD2X), ELSE WORD2 IS SET TO ZERO.
C  (for OS/8, WORD2 and WORD2X).
C
C	IMPLICIT INTEGER (A-Z)
C	LOGICAL*1 FRST(20),BLANK,LCA,LCZ,UCA
C	DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/

	SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)
	INTEGER INPUT(20),WORD1,WORD1X
	INTEGER WORD2,WORD2X

10	WRITE(4,1)
1	FORMAT(' > ',$)
C	READ(4,2)INPUT
C2	FORMAT(20A1)
	CALL RDLINE(INPUT, 20)
	WORD1 = ' '
	WORD1X = ' '
	WORD2 = ' '
	WORD2X = ' '

	DO 15 I=1,20
C Using INT here to normalize the input values
	J = INT(INPUT(I))
15	INPUT(I) = J
	IX1=0
	IX2=0
	I=0
C
C Find first nonblank
C
20	I=I+1
	IF(I.GT.20)GOTO 10
	IF(INPUT(I).EQ.32)GOTO 20
C
C Move four characters to WORD1
C
	DO 30 IX1 = 1, 4
	CALL CPUT(WORD1, IX1, INPUT(I))
	I=I+1
	IF(I.GT.20)GOTO 100
C
C If blank, go to word 2
C
	IF(INPUT(I) .EQ. 32) GOTO 50
30	CONTINUE
C
C Move two characters to WORD1X
C
	DO 40 IX1 = 1, 2
	CALL CPUT(WORD1X, IX1, INPUT(I))
	I=I+1
	IF(I.GT.20)GOTO 100
	IF(INPUT(I).EQ.32)GOTO 50
40	CONTINUE

C
C Find next nonblank
C
50	I = I + 1
	IF(I.GT.20) GOTO 100
	IF (INPUT(I).EQ. 32)GOTO 50

C
C Move four to WORD2
C
	DO 60 IX1 = 1,4
	CALL CPUT(WORD2, IX1, INPUT(I))
	I = I + 1
	IF (I.GT.20) GOTO 100
	IF (INPUT(I).EQ. 32) GOTO 100
60	CONTINUE
C
C Move to to WORD2X
C
	DO 70 IX1 = 1,2
	CALL CPUT(WORD2X, IX1, INPUT(I))
	I = I + 1
	IF (I.GT.20) GOTO 100
	IF(INPUT(I).EQ.32) GOTO 100
70	CONTINUE
100	IF (WORD2 .NE. ' ') RETURN
	WORD2 = 0
	WORD2X = 0
	RETURN
	END

---