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, 20 IF (IX1 .GT. 2) GOTO 35 CALL CPUT(WORD1X, IX1, INPUT(I)) 35 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