X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fadventure%2FGETIN.FT;fp=sw%2Fadventure%2FGETIN.FT;h=012a8f7294a9ce224e99dbcc34ae19867a936d1c;hb=84b5715c66b026062d9c455da3509b814bc32b1b;hp=0000000000000000000000000000000000000000;hpb=9107854b0bc70913de9757805c976b7442d88178;p=pdp8.git

diff --git a/sw/adventure/GETIN.FT b/sw/adventure/GETIN.FT
new file mode 100644
index 0000000..012a8f7
--- /dev/null
+++ b/sw/adventure/GETIN.FT
@@ -0,0 +1,95 @@
+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