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 C IF(BLKLIN.AND.NOINPT)TYPE 2 NOINPT=.TRUE. C ATTACH/DETACH THE TERMINAL SO CONTROL-O WILL WORK OK CALL TIATT 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 CALL TIDET 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 C NOINPT=.FALSE. 2 TYPE 1 1 FORMAT(1X,'}',$) READ (5,3,ERR=902) FRST 3 FORMAT(20A1) DO 399, IX1=1,20 C CONVERT LOWER-CASE TO UPPER CASE IX2=FRST(IX1) IF (IX2 .GE. 97 .AND. IX2 .LE. 122) FRST(IX1)=IX2-32 399 CONTINUE 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 C ERROR ON INPUT. MAYBE EOF.... REWIND & FORGET IT. 902 REWIND (5) GO TO 2 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