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