adventure: Initial commit

[pdp8.git] / sw / adventure / GETIN.FT

diff --git a/sw/adventure/GETIN.FT b/sw/adventure/GETIN.FT
new file mode 100644 (file)
index 0000000..012a8f7
--- /dev/null
+++ b/sw/adventure/GETIN.FT
@@ -0,0 +1,95 @@
+C WAS SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)\r
+C OS/8 version returns 4 chars in the first word of each command entity\r
+C\r
+C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH\r
+C  BLANKS, AND RETURN IT IN WORD1 AND WORD1A. (for OS/8, WORD1)\r
+C  CHARS 5  AND 6 ARE RETURNED IN WORD1X, IN\r
+C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF\r
+C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN\r
+C  WORD2 AND WORD2A (CHARS 5 AND 68 IN WORD2X), ELSE WORD2 IS SET TO ZERO.\r
+C  (for OS/8, WORD2 and WORD2X).\r
+C\r
+C      IMPLICIT INTEGER (A-Z)\r
+C      LOGICAL*1 FRST(20),BLANK,LCA,LCZ,UCA\r
+C      DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/\r
+\r
+       SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)\r
+       INTEGER INPUT(20),WORD1,WORD1X\r
+       INTEGER WORD2,WORD2X\r
+\r
+10     WRITE(4,1)\r
+1      FORMAT(' > ',$)\r
+C      READ(4,2)INPUT\r
+C2     FORMAT(20A1)\r
+       CALL RDLINE(INPUT, 20)\r
+       WORD1 = ' '\r
+       WORD1X = ' '\r
+       WORD2 = ' '\r
+       WORD2X = ' '\r
+\r
+       DO 15 I=1,20\r
+C Using INT here to normalize the input values\r
+       J = INT(INPUT(I))\r
+15     INPUT(I) = J\r
+       IX1=0\r
+       IX2=0\r
+       I=0\r
+C\r
+C Find first nonblank\r
+C\r
+20     I=I+1\r
+       IF(I.GT.20)GOTO 10\r
+       IF(INPUT(I).EQ.32)GOTO 20\r
+C\r
+C Move four characters to WORD1\r
+C\r
+       DO 30 IX1 = 1, 4\r
+       CALL CPUT(WORD1, IX1, INPUT(I))\r
+       I=I+1\r
+       IF(I.GT.20)GOTO 100\r
+C\r
+C If blank, go to word 2\r
+C\r
+       IF(INPUT(I) .EQ. 32) GOTO 50\r
+30     CONTINUE\r
+C\r
+C Move two characters to WORD1X\r
+C\r
+       DO 40 IX1 = 1, 20\r
+       IF (IX1 .GT. 2) GOTO 35\r
+       CALL CPUT(WORD1X, IX1, INPUT(I))\r
+35     I=I+1\r
+       IF(I.GT.20)GOTO 100\r
+       IF(INPUT(I).EQ.32)GOTO 50\r
+40     CONTINUE\r
+\r
+C\r
+C Find next nonblank\r
+C\r
+50     I = I + 1\r
+       IF(I.GT.20) GOTO 100\r
+       IF (INPUT(I).EQ. 32)GOTO 50\r
+\r
+C\r
+C Move four to WORD2\r
+C\r
+       DO 60 IX1 = 1,4\r
+       CALL CPUT(WORD2, IX1, INPUT(I))\r
+       I = I + 1\r
+       IF (I.GT.20) GOTO 100\r
+       IF (INPUT(I).EQ. 32) GOTO 100\r
+60     CONTINUE\r
+C\r
+C Move to to WORD2X\r
+C\r
+       DO 70 IX1 = 1,2\r
+       CALL CPUT(WORD2X, IX1, INPUT(I))\r
+       I = I + 1\r
+       IF (I.GT.20) GOTO 100\r
+       IF(INPUT(I).EQ.32) GOTO 100\r
+70     CONTINUE\r
+100    IF (WORD2 .NE. ' ') RETURN\r
+       WORD2 = 0\r
+       WORD2X = 0\r
+       RETURN\r
+       END\r