# 2.11BSD#431 - /usr/src/new/PORT/dungeon/sverbs.F

       1: C SVERBS-	SIMPLE VERBS PROCESSOR
       2: C	ALL VERBS IN THIS ROUTINE MUST BE INDEPENDANT
       3: C	OF OBJECT ACTIONS
       4: C
       5: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
       6: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
       7: C WRITTEN BY R. M. SUPNIK
       8: C
       9: C DECLARATIONS
      10: C
      11:         LOGICAL FUNCTION SVERBS(RI)
      12:         IMPLICIT INTEGER (A-Z)
      13:         LOGICAL MOVETO,YESNO
      14:         LOGICAL RMDESC
      15:         LOGICAL QOPEN
      16:         LOGICAL FINDXT,QHERE,F
      17:         INTEGER JOKES(25)
      18:         CHARACTER ANSSTR(78)
      19:         CHARACTER PP1(6),PP2(6),CH(6)
      20:         INTEGER ANSWER(28)
      21: #include "parser.h"
      22: #include "gamestate.h"
      23: #include "state.h"
      24: #include "screen.h"
      25: C
      26: C MISCELLANEOUS VARIABLES
      27: C
      28:         CHARACTER VEDIT
      29:         COMMON /VERS/ VMAJ,VMIN,VEDIT
      30: #include "io.h"
      31: #include "rooms.h"
      32: #include "rflag.h"
      33: #include "rindex.h"
      34: #include "exits.h"
      35: #include "curxt.h"
      36: #include "xpars.h"
      37: #include "xsrch.h"
      38: #include "objects.h"
      39: #include "oflags.h"
      40: #include "oindex.h"
      41: #include "clock.h"
      42:
      43: #include "advers.h"
      44: #include "verbs.h"
      45: #include "flags.h"
      46: C
      47: C FUNCTIONS AND DATA
      48: C
      49:         QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
      50:         DATA MXNOP/39/,MXJOKE/64/
      51:         DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
      52: &               313,5314,5319,324,325,883,884,120,120,0,0,0,0/
      53:         DATA ANSWER/0,6,1,6,2,5,3,5,4,3,4,6,4,6,4,5,
      54: &               5,5,5,4,5,6,6,10,7,4,7,6/
      55:         DATA ANSSTR/'T','E','M','P','L','E',
      56: &               'F','O','R','E','S','T',
      57: &               '3','0','0','0','3',
      58: &               'F','L','A','S','K',
      59: &               'R','U','B',
      60: &               'F','O','N','D','L','E',
      61: &               'C','A','R','R','E','S',
      62: &               'T','O','U','C','H',
      63: &               'B','O','N','E','S',
      64: &               'B','O','D','Y',
      65: &               'S','K','E','L','E','T',
      66: &               'R','U','S','T','Y','K','N','I','F','E',
      67: &               'N','O','N','E',
      68: &               'N','O','W','H','E','R','\0'/
      69: C SVERBS, PAGE 2
      70: C
      71:         SVERBS=.TRUE.
      72: C						!ASSUME WINS.
      73:         IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
      74: C						!SET UP DESCRIPTORS.
      75:         IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
      76: C
      77:         IF(RI.EQ.0) CALL BUG(7,RI)
      78: C						!ZERO IS VERBOTEN.
      79:         IF(RI.LE.MXNOP) RETURN
      80: C						!NOP?
      81:         IF(RI.LE.MXJOKE) GO TO 100
      82: C						!JOKE?
      83:         GO TO (65000,66000,67000,68000,69000,
      84: &        1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
      85: &        11000,12000,13000,14000,15000,16000,17000,18000,19000,20000,
      86: &        21000,22000,23000,24000,25000,26000,27000),
      87: &               (RI-MXJOKE)
      88:         CALL BUG(7,RI)
      89: C
      90: C ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
      91: C
      92: 10      SVERBS=.FALSE.
      93: C						!LOSE.
      94:         RETURN
      95: C
      96: C JOKE PROCESSOR.
      97: C FIND PROPER ENTRY IN JOKES, USE IT TO SELECT STRING TO PRINT.
      98: C
      99: 100     I=JOKES(RI-MXNOP)
     100: C						!GET TABLE ENTRY.
     101:         J=I/1000
     102: C						!ISOLATE # STRINGS.
     103:         IF(J.NE.0) I=MOD(I,1000)+RND(J)
     104: C						!IF RANDOM, CHOOSE.
     105:         CALL RSPEAK(I)
     106: C						!PRINT JOKE.
     107:         RETURN
     108: C SVERBS, PAGE 2A
     109: C
     110: C V65--	ROOM
     111: C
     112: 65000   SVERBS=RMDESC(2)
     113: C						!DESCRIBE ROOM ONLY.
     114:         RETURN
     115: C
     116: C V66--	OBJECTS
     117: C
     118: 66000   SVERBS=RMDESC(1)
     119: C						!DESCRIBE OBJ ONLY.
     120:         IF(.NOT.TELFLG) CALL RSPEAK(138)
     121: C						!NO OBJECTS.
     122:         RETURN
     123: C
     124: C V67--	RNAME
     125: C
     126: 67000   CALL RSPEAK(RDESC2-HERE)
     127: C						!SHORT ROOM NAME.
     128:         RETURN
     129: C
     130: C V68--	RESERVED
     131: C
     132: 68000   RETURN
     133: C
     134: C V69--	RESERVED
     135: C
     136: 69000   RETURN
     137: C SVERBS, PAGE 3
     138: C
     139: C V70--	BRIEF.  SET FLAG.
     140: C
     141: 1000    BRIEFF=.TRUE.
     142: C						!BRIEF DESCRIPTIONS.
     143:         SUPERF=.FALSE.
     144:         CALL RSPEAK(326)
     145:         RETURN
     146: C
     147: C V71--	VERBOSE.  CLEAR FLAGS.
     148: C
     149: 2000    BRIEFF=.FALSE.
     150: C						!LONG DESCRIPTIONS.
     151:         SUPERF=.FALSE.
     152:         CALL RSPEAK(327)
     153:         RETURN
     154: C
     155: C V72--	SUPERBRIEF.  SET FLAG.
     156: C
     157: 3000    SUPERF=.TRUE.
     158:         CALL RSPEAK(328)
     159:         RETURN
     160: C
     161: C V73-- STAY (USED IN ENDGAME).
     162: C
     163: 4000    IF(WINNER.NE.AMASTR) GO TO 4100
     164: C						!TELL MASTER, STAY.
     165:         CALL RSPEAK(781)
     166: C						!HE DOES.
     167:         CTICK(CEVFOL)=0
     168: C						!NOT FOLLOWING.
     169:         RETURN
     170: C
     171: 4100    IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)
     172: C						!JOKE.
     173:         RETURN
     174: C
     175: C V74--	VERSION.  PRINT INFO.
     176: C
     177: #ifdef PDP
     178: 5000    call prvers(vmaj,vmin,vedit)
     179: #else
     180: 5000    WRITE(OUTCH,5010) VMAJ,VMIN,VEDIT
     181: #ifdef NOCC
     182: 5010    FORMAT('V',I1,'.',I2,A1)
     183: #else NOCC
     184: 5010    FORMAT(' V',I1,'.',I2,A1)
     185: #endif NOCC
     186: #endif PDP
     187:         TELFLG=.TRUE.
     188:         RETURN
     189: C
     190: C V75--	SWIM.  ALWAYS A JOKE.
     191: C
     192: 6000    I=330
     193: C						!ASSUME WATER.
     194:         IF(and(RFLAG(HERE),(RWATER+RFILL)).EQ.0)
     195: &               I=331+RND(3)
     196:         CALL RSPEAK(I)
     197:         RETURN
     198: C
     199: C V76--	GERONIMO.  IF IN BARREL, FATAL, ELSE JOKE.
     200: C
     201: 7000    IF(HERE.EQ.MBARR) GO TO 7100
     202: C						!IN BARREL?
     203:         CALL RSPEAK(334)
     204: C						!NO, JOKE.
     205:         RETURN
     206: C
     207: 7100    CALL JIGSUP(335)
     208: C						!OVER FALLS.
     209:         RETURN
     210: C
     211: C V77--	SINBAD ET AL.  CHASE CYCLOPS, ELSE JOKE.
     212: C
     213: 8000    IF((HERE.EQ.MCYCL).AND.QHERE(CYCLO,HERE)) GO TO 8100
     214:         CALL RSPEAK(336)
     215: C						!NOT HERE, JOKE.
     216:         RETURN
     217: C
     218: 8100    CALL NEWSTA(CYCLO,337,0,0,0)
     219: C						!CYCLOPS FLEES.
     220:         CYCLOF=.TRUE.
     221: C						!SET ALL FLAGS.
     222:         MAGICF=.TRUE.
     223:         OFLAG2(CYCLO)=and(OFLAG2(CYCLO), not(FITEBT))
     224:         RETURN
     225: C
     226: C V78--	WELL.  OPEN DOOR, ELSE JOKE.
     227: C
     228: 9000    IF(RIDDLF.OR.(HERE.NE.RIDDL)) GO TO 9100
     229: C						!IN RIDDLE ROOM?
     230:         RIDDLF=.TRUE.
     231: C						!YES, SOLVED IT.
     232:         CALL RSPEAK(338)
     233:         RETURN
     234: C
     235: 9100    CALL RSPEAK(339)
     236: C						!WELL, WHAT?
     237:         RETURN
     238: C
     239: C V79--	PRAY.  IF IN TEMP2, POOF
     240: C						!
     241: C
     242: 10000   IF(HERE.NE.TEMP2) GO TO 10050
     243: C						!IN TEMPLE?
     244:         IF(MOVETO(FORE1,WINNER)) GO TO 10100
     245: C						!FORE1 STILL THERE?
     246: 10050   CALL RSPEAK(340)
     247: C						!JOKE.
     248:         RETURN
     249: C
     250: 10100   F=RMDESC(3)
     251: C						!MOVED, DESCRIBE.
     252:         RETURN
     253: C
     254: C V80--	TREASURE.  IF IN TEMP1, POOF
     255: C						!
     256: C
     257: 11000   IF(HERE.NE.TEMP1) GO TO 11050
     258: C						!IN TEMPLE?
     259:         IF(MOVETO(TREAS,WINNER)) GO TO 10100
     260: C						!TREASURE ROOM THERE?
     261: 11050   CALL RSPEAK(341)
     262: C						!NOTHING HAPPENS.
     263:         RETURN
     264: C
     265: C V81--	TEMPLE.  IF IN TREAS, POOF
     266: C						!
     267: C
     268: 12000   IF(HERE.NE.TREAS) GO TO 12050
     269: C						!IN TREASURE?
     270:         IF(MOVETO(TEMP1,WINNER)) GO TO 10100
     271: C						!TEMP1 STILL THERE?
     272: 12050   CALL RSPEAK(341)
     273: C						!NOTHING HAPPENS.
     274:         RETURN
     275: C
     276: C V82--	BLAST.  USUALLY A JOKE.
     277: C
     278: 13000   I=342
     279: C						!DONT UNDERSTAND.
     280:         IF(PRSO.EQ.SAFE) I=252
     281: C						!JOKE FOR SAFE.
     282:         CALL RSPEAK(I)
     283:         RETURN
     284: C
     285: C V83--	SCORE.  PRINT SCORE.
     286: C
     287: 14000   CALL SCORE(.FALSE.)
     288:         RETURN
     289: C
     290: C V84--	QUIT.  FINISH OUT THE GAME.
     291: C
     292: 15000   CALL SCORE(.TRUE.)
     293: C						!TELLL SCORE.
     294:         IF(.NOT.YESNO(343,0,0)) RETURN
     295: C						!ASK FOR Y/N DECISION.
     296: #ifdef PDP
     297: C	close routine moved to exit for pdp version
     298: #else
     299:         CLOSE (DBCH)
     300: #endif PDP
     301:         CALL EXIT
     302: C						!BYE.
     303: C SVERBS, PAGE 4
     304: C
     305: C V85--	FOLLOW (USED IN ENDGAME)
     306: C
     307: 16000   IF(WINNER.NE.AMASTR) RETURN
     308: C						!TELL MASTER, FOLLOW.
     309:         CALL RSPEAK(782)
     310:         CTICK(CEVFOL)=-1
     311: C						!STARTS FOLLOWING.
     312:         RETURN
     313: C
     314: C V86--	WALK THROUGH
     315: C
     316: 17000   IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
     317: &               ((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 17100
     318:         SCOLAC=SCOLRM
     319: C						!WALKED THRU SCOL.
     320:         PRSO=0
     321: C						!FAKE OUT FROMDR.
     322:         CTICK(CEVSCL)=6
     323: C						!START ALARM.
     324:         CALL RSPEAK(668)
     325: C						!DISORIENT HIM.
     326:         F=MOVETO(SCOLRM,WINNER)
     327: C						!INTO ROOM.
     328:         F=RMDESC(3)
     329: C						!DESCRIBE.
     330:         RETURN
     331: C
     332: 17100   IF(HERE.NE.SCOLAC) GO TO 17300
     333: C						!ON OTHER SIDE OF SCOL?
     334:         DO 17200 I=1,12,3
     335: C						!WALK THRU PROPER WALL?
     336:           IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
     337: &               GO TO 17500
     338: 17200   CONTINUE
     339: C
     340: 17300   IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 17400
     341:         I=669
     342: C						!NO, JOKE.
     343:         IF(PRSO.EQ.SCOL) I=670
     344: C						!SPECIAL JOKE FOR SCOL.
     345:         CALL RSPSUB(I,ODO2)
     346:         RETURN
     347: C
     348: 17400   I=671
     349: C						!JOKE.
     350:         IF(OROOM(PRSO).NE.0) I=552+RND(5)
     351: C						!SPECIAL JOKES IF CARRY.
     352:         CALL RSPEAK(I)
     353:         RETURN
     354: C
     355: 17500   PRSO=SCOLWL(I+2)
     356: C						!THRU SCOL WALL...
     357:         DO 17600 I=1,8,2
     358: C						!FIND MATCHING ROOM.
     359:           IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
     360: 17600   CONTINUE
     361: C						!DECLARE NEW SCOLRM.
     362:         CTICK(CEVSCL)=0
     363: C						!CANCEL ALARM.
     364:         CALL RSPEAK(668)
     365: C						!DISORIENT HIM.
     366:         F=MOVETO(BKBOX,WINNER)
     367: C						!BACK IN BOX ROOM.
     368:         F=RMDESC(3)
     369:         RETURN
     370: C
     371: C V87--	RING.  A JOKE.
     372: C
     373: 18000   I=359
     374: C						!CANT RING.
     375:         IF(PRSO.EQ.BELL) I=360
     376: C						!DING, DONG.
     377:         CALL RSPEAK(I)
     378: C						!JOKE.
     379:         RETURN
     380: C
     381: C V88--	BRUSH.  JOKE WITH OBSCURE TRAP.
     382: C
     383: 19000   IF(PRSO.EQ.TEETH) GO TO 19100
     384: C						!BRUSH TEETH?
     385:         CALL RSPEAK(362)
     386: C						!NO, JOKE.
     387:         RETURN
     388: C
     389: 19100   IF(PRSI.NE.0) GO TO 19200
     390: C						!WITH SOMETHING?
     391:         CALL RSPEAK(363)
     392: C						!NO, JOKE.
     393:         RETURN
     394: C
     395: 19200   IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
     396: &               GO TO 19300
     397:         CALL RSPSUB(364,ODI2)
     398: C						!NO, JOKE.
     399:         RETURN
     400: C
     401: 19300   CALL JIGSUP(365)
     402: C						!YES, DEAD
     403: C						!
     404: C						!
     405: C						!
     406: C						!
     407: C						!
     408:         RETURN
     409: C SVERBS, PAGE 5
     410: C
     411: C V89--	DIG.  UNLESS SHOVEL, A JOKE.
     412: C
     413: 20000   IF(PRSO.EQ.SHOVE) RETURN
     414: C						!SHOVEL?
     415:         I=392
     416: C						!ASSUME TOOL.
     417:         IF(and(OFLAG1(PRSO),TOOLBT).EQ.0) I=393
     418:         CALL RSPSUB(I,ODO2)
     419:         RETURN
     420: C
     421: C V90--	TIME.  PRINT OUT DURATION OF GAME.
     422: C
     423: #ifdef PDP
     424: C	no duration time available for pdp version (removed
     425: C	to make things fit)
     426: 21000   TELFLG=.TRUE.
     427:         RETURN
     428: #else
     429: 21000   CALL GTTIME(K)
     430: C						!GET PLAY TIME.
     431:         I=K/60
     432:         J=MOD(K,60)
     433: C
     434: #ifdef NOCC
     435:         IF(I.EQ.0.AND.J.EQ.1) WRITE(OUTCH,21010) J
     436:         IF(I.EQ.0.AND.J.NE.1) WRITE(OUTCH,21011) J
     437:         IF(I.EQ.1.AND.J.EQ.1) WRITE(OUTCH,21012) I,J
     438:         IF(I.EQ.1.AND.J.NE.1) WRITE(OUTCH,21013) I,J
     439:         IF(I.GE.2.AND.J.EQ.1) WRITE(OUTCH,21014) I,J
     440:         IF(I.GE.2.AND.J.NE.1) WRITE(OUTCH,21015) I,J
     441:         TELFLG=.TRUE.
     442:         RETURN
     443: C
     444: 21010   FORMAT('You have been playing Dungeon for ',I2,' minute.')
     445: 21011   FORMAT('You have been playing Dungeon for ',I2,' minutes.')
     446: 21012   FORMAT('You have been playing Dungeon for ',I3,' hour and ',
     447: &               I2,' minute.')
     448: 21013   FORMAT('You have been playing Dungeon for ',I3,' hour and ',
     449: &               I2,' minutes.')
     450: 21014   FORMAT('You have been playing Dungeon for ',I3,' hours and ',
     451: &               I2,' minute.')
     452: 21015   FORMAT('You have been playing Dungeon for ',I3,' hours and ',
     453: &               I2,' minutes.')
     454: #else NOCC
     455:         WRITE(OUTCH,21010)
     456:         IF(I.NE.0) WRITE(OUTCH,21011) I
     457:         IF(I.GE.2) WRITE(OUTCH,21012)
     458:         IF(I.EQ.1) WRITE(OUTCH,21013)
     459:         IF(J.EQ.1) WRITE(OUTCH,21014) J
     460:         IF(J.NE.1) WRITE(OUTCH,21015) J
     461:         TELFLG=.TRUE.
     462:         RETURN
     463: C
     464: 21010   FORMAT(' You have been playing Dungeon for ',$)
     465: 21011   FORMAT('+',I3,' hour',$)
     466: 21012   FORMAT('+s and ',$)
     467: 21013   FORMAT('+ and ',$)
     468: 21014   FORMAT('+',I2,' minute.')
     469: 21015   FORMAT('+',I2,' minutes.')
     470: #endif NOCC
     471: #endif PDP
     472: C
     473: C V91--	LEAP.  USUALLY A JOKE, WITH A CATCH.
     474: C
     475: 22000   IF(PRSO.EQ.0) GO TO 22200
     476: C						!OVER SOMETHING?
     477:         IF(QHERE(PRSO,HERE)) GO TO 22100
     478: C						!HERE?
     479:         CALL RSPEAK(447)
     480: C						!NO, JOKE.
     481:         RETURN
     482: C
     483: 22100   IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 22300
     484:         CALL RSPSUB(448,ODO2)
     485: C						!CANT JUMP VILLAIN.
     486:         RETURN
     487: C
     488: 22200   IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 22300
     489: C						!DOWN EXIT?
     490:         IF((XTYPE.EQ.XNO).OR.((XTYPE.EQ.XCOND).AND.
     491: &               .NOT.FLAGS(XFLAG))) GO TO 22400
     492: 22300   CALL RSPEAK(314+RND(5))
     493: C						!WHEEEE
     494: C						!
     495:         RETURN
     496: C
     497: 22400   CALL JIGSUP(449+RND(4))
     498: C						!FATAL LEAP.
     499:         RETURN
     500: C SVERBS, PAGE 6
     501: C
     502: C V92--	LOCK.
     503: C
     504: 23000   IF((PRSO.EQ.GRATE).AND.(HERE.EQ.MGRAT))
     505: &               GO TO 23200
     506: 23100   CALL RSPEAK(464)
     507: C						!NOT LOCK GRATE.
     508:         RETURN
     509: C
     510: 23200   GRUNLF=.FALSE.
     511: C						!GRATE NOW LOCKED.
     512:         CALL RSPEAK(214)
     513:         TRAVEL(REXIT(HERE)+1)=214
     514: C						!CHANGE EXIT STATUS.
     515:         RETURN
     516: C
     517: C V93--	UNLOCK
     518: C
     519: 24000   IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
     520: &               GO TO 23100
     521:         IF(PRSI.EQ.KEYS) GO TO 24200
     522: C						!GOT KEYS?
     523:         CALL RSPSUB(465,ODI2)
     524: C						!NO, JOKE.
     525:         RETURN
     526: C
     527: 24200   GRUNLF=.TRUE.
     528: C						!UNLOCK GRATE.
     529:         CALL RSPEAK(217)
     530:         TRAVEL(REXIT(HERE)+1)=217
     531: C						!CHANGE EXIT STATUS.
     532:         RETURN
     533: C
     534: C V94--	DIAGNOSE.
     535: C
     536: 25000   I=FIGHTS(WINNER,.FALSE.)
     537: C						!GET FIGHTS STRENGTH.
     538:         J=ASTREN(WINNER)
     539: C						!GET HEALTH.
     540:         K=MIN0(I+J,4)
     541: C						!GET STATE.
     542:         IF(.NOT.CFLAG(CEVCUR)) J=0
     543: C						!IF NO WOUNDS.
     544:         L=MIN0(4,IABS(J))
     545: C						!SCALE.
     546:         CALL RSPEAK(473+L)
     547: C						!DESCRIBE HEALTH.
     548:         I=(30*(-J-1))+CTICK(CEVCUR)
     549: C						!COMPUTE WAIT.
     550: C
     551: #ifdef PDP
     552:         if(J .ne. 0) call cured(I)
     553: #else
     554:         IF(J.NE.0) WRITE(OUTCH,25100) I
     555: #ifdef NOCC
     556: 25100   FORMAT('You will be cured after ',I3,' moves.')
     557: #else NOCC
     558: 25100   FORMAT(' You will be cured after ',I3,' moves.')
     559: #endif NOCC
     560: #endif PDP
     561: C
     562:         CALL RSPEAK(478+K)
     563: C						!HOW MUCH MORE?
     564:         IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)
     565: C						!HOW MANY DEATHS?
     566:         RETURN
     567: C SVERBS, PAGE 7
     568: C
     569: C V95--	INCANT
     570: C
     571: 26000   DO 26100 I=1,6
     572: C						!SET UP PARSE.
     573:           PP1(I)=' '
     574:           PP2(I)=' '
     575: 26100   CONTINUE
     576:         WP=1
     577: C						!WORD POINTER.
     578:         CP=1
     579: C						!CHAR POINTER.
     580:         IF(PRSCON.LE.1) GO TO 26300
     581:         DO 26200 I=PRSCON,INLNT
     582: C						!PARSE INPUT
     583:           IF(INBUF(I).EQ.',') GO TO 26300
     584: C						!END OF PHRASE?
     585:           IF(INBUF(I).NE.' ') GO TO 26150
     586: C						!SPACE?
     587:           IF(CP.NE.1) WP=WP+1
     588:           CP=1
     589:           GO TO 26200
     590: 26150     IF(WP.EQ.1) PP1(CP)=INBUF(I)
     591: C						!STUFF INTO HOLDER.
     592:           IF(WP.EQ.2) PP2(CP)=INBUF(I)
     593:           CP=MIN0(CP+1,6)
     594: 26200   CONTINUE
     595: C
     596: 26300   PRSCON=1
     597: C						!KILL REST OF LINE.
     598:         IF(PP1(1).NE.' ') GO TO 26400
     599: C						!ANY INPUT?
     600:         CALL RSPEAK(856)
     601: C						!NO, HO HUM.
     602:         RETURN
     603: C
     604: 26400   CALL ENCRYP(PP1,CH)
     605: C						!COMPUTE RESPONSE.
     606:         IF(PP2(1).NE.' ') GO TO 26600
     607: C						!TWO PHRASES?
     608: C
     609:         IF(SPELLF) GO TO 26550
     610: C						!HE'S TRYING TO LEARN.
     611:         IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 26575
     612:         SPELLF=.TRUE.
     613: C						!TELL HIM.
     614:         TELFLG=.TRUE.
     615: #ifdef PDP
     616:         call voice(PP1,CH)
     617: #else
     618:         WRITE(OUTCH,26510) PP1,CH
     619: #ifdef NOCC
     620: 26510   FORMAT('A hollow voice replies:  "',6A1,1X,6A1,'".')
     621: #else NOCC
     622: 26510   FORMAT(' A hollow voice replies:  "',6A1,1X,6A1,'".')
     623: #endif NOCC
     624: #endif PDP
     625: C
     626:         RETURN
     627: C
     628: 26550   CALL RSPEAK(857)
     629: C						!HE'S GOT ONE ALREADY.
     630:         RETURN
     631: C
     632: 26575   CALL RSPEAK(858)
     633: C						!HE'S NOT IN ENDGAME.
     634:         RETURN
     635: C
     636: 26600   IF(and(RFLAG(TSTRS),RSEEN).NE.0) GO TO 26800
     637:         DO 26700 I=1,6
     638:           IF(PP2(I).NE.CH(I)) GO TO 26575
     639: C						!WRONG.
     640: 26700   CONTINUE
     641:         SPELLF=.TRUE.
     642: C						!IT WORKS.
     643:         CALL RSPEAK(859)
     644:         CTICK(CEVSTE)=1
     645: C						!FORCE START.
     646:         RETURN
     647: C
     648: 26800   CALL RSPEAK(855)
     649: C						!TOO LATE.
     650:         RETURN
     651: C SVERBS, PAGE 8
     652: C
     653: C V96--	ANSWER
     654: C
     655: 27000   IF((PRSCON.GT.1).AND.
     656: &               (HERE.EQ.FDOOR).AND.INQSTF)
     657: &               GO TO 27100
     658:         CALL RSPEAK(799)
     659: C						!NO ONE LISTENS.
     660:         PRSCON=1
     661:         RETURN
     662: C
     663: 27100   K=1
     664: C						!POINTER INTO ANSSTR.
     665:         DO 27300 J=1,28,2
     666: C						!CHECK ANSWERS.
     667:           NEWK=K+ANSWER(J+1)
     668: C						!COMPUTE NEXT K.
     669:           IF(QUESNO.NE.ANSWER(J)) GO TO 27300
     670: C						!ONLY CHECK PROPER ANS.
     671:           I=PRSCON-1
     672: C						!SCAN ANSWER.
     673:           DO 27200 L=K,NEWK-1
     674: 27150       I=I+1
     675: C						!SKIP INPUT BLANKS.
     676:             IF(I.GT.INLNT) GO TO 27300
     677: C						!END OF INPUT? LOSE.
     678:             IF(INBUF(I).EQ.' ') GO TO 27150
     679:             IF(INBUF(I).NE.ANSSTR(L)) GO TO 27300
     680: 27200     CONTINUE
     681:           GO TO 27500
     682: C						!RIGHT ANSWER.
     683: 27300   K=NEWK
     684: C
     685:         PRSCON=1
     686: C						!KILL REST OF LINE.
     687:         NQATT=NQATT+1
     688: C						!WRONG, CRETIN.
     689:         IF(NQATT.GE.5) GO TO 27400
     690: C						!TOO MANY WRONG?
     691:         CALL RSPEAK(800+NQATT)
     692: C						!NO, TRY AGAIN.
     693:         RETURN
     694: C
     695: 27400   CALL RSPEAK(826)
     696: C						!ALL OVER.
     697:         CFLAG(CEVINQ)=.FALSE.
     698: C						!LOSE.
     699:         RETURN
     700: C
     701: 27500   PRSCON=1
     702: C						!KILL REST OF LINE.
     703:         CORRCT=CORRCT+1
     704: C						!GOT IT RIGHT.
     705:         CALL RSPEAK(800)
     706: C						!HOORAY.
     707:         IF(CORRCT.GE.3) GO TO 27600
     708: C						!WON TOTALLY?
     709:         CTICK(CEVINQ)=2
     710: C						!NO, START AGAIN.
     711:         QUESNO=MOD(QUESNO+3,8)
     712:         NQATT=0
     713:         CALL RSPEAK(769)
     714: C						!ASK NEXT QUESTION.
     715:         CALL RSPEAK(770+QUESNO)
     716:         RETURN
     717: C
     718: 27600   CALL RSPEAK(827)
     719: C						!QUIZ OVER,
     720:         CFLAG(CEVINQ)=.FALSE.
     721:         OFLAG2(QDOOR)=or(OFLAG2(QDOOR),OPENBT)
     722:         RETURN
     723: C
     724:         END

Last modified: 1988-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 639 |