File: IOSUB.FT of Tape: Sources/Other/new-16

(Source file text) 

---

C  I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1)
C
C
	SUBROUTINE SPEAK(N)
C
C  PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE.
C  PRECEDE IT WITH A BLANK LINE UNLESS BLKLIN IS FALSE.
C
	IMPLICIT INTEGER (A-Z)
	LOGICAL BLKLIN,NOINPT
	COMMON /TXTCOM/ RTEXT,LINES,ASCVAR
	COMMON /BLKCOM/ BLKLIN,NOINPT
	COMMON /ALPHAS/ BLANK,EOF
	DIMENSION RTEXT(205),LINES(36)
C
	IF(N.EQ.0)RETURN
	READ(2'N) LOC,LINES
	IF(LINES(1).EQ.EOF)RETURN
	IF(BLKLIN.AND.NOINPT)TYPE 2
	NOINPT=.TRUE.
1	OLDLOC = LOC
	DO 3 I=36,1,-1
	L = I
	IF(LINES(I) .NE. BLANK) GO TO 5
3	CONTINUE
5	TYPE 2,(LINES(I),I=1,L)
2	FORMAT(' ',36A2)
	READ(2'ASCVAR) LOC,LINES
	IF(LOC .EQ. OLDLOC) GO TO 1
	RETURN
	END
C
C
C
	SUBROUTINE PSPEAK(MSG,SKIP)
C
C  FIND THE SKIP+1ST MESSAGE FOR OBJECT MSG AND PRINT IT.
C  MSG SHOULD BE THE INDEX OF
C  THE OBJECT.  (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).
C
	IMPLICIT INTEGER (A-Z)
	COMMON /TXTCOM/ RTEXT,LINES,ASCVAR
	COMMON /PTXCOM/ PTEXT
	DIMENSION RTEXT(205),LINES(36),PTEXT(100)
C
	M=PTEXT(MSG)
	IF(SKIP.LT.0)GOTO 9
	OLDLOC=MSG
	DO 3 I=1,SKIP+1
1	READ(2'M)LOC,LINES
	M = ASCVAR
	IF(LOC.EQ.OLDLOC) GO TO 1
	OLDLOC=LOC
3	CONTINUE
	M=M-1
9	CALL SPEAK(M)
	RETURN
	END
C
C
C
	SUBROUTINE RSPEAK(I)
C
C  PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE).
C
	IMPLICIT INTEGER (A-Z)
	COMMON /TXTCOM/ RTEXT
	DIMENSION RTEXT(205)
C
	IF(I.NE.0)CALL SPEAK(RTEXT(I))
	RETURN
	END
C
C
C
C
C	SUBROUTINE MSPEAK(I)
C
C  PRINT THE I-TH "MAGIC" MESSAGE FROM SECTION 12 OF DATABASE
C
C	IMPLICIT INTEGER (A-Z)
C	COMMON /MTXCOM/ MTEXT
C	DIMENSION MTEXT (35)
C
C	IF(I.NE.0) CALL SPEAK(MTEXT(I))
C	RETURN
C	END
C
C
	SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)
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.
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
	IMPLICIT INTEGER (A-Z)
	LOGICAL BLKLIN,NOINPT
	LOGICAL*1 FRST(20),BLANK,BLANK1
	COMMON /BLKCOM/ BLKLIN,NOINPT
	DATA BLANK/' '/
C
	NOINPT=.FALSE.
	IF(BLKLIN)TYPE 1
1	FORMAT(1X)
2	ACCEPT 3,FRST
3	FORMAT(20A1)
	ST2 = 1
	IX1 = 0
	IX2 = 0
	I = 0
10	I = I + 1
	IF(I .GT. 20) GO TO 2
	IF(FRST(I) .EQ. BLANK) GO TO 10
15	IX1 = IX1 + 1
	I = I + 1
	IF(I .GT. 20) GO TO 500
	IF(FRST(I) .NE. BLANK) GO TO 15
20	I = I + 1
	IF(I .GT. 20) GO TO 500
	IF(FRST(I) .EQ. BLANK) GO TO 20
	ST2 = I
25	IX2 = IX2 + 1
	I = I + 1
	IF(I .GT. 20) GO TO 500
	IF(FRST(I) .NE. BLANK) GO TO 25
500	IX1 = MIN0(6,IX1)
	IX2 = MIN0(6,IX2)
	DECODE(IX1,99,FRST) WORD1,WORD1A,WORD1X
99	FORMAT(3A2)
	WORD2 = 0
	IF(IX2 .EQ. 0) RETURN
	DO 30 I=1,IX2
30	FRST(I)=FRST(ST2+I-1)
	DECODE(IX2,99,FRST) WORD2,WORD2A,WORD2X
	RETURN
C
	END
C
C
C
	LOGICAL FUNCTION YES(X,Y,Z)
C
C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6.
C
	IMPLICIT INTEGER (A-Z)
	EXTERNAL RSPEAK
	LOGICAL YESX
C
	YES=YESX(X,Y,Z,RSPEAK)
	RETURN
	END
C
C
C
C	LOGICAL FUNCTION YESM(X,Y,Z)
C
C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12.
C
C	IMPLICIT INTEGER (A-Z)
C	EXTERNAL MSPEAK
C	LOGICAL YESX
C
C	YESM=YESX(X,Y,Z,MSPEAK)
C	RETURN
C	END
C
C
C
	LOGICAL FUNCTION YESX(X,Y,Z,SPK)
C
C  PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  IF YES, PRINT Y AND LEAVE YEA
C  TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE.  SPK IS EITHER RSPEAK OR MSPEAK.
C
	IMPLICIT INTEGER (A-Z)
	COMMON /ALPHAS/ BLANK,EOF,CYE,CY,CNO,CN
C
1	IF(X.NE.0)CALL SPK(X)
	CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3,JUNK4,JUNK5)
	IF(REPLY.EQ.CYE .OR. REPLY.EQ.CY)GOTO 10
	IF(REPLY.EQ.CNO .OR. REPLY.EQ.CN)GOTO 20
	TYPE 9
9	FORMAT(/' PLEASE ANSWER THE QUESTION.')
	GOTO 1
10	YESX=.TRUE.
	IF(Y.NE.0)CALL SPK(Y)
	RETURN
20	YESX=.FALSE.
	IF(Z.NE.0)CALL SPK(Z)
	RETURN
	END

---