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 IMPLICIT INTEGER (A-Z) COMMON /TXTCOM/ RTEXT,LINES,ASCVAR 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 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 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 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 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*1 FRST(20),BLANK,LCA,LCZ,UCA DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/ C TYPE 1 1 FORMAT(' >',$) 2 ACCEPT 3,FRST 3 FORMAT(20A1) C DO 5 I=1,20 IF((FRST(I).GE.LCA).AND.(FRST(I).LE.LCZ)) 1 FRST(I)=FRST(I)-LCA+UCA 5 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 END LOGICAL FUNCTION YES(X,Y,Z) 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. C IMPLICIT INTEGER (A-Z) COMMON /ALPHAS/ BLANK,EOF,CYE,CY,CNO,CN C 1 IF(X.NE.0)CALL RSPEAK(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 YES=.TRUE. IF(Y.NE.0)CALL RSPEAK(Y) RETURN 20 YES=.FALSE. IF(Z.NE.0)CALL RSPEAK(Z) RETURN END