sw/adventure/GETIN.FT

   1 C WAS SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)
   2 C OS/8 version returns 4 chars in the first word of each command entity
   3 C
   4 C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH
   5 C  BLANKS, AND RETURN IT IN WORD1 AND WORD1A. (for OS/8, WORD1)
   6 C  CHARS 5  AND 6 ARE RETURNED IN WORD1X, IN
   7 C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF
   8 C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN
   9 C  WORD2 AND WORD2A (CHARS 5 AND 68 IN WORD2X), ELSE WORD2 IS SET TO ZERO.
  10 C  (for OS/8, WORD2 and WORD2X).
  11 C
  12 C       IMPLICIT INTEGER (A-Z)
  13 C       LOGICAL*1 FRST(20),BLANK,LCA,LCZ,UCA
  14 C       DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/
  15
  16         SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)
  17         INTEGER INPUT(20),WORD1,WORD1X
  18         INTEGER WORD2,WORD2X
  19
  20 10      WRITE(4,1)
  21 1       FORMAT(' > ',$)
  22 C       READ(4,2)INPUT
  23 C2      FORMAT(20A1)
  24         CALL RDLINE(INPUT, 20)
  25         WORD1 = ' '
  26         WORD1X = ' '
  27         WORD2 = ' '
  28         WORD2X = ' '
  29
  30         DO 15 I=1,20
  31 C Using INT here to normalize the input values
  32         J = INT(INPUT(I))
  33 15      INPUT(I) = J
  34         IX1=0
  35         IX2=0
  36         I=0
  37 C
  38 C Find first nonblank
  39 C
  40 20      I=I+1
  41         IF(I.GT.20)GOTO 10
  42         IF(INPUT(I).EQ.32)GOTO 20
  43 C
  44 C Move four characters to WORD1
  45 C
  46         DO 30 IX1 = 1, 4
  47         CALL CPUT(WORD1, IX1, INPUT(I))
  48         I=I+1
  49         IF(I.GT.20)GOTO 100
  50 C
  51 C If blank, go to word 2
  52 C
  53         IF(INPUT(I) .EQ. 32) GOTO 50
  54 30      CONTINUE
  55 C
  56 C Move two characters to WORD1X
  57 C
  58         DO 40 IX1 = 1, 20
  59         IF (IX1 .GT. 2) GOTO 35
  60         CALL CPUT(WORD1X, IX1, INPUT(I))
  61 35      I=I+1
  62         IF(I.GT.20)GOTO 100
  63         IF(INPUT(I).EQ.32)GOTO 50
  64 40      CONTINUE
  65
  66 C
  67 C Find next nonblank
  68 C
  69 50      I = I + 1
  70         IF(I.GT.20) GOTO 100
  71         IF (INPUT(I).EQ. 32)GOTO 50
  72
  73 C
  74 C Move four to WORD2
  75 C
  76         DO 60 IX1 = 1,4
  77         CALL CPUT(WORD2, IX1, INPUT(I))
  78         I = I + 1
  79         IF (I.GT.20) GOTO 100
  80         IF (INPUT(I).EQ. 32) GOTO 100
  81 60      CONTINUE
  82 C
  83 C Move to to WORD2X
  84 C
  85         DO 70 IX1 = 1,2
  86         CALL CPUT(WORD2X, IX1, INPUT(I))
  87         I = I + 1
  88         IF (I.GT.20) GOTO 100
  89         IF(INPUT(I).EQ.32) GOTO 100
  90 70      CONTINUE
  91 100     IF (WORD2 .NE. ' ') RETURN
  92         WORD2 = 0
  93         WORD2X = 0
  94         RETURN
  95         END