![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sverbs.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to sverbs.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.