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: 2130
Valid CSS Valid XHTML 1.0 Strict