C I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1) SUBROUTINE SPEAK(N) C PRINT THE MESSAGE IN RECORD N OF THE RANDOM ACCESS MESSAGE FILE. C PRECEDE IT WITH A BLANK LINE UNLESS BLKLIN IS FALSE. IMPLICIT INTEGER*4(A-Z) C INTEGER*2 RTEXT,ASCVAR,N LOGICAL BLKLIN COMMON /TXTCOM/ RTEXT,LINES,ASCVAR COMMON /BLKCOM/ BLKLIN DIMENSION RTEXT(205),LINES(18) IF(N.EQ.0)RETURN READ(2'N) LOC,LINES IF(LINES(2).EQ.'>$<')RETURN IF(BLKLIN)TYPE 2 1 OLDLOC = LOC DO 3 I=18,1,-1 L = I IF(LINES(I) .NE. ' ') GO TO 5 3 CONTINUE 5 TYPE 2,(LINES(I),I=1,L) 2 FORMAT(' ',18A4) READ(2'ASCVAR) LOC,LINES IF(LOC .EQ. OLDLOC) GO TO 1 RETURN END SUBROUTINE PSPEAK(MSG,SKIP) C FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT. MSG SHOULD BE THE INDEX OF C THE INVENTORY MESSAGE FOR OBJECT. (INVEN+N+1 MESSAGE IS PROP=N MESSAGE). IMPLICIT INTEGER*4(A-Z) C INTEGER*2 RTEXT,PTEXT,ASCVAR COMMON /TXTCOM/ RTEXT,LINES,ASCVAR COMMON /PTXCOM/ PTEXT DIMENSION RTEXT(205),LINES(18),PTEXT(100) M=PTEXT(MSG) IF(SKIP.LT.0)GOTO 9 DO 3 I=1,SKIP+1 1 READ(2'M)LOC,LINES 3 M = ASCVAR 9 CALL SPEAK(M) RETURN END SUBROUTINE RSPEAK(I) C PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE). IMPLICIT INTEGER*4(A-Z) C INTEGER*2 RTEXT,ASCVAR COMMON /TXTCOM/ RTEXT DIMENSION RTEXT(205) IF(I.NE.0)CALL SPEAK(RTEXT(I)) RETURN END SUBROUTINE MSPEAK(I) C PRINT THE I-TH "MAGIC" MESSAGE (SECTION 12 OF DATABASE). IMPLICIT INTEGER*4(A-Z) C INTEGER*2 MTEXT,ASCVAR COMMON /MTXCOM/ MTEXT DIMENSION MTEXT(35) IF(I.NE.0)CALL SPEAK(MTEXT(I)) RETURN END SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X) C GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD, PAD IT WITH C BLANKS, AND RETURN IT IN WORD1. CHARS 5 THRU 8 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 (CHARS 5 THRU 8 IN WORD2X), ELSE WORD2 IS SET TO ZERO. IMPLICIT INTEGER*4(A-Z) C INTEGER*2 ASCVAR LOGICAL BLKLIN LOGICAL*1 FRST(20) COMMON /BLKCOM/ BLKLIN IF(BLKLIN)TYPE 1 1 FORMAT() 2 ACCEPT 3,K,FRST 3 FORMAT(Q,20A1) ST2 = 1 IX1 = 0 IX2 = 0 I = 0 10 I = I + 1 IF(I .GT. 20) GO TO 2 IF(FRST(I) .EQ. ' ') GO TO 10 15 IX1 = IX1 + 1 I = I + 1 IF(I .GT. 20) GO TO 500 IF(FRST(I) .NE. ' ') GO TO 15 20 I = I + 1 IF(I .GT. 20) GO TO 500 IF(FRST(I) .EQ. ' ') GO TO 20 ST2 = I 25 IX2 = IX2 + 1 I = I + 1 IF(I .GT. 20) GO TO 500 IF(FRST(I) .NE. ' ') GO TO 25 500 IX1 = MIN0(8,IX1) IX2 = MIN0(8,IX2) DECODE(IX1,99,FRST) WORD1,WORD1X 99 FORMAT(2A4) WORD2 = 0 IF(IX2 .EQ. 0) RETURN DECODE(IX2,99,FRST(ST2)) WORD2,WORD2X RETURN END LOGICAL FUNCTION YES(X,Y,Z) C CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6. IMPLICIT INTEGER*4(A-Z) C INTEGER*2 ASCVAR EXTERNAL RSPEAK LOGICAL YESX YES=YESX(X,Y,Z,RSPEAK) RETURN END LOGICAL FUNCTION YESM(X,Y,Z) C CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12. IMPLICIT INTEGER*4(A-Z) C INTEGER*2 ASCVAR EXTERNAL MSPEAK LOGICAL YESX YESM=YESX(X,Y,Z,MSPEAK) RETURN END LOGICAL FUNCTION YESX(X,Y,Z,SPK) 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. IMPLICIT INTEGER*4(A-Z) C INTEGER*2 ASCVAR 1 IF(X.NE.0)CALL SPK(X) CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3) IF(REPLY.EQ.'YES'.OR.REPLY.EQ.'Y')GOTO 10 IF(REPLY.EQ.'NO'.OR.REPLY.EQ.'N')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