![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to verbs.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 verbs.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 ! root 1: C VAPPLI- MAIN VERB PROCESSING ROUTINE ! 2: C ! 3: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 ! 4: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED ! 5: C WRITTEN BY R. M. SUPNIK ! 6: C ! 7: C DECLARATIONS ! 8: C ! 9: LOGICAL FUNCTION VAPPLI(RI) ! 10: IMPLICIT INTEGER (A-Z) ! 11: LOGICAL LIT,OBJACT ! 12: LOGICAL QEMPTY,RMDESC,CLOCKD ! 13: LOGICAL QOPEN,EDIBLE,DRKBLE ! 14: LOGICAL TAKE,PUT,DROP,WALK ! 15: LOGICAL QHERE,SVERBS,FINDXT,OAPPLI,F ! 16: #include "parser.h" ! 17: #include "gamestate.h" ! 18: #include "state.h" ! 19: C ! 20: COMMON /STAR/ MBASE,STRBIT ! 21: #include "rooms.h" ! 22: #include "rflag.h" ! 23: #include "rindex.h" ! 24: #include "xsrch.h" ! 25: #include "objects.h" ! 26: #include "oflags.h" ! 27: #include "oindex.h" ! 28: #include "advers.h" ! 29: #include "verbs.h" ! 30: C ! 31: C FUNCTIONS AND DATA ! 32: C ! 33: QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0 ! 34: EDIBLE(R)=and(OFLAG1(R),FOODBT).NE.0 ! 35: DRKBLE(R)=and(OFLAG1(R),DRNKBT).NE.0 ! 36: DATA MXNOP/39/,MXSMP/99/ ! 37: C VAPPLI, PAGE 2 ! 38: C ! 39: VAPPLI=.TRUE. ! 40: C !ASSUME WINS. ! 41: C ! 42: IF(PRSO.GT.220) GO TO 5 ! 43: C ! 44: IF(PRSO.NE.0) ODO2=ODESC2(PRSO) ! 45: C !SET UP DESCRIPTORS. ! 46: 5 IF(PRSI.NE.0) ODI2=ODESC2(PRSI) ! 47: AV=AVEHIC(WINNER) ! 48: RMK=372+RND(6) ! 49: C !REMARK FOR HACK-HACKS. ! 50: C ! 51: IF(RI.EQ.0) GO TO 10 ! 52: C !ZERO IS FALSE. ! 53: IF(RI.LE.MXNOP) RETURN ! 54: C !NOP? ! 55: IF(RI.LE.MXSMP) GO TO 100 ! 56: C !SIMPLE VERB? ! 57: GO TO (18000,20000, ! 58: & 22000,23000,24000,25000,26000,27000,28000,29000,30000, ! 59: & 31000,32000,33000,34000,35000,36000, 38000,39000,40000, ! 60: & 41000,42000,43000,44000,45000,46000,47000,48000,49000,50000, ! 61: & 51000,52000,53000, 55000,56000, 58000,59000,60000, ! 62: & 63000,64000,65000,66000, 68000,69000,70000, ! 63: & 71000,72000,73000,74000, 77000,78000, ! 64: & 80000,81000,82000,83000,84000,85000,86000,87000,88000), ! 65: & (RI-MXSMP) ! 66: CALL BUG(7,RI) ! 67: C ! 68: C ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE. ! 69: C ! 70: 10 VAPPLI=.FALSE. ! 71: C !LOSE. ! 72: RETURN ! 73: C ! 74: C SIMPLE VERBS ARE HANDLED EXTERNALLY. ! 75: C ! 76: 100 VAPPLI=SVERBS(RI) ! 77: RETURN ! 78: C VAPPLI, PAGE 3 ! 79: C ! 80: C V100-- READ. OUR FIRST REAL VERB. ! 81: C ! 82: 18000 IF(LIT(HERE)) GO TO 18100 ! 83: C !ROOM LIT? ! 84: CALL RSPEAK(356) ! 85: C !NO, CANT READ. ! 86: RETURN ! 87: C ! 88: 18100 IF(PRSI.EQ.0) GO TO 18200 ! 89: C !READ THROUGH OBJ? ! 90: IF(and(OFLAG1(PRSI),TRANBT).NE.0) GO TO 18200 ! 91: CALL RSPSUB(357,ODI2) ! 92: C !NOT TRANSPARENT. ! 93: RETURN ! 94: C ! 95: 18200 IF(and(OFLAG1(PRSO),READBT).NE.0) GO TO 18300 ! 96: CALL RSPSUB(358,ODO2) ! 97: C !NOT READABLE. ! 98: RETURN ! 99: C ! 100: 18300 IF(.NOT.OBJACT(X)) CALL RSPEAK(OREAD(PRSO)) ! 101: RETURN ! 102: C ! 103: C V101-- MELT. UNLESS OBJECT HANDLES, JOKE. ! 104: C ! 105: 20000 IF(.NOT.OBJACT(X)) CALL RSPSUB(361,ODO2) ! 106: RETURN ! 107: C ! 108: C V102-- INFLATE. WORKS ONLY WITH BOATS. ! 109: C ! 110: 22000 IF(.NOT.OBJACT(X)) CALL RSPEAK(368) ! 111: C !OBJ HANDLE? ! 112: RETURN ! 113: C ! 114: C V103-- DEFLATE. ! 115: C ! 116: 23000 IF(.NOT.OBJACT(X)) CALL RSPEAK(369) ! 117: C !OBJ HANDLE? ! 118: RETURN ! 119: C VAPPLI, PAGE 4 ! 120: C ! 121: C V104-- ALARM. IF SLEEPING, WAKE HIM UP. ! 122: C ! 123: 24000 IF(and(OFLAG2(PRSO),SLEPBT).EQ.0) GO TO 24100 ! 124: VAPPLI=OBJACT(X) ! 125: C !SLEEPING, LET OBJ DO. ! 126: RETURN ! 127: C ! 128: 24100 CALL RSPSUB(370,ODO2) ! 129: C !JOKE. ! 130: RETURN ! 131: C ! 132: C V105-- EXORCISE. OBJECTS HANDLE. ! 133: C ! 134: 25000 F=OBJACT(X) ! 135: C !OBJECTS HANDLE. ! 136: RETURN ! 137: C ! 138: C V106-- PLUG. LET OBJECTS HANDLE. ! 139: C ! 140: 26000 IF(.NOT.OBJACT(X)) CALL RSPEAK(371) ! 141: RETURN ! 142: C ! 143: C V107-- KICK. IF OBJECT IGNORES, JOKE. ! 144: C ! 145: 27000 IF(.NOT.OBJACT(X)) CALL RSPSB2(378,ODO2,RMK) ! 146: RETURN ! 147: C ! 148: C V108-- WAVE. SAME. ! 149: C ! 150: 28000 IF(.NOT.OBJACT(X)) CALL RSPSB2(379,ODO2,RMK) ! 151: RETURN ! 152: C ! 153: C V109,V110-- RAISE, LOWER. SAME. ! 154: C ! 155: 29000 CONTINUE ! 156: 30000 IF(.NOT.OBJACT(X)) CALL RSPSB2(380,ODO2,RMK) ! 157: RETURN ! 158: C ! 159: C V111-- RUB. SAME. ! 160: C ! 161: 31000 IF(.NOT.OBJACT(X)) CALL RSPSB2(381,ODO2,RMK) ! 162: RETURN ! 163: C ! 164: C V112-- PUSH. SAME. ! 165: C ! 166: 32000 IF(.NOT.OBJACT(X)) CALL RSPSB2(382,ODO2,RMK) ! 167: RETURN ! 168: C VAPPLI, PAGE 5 ! 169: C ! 170: C V113-- UNTIE. IF OBJECT IGNORES, JOKE. ! 171: C ! 172: 33000 IF(OBJACT(X)) RETURN ! 173: C !OBJECT HANDLE? ! 174: I=383 ! 175: C !NO, NOT TIED. ! 176: IF(and(OFLAG2(PRSO),TIEBT).EQ.0) I=384 ! 177: CALL RSPEAK(I) ! 178: RETURN ! 179: C ! 180: C V114-- TIE. NEVER REALLY WORKS. ! 181: C ! 182: 34000 IF(and(OFLAG2(PRSO),TIEBT).NE.0) GO TO 34100 ! 183: CALL RSPEAK(385) ! 184: C !NOT TIEABLE. ! 185: RETURN ! 186: C ! 187: 34100 IF(.NOT.OBJACT(X)) CALL RSPSUB(386,ODO2) ! 188: C !JOKE. ! 189: RETURN ! 190: C ! 191: C V115-- TIE UP. NEVER REALLY WORKS. ! 192: C ! 193: 35000 IF(and(OFLAG2(PRSI),TIEBT).NE.0) GO TO 35100 ! 194: CALL RSPSUB(387,ODO2) ! 195: C !NOT TIEABLE. ! 196: RETURN ! 197: C ! 198: 35100 I=388 ! 199: C !ASSUME VILLAIN. ! 200: IF(and(OFLAG2(PRSO),VILLBT).EQ.0) I=389 ! 201: CALL RSPSUB(I,ODO2) ! 202: C !JOKE. ! 203: RETURN ! 204: C ! 205: C V116-- TURN. OBJECT MUST HANDLE. ! 206: C ! 207: 36000 IF(and(OFLAG1(PRSO),TURNBT).NE.0) GO TO 36100 ! 208: CALL RSPEAK(390) ! 209: C !NOT TURNABLE. ! 210: RETURN ! 211: C ! 212: 36100 IF(and(OFLAG1(PRSI),TOOLBT).NE.0) GO TO 36200 ! 213: CALL RSPSUB(391,ODI2) ! 214: C !NOT A TOOL. ! 215: RETURN ! 216: C ! 217: 36200 VAPPLI=OBJACT(X) ! 218: C !LET OBJECT HANDLE. ! 219: RETURN ! 220: C ! 221: C V117-- BREATHE. BECOMES INFLATE WITH LUNGS. ! 222: C ! 223: 38000 PRSA=INFLAW ! 224: PRSI=LUNGS ! 225: GO TO 22000 ! 226: C !HANDLE LIKE INFLATE. ! 227: C ! 228: C V118-- KNOCK. MOSTLY JOKE. ! 229: C ! 230: 39000 IF(OBJACT(X)) RETURN ! 231: C !OBJ HANDLE? ! 232: I=394 ! 233: C !JOKE FOR DOOR. ! 234: IF(and(OFLAG1(PRSO),DOORBT).EQ.0) I=395 ! 235: CALL RSPSUB(I,ODO2) ! 236: C !JOKE FOR NONDOORS TOO. ! 237: RETURN ! 238: C ! 239: C V119-- LOOK. ! 240: C ! 241: 40000 IF(PRSO.NE.0) GO TO 41500 ! 242: C !SOMETHING TO LOOK AT? ! 243: VAPPLI=RMDESC(3) ! 244: C !HANDLED BY RMDESC. ! 245: RETURN ! 246: C ! 247: C V120-- EXAMINE. ! 248: C ! 249: 41000 IF(PRSO.NE.0) GO TO 41500 ! 250: C !SOMETHING TO EXAMINE? ! 251: VAPPLI=RMDESC(0) ! 252: C !HANDLED BY RMDESC. ! 253: RETURN ! 254: C ! 255: 41500 IF(OBJACT(X)) RETURN ! 256: C !OBJ HANDLE? ! 257: I=OREAD(PRSO) ! 258: C !GET READING MATERIAL. ! 259: IF(I.NE.0) CALL RSPEAK(I) ! 260: C !OUTPUT IF THERE, ! 261: IF(I.EQ.0) CALL RSPSUB(429,ODO2) ! 262: C !OTHERWISE DEFAULT. ! 263: PRSA=FOOW ! 264: C !DEFUSE ROOM PROCESSORS. ! 265: RETURN ! 266: C ! 267: C V121-- SHAKE. IF HOLLOW OBJECT, SOME ACTION. ! 268: C ! 269: 42000 IF(OBJACT(X)) RETURN ! 270: C !OBJECT HANDLE? ! 271: IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 42100 ! 272: CALL RSPEAK(371) ! 273: C !JOKE FOR VILLAINS. ! 274: RETURN ! 275: C ! 276: 42100 IF(QEMPTY(PRSO).OR.(and(OFLAG1(PRSO),TAKEBT).EQ.0)) ! 277: & GO TO 10 ! 278: IF(QOPEN(PRSO)) GO TO 42300 ! 279: C !OPEN? SPILL. ! 280: CALL RSPSUB(396,ODO2) ! 281: C !NO, DESCRIBE NOISE. ! 282: RETURN ! 283: C ! 284: 42300 CALL RSPSUB(397,ODO2) ! 285: C !SPILL THE WORKS. ! 286: DO 42500 I=1,OLNT ! 287: C !SPILL CONTENTS. ! 288: IF(OCAN(I).NE.PRSO) GO TO 42500 ! 289: C !INSIDE? ! 290: OFLAG2(I)=or(OFLAG2(I),TCHBT) ! 291: IF(AV.EQ.0) GO TO 42400 ! 292: C !IN VEHICLE? ! 293: CALL NEWSTA(I,0,0,AV,0) ! 294: C !YES, SPILL IN THERE. ! 295: GO TO 42500 ! 296: C ! 297: 42400 CALL NEWSTA(I,0,HERE,0,0) ! 298: C !NO, SPILL ON FLOOR, ! 299: IF(I.EQ.WATER) CALL NEWSTA(I,133,0,0,0) ! 300: C !BUT WATER DISAPPEARS. ! 301: 42500 CONTINUE ! 302: RETURN ! 303: C ! 304: C V122-- MOVE. MOSTLY JOKES. ! 305: C ! 306: 43000 IF(OBJACT(X)) RETURN ! 307: C !OBJ HANDLE? ! 308: I=398 ! 309: C !ASSUME NOT HERE. ! 310: IF(QHERE(PRSO,HERE)) I=399 ! 311: CALL RSPSUB(I,ODO2) ! 312: C !JOKE. ! 313: RETURN ! 314: C VAPPLI, PAGE 6 ! 315: C ! 316: C V123-- TURN ON. ! 317: C ! 318: 44000 F=LIT(HERE) ! 319: C !RECORD IF LIT. ! 320: IF(OBJACT(X)) GO TO 44300 ! 321: C !OBJ HANDLE? ! 322: IF((and(OFLAG1(PRSO),LITEBT).NE.0).AND. ! 323: & (OADV(PRSO).EQ.WINNER)) GO TO 44100 ! 324: CALL RSPEAK(400) ! 325: C !CANT DO IT. ! 326: RETURN ! 327: C ! 328: 44100 IF(and(OFLAG1(PRSO),ONBT).EQ.0) GO TO 44200 ! 329: CALL RSPEAK(401) ! 330: C !ALREADY ON. ! 331: RETURN ! 332: C ! 333: 44200 OFLAG1(PRSO)=or(OFLAG1(PRSO),ONBT) ! 334: CALL RSPSUB(404,ODO2) ! 335: 44300 IF(.NOT.F .AND.LIT(HERE)) F=RMDESC(0) ! 336: C !ROOM NEWLY LIT. ! 337: RETURN ! 338: C ! 339: C V124-- TURN OFF. ! 340: C ! 341: 45000 IF(OBJACT(X)) GO TO 45300 ! 342: C !OBJ HANDLE? ! 343: IF((and(OFLAG1(PRSO),LITEBT).NE.0).AND. ! 344: & (OADV(PRSO).EQ.WINNER)) GO TO 45100 ! 345: CALL RSPEAK(402) ! 346: C !CANT DO IT. ! 347: RETURN ! 348: C ! 349: 45100 IF(and(OFLAG1(PRSO),ONBT).NE.0) GO TO 45200 ! 350: CALL RSPEAK(403) ! 351: C !ALREADY OFF. ! 352: RETURN ! 353: C ! 354: 45200 OFLAG1(PRSO)=and(OFLAG1(PRSO), not(ONBT)) ! 355: CALL RSPSUB(405,ODO2) ! 356: 45300 IF(.NOT.LIT(HERE)) CALL RSPEAK(406) ! 357: C !MAY BE DARK. ! 358: RETURN ! 359: C ! 360: C V125-- OPEN. A FINE MESS. ! 361: C ! 362: 46000 IF(OBJACT(X)) RETURN ! 363: C !OBJ HANDLE? ! 364: IF(and(OFLAG1(PRSO),CONTBT).NE.0) GO TO 46100 ! 365: 46050 CALL RSPSUB(407,ODO2) ! 366: C !NOT OPENABLE. ! 367: RETURN ! 368: C ! 369: 46100 IF(OCAPAC(PRSO).NE.0) GO TO 46200 ! 370: CALL RSPSUB(408,ODO2) ! 371: C !NOT OPENABLE. ! 372: RETURN ! 373: C ! 374: 46200 IF(.NOT.QOPEN(PRSO)) GO TO 46225 ! 375: CALL RSPEAK(412) ! 376: C !ALREADY OPEN. ! 377: RETURN ! 378: C ! 379: 46225 OFLAG2(PRSO)=or(OFLAG2(PRSO),OPENBT) ! 380: IF((and(OFLAG1(PRSO),TRANBT).NE.0).OR.QEMPTY(PRSO)) ! 381: & GO TO 46300 ! 382: CALL PRINCO(PRSO,410) ! 383: C !PRINT CONTENTS. ! 384: RETURN ! 385: C ! 386: 46300 CALL RSPEAK(409) ! 387: C !DONE ! 388: RETURN ! 389: C ! 390: C V126-- CLOSE. ! 391: C ! 392: 47000 IF(OBJACT(X)) RETURN ! 393: C !OBJ HANDLE? ! 394: IF(and(OFLAG1(PRSO),CONTBT).EQ.0) GO TO 46050 ! 395: IF(OCAPAC(PRSO).NE.0) GO TO 47100 ! 396: CALL RSPSUB(411,ODO2) ! 397: C !NOT CLOSABLE. ! 398: RETURN ! 399: C ! 400: 47100 IF(QOPEN(PRSO)) GO TO 47200 ! 401: C !OPEN? ! 402: CALL RSPEAK(413) ! 403: C !NO, JOKE. ! 404: RETURN ! 405: C ! 406: 47200 OFLAG2(PRSO)=and(OFLAG2(PRSO), not(OPENBT)) ! 407: CALL RSPEAK(414) ! 408: C !DONE. ! 409: RETURN ! 410: C VAPPLI, PAGE 7 ! 411: C ! 412: C V127-- FIND. BIG MEGILLA. ! 413: C ! 414: 48000 IF(OBJACT(X)) RETURN ! 415: C !OBJ HANDLE? ! 416: I=415 ! 417: C !DEFAULT CASE. ! 418: IF(QHERE(PRSO,HERE)) GO TO 48300 ! 419: C !IN ROOM? ! 420: IF(OADV(PRSO).EQ.WINNER) GO TO 48200 ! 421: C !ON WINNER? ! 422: J=OCAN(PRSO) ! 423: C !DOWN ONE LEVEL. ! 424: IF(J.EQ.0) GO TO 10 ! 425: IF(((and(OFLAG1(J),TRANBT).EQ.0).AND. ! 426: & (.NOT.QOPEN(J).OR.(and(OFLAG1(J),(DOORBT+CONTBT)).EQ.0)))) ! 427: & GO TO 10 ! 428: I=417 ! 429: C !ASSUME IN ROOM. ! 430: IF(QHERE(J,HERE)) GO TO 48100 ! 431: IF(OADV(J).NE.WINNER) GO TO 10 ! 432: C !NOT HERE OR ON PERSON. ! 433: I=418 ! 434: 48100 CALL RSPSUB(I,ODESC2(J)) ! 435: C !DESCRIBE FINDINGS. ! 436: RETURN ! 437: C ! 438: 48200 I=416 ! 439: 48300 CALL RSPSUB(I,ODO2) ! 440: C !DESCRIBE FINDINGS. ! 441: RETURN ! 442: C ! 443: C V128-- WAIT. RUN CLOCK DEMON. ! 444: C ! 445: 49000 CALL RSPEAK(419) ! 446: C !TIME PASSES. ! 447: DO 49100 I=1,3 ! 448: IF(CLOCKD(X)) RETURN ! 449: 49100 CONTINUE ! 450: RETURN ! 451: C ! 452: C V129-- SPIN. ! 453: C V159-- TURN TO. ! 454: C ! 455: 50000 CONTINUE ! 456: 88000 IF(.NOT.OBJACT(X)) CALL RSPEAK(663) ! 457: C !IF NOT OBJ, JOKE. ! 458: RETURN ! 459: C ! 460: C V130-- BOARD. WORKS WITH VEHICLES. ! 461: C ! 462: 51000 IF(and(OFLAG2(PRSO),VEHBT).NE.0) GO TO 51100 ! 463: CALL RSPSUB(421,ODO2) ! 464: C !NOT VEHICLE, JOKE. ! 465: RETURN ! 466: C ! 467: 51100 IF(QHERE(PRSO,HERE)) GO TO 51200 ! 468: C !HERE? ! 469: CALL RSPSUB(420,ODO2) ! 470: C !NO, JOKE. ! 471: RETURN ! 472: C ! 473: 51200 IF(AV.EQ.0) GO TO 51300 ! 474: C !ALREADY GOT ONE? ! 475: CALL RSPSUB(422,ODO2) ! 476: C !YES, JOKE. ! 477: RETURN ! 478: C ! 479: 51300 IF(OBJACT(X)) RETURN ! 480: C !OBJ HANDLE? ! 481: CALL RSPSUB(423,ODO2) ! 482: C !DESCRIBE. ! 483: AVEHIC(WINNER)=PRSO ! 484: IF(WINNER.NE.PLAYER) OCAN(AOBJ(WINNER))=PRSO ! 485: RETURN ! 486: C ! 487: C V131-- DISEMBARK. ! 488: C ! 489: 52000 IF(AV.EQ.PRSO) GO TO 52100 ! 490: C !FROM VEHICLE? ! 491: CALL RSPEAK(424) ! 492: C !NO, JOKE. ! 493: RETURN ! 494: C ! 495: 52100 IF(OBJACT(X)) RETURN ! 496: C !OBJ HANDLE? ! 497: IF(and(RFLAG(HERE),RLAND).NE.0) GO TO 52200 ! 498: CALL RSPEAK(425) ! 499: C !NOT ON LAND. ! 500: RETURN ! 501: C ! 502: 52200 AVEHIC(WINNER)=0 ! 503: CALL RSPEAK(426) ! 504: IF(WINNER.NE.PLAYER) CALL NEWSTA(AOBJ(WINNER),0,HERE,0,0) ! 505: RETURN ! 506: C ! 507: C V132-- TAKE. HANDLED EXTERNALLY. ! 508: C ! 509: 53000 VAPPLI=TAKE(.TRUE.) ! 510: RETURN ! 511: C ! 512: C V133-- INVENTORY. PROCESSED EXTERNALLY. ! 513: C ! 514: 55000 CALL INVENT(WINNER) ! 515: RETURN ! 516: C VAPPLI, PAGE 8 ! 517: C ! 518: C V134-- FILL. STRANGE DOINGS WITH WATER. ! 519: C ! 520: 56000 IF(PRSI.NE.0) GO TO 56050 ! 521: C !ANY OBJ SPECIFIED? ! 522: IF(and(RFLAG(HERE),(RWATER+RFILL)).NE.0) GO TO 56025 ! 523: CALL RSPEAK(516) ! 524: C !NOTHING TO FILL WITH. ! 525: PRSWON=.FALSE. ! 526: C !YOU LOSE. ! 527: RETURN ! 528: C ! 529: 56025 PRSI=GWATE ! 530: C !USE GLOBAL WATER. ! 531: 56050 IF(OBJACT(X)) RETURN ! 532: C !OBJ HANDLE? ! 533: IF((PRSI.NE.GWATE).AND.(PRSI.NE.WATER)) ! 534: & CALL RSPSB2(444,ODI2,ODO2) ! 535: RETURN ! 536: C ! 537: C V135,V136-- EAT/DRINK ! 538: C ! 539: 58000 CONTINUE ! 540: 59000 IF(OBJACT(X)) RETURN ! 541: C !OBJ HANDLE? ! 542: IF(PRSO.EQ.GWATE) GO TO 59500 ! 543: C !DRINK GLOBAL WATER? ! 544: IF(.NOT.EDIBLE(PRSO)) GO TO 59400 ! 545: C !EDIBLE? ! 546: IF(OADV(PRSO).EQ.WINNER) GO TO 59200 ! 547: C !YES, ON WINNER? ! 548: 59100 CALL RSPSUB(454,ODO2) ! 549: C !NOT ACCESSIBLE. ! 550: RETURN ! 551: C ! 552: 59200 IF(PRSA.EQ.DRINKW) GO TO 59300 ! 553: C !DRINK FOOD? ! 554: CALL NEWSTA(PRSO,455,0,0,0) ! 555: C !NO, IT DISAPPEARS. ! 556: RETURN ! 557: C ! 558: 59300 CALL RSPEAK(456) ! 559: C !YES, JOKE. ! 560: RETURN ! 561: C ! 562: 59400 IF(.NOT.DRKBLE(PRSO)) GO TO 59600 ! 563: C !DRINKABLE? ! 564: IF(OCAN(PRSO).EQ.0) GO TO 59100 ! 565: C !YES, IN SOMETHING? ! 566: IF(OADV(OCAN(PRSO)).NE.WINNER) GO TO 59100 ! 567: IF(QOPEN(OCAN(PRSO))) GO TO 59500 ! 568: C !CONT OPEN? ! 569: CALL RSPEAK(457) ! 570: C !NO, JOKE. ! 571: RETURN ! 572: C ! 573: 59500 CALL NEWSTA(PRSO,458,0,0,0) ! 574: C !GONE. ! 575: RETURN ! 576: C ! 577: 59600 CALL RSPSUB(453,ODO2) ! 578: C !NOT FOOD OR DRINK. ! 579: RETURN ! 580: C ! 581: C V137-- BURN. COMPLICATED. ! 582: C ! 583: 60000 IF(and(OFLAG1(PRSI),(FLAMBT+LITEBT+ONBT)).NE. ! 584: & (FLAMBT+LITEBT+ONBT)) GO TO 60400 ! 585: IF(OBJACT(X)) RETURN ! 586: C !OBJ HANDLE? ! 587: IF(OCAN(PRSO).NE.RECEP) GO TO 60050 ! 588: C !BALLOON? ! 589: IF(OAPPLI(OACTIO(BALLO),0)) RETURN ! 590: C !DID IT HANDLE? ! 591: 60050 IF(and(OFLAG1(PRSO),BURNBT).EQ.0) GO TO 60300 ! 592: IF(OADV(PRSO).NE.WINNER) GO TO 60100 ! 593: C !CARRYING IT? ! 594: CALL RSPSUB(459,ODO2) ! 595: CALL JIGSUP(460) ! 596: RETURN ! 597: C ! 598: 60100 J=OCAN(PRSO) ! 599: C !GET CONTAINER. ! 600: IF(QHERE(PRSO,HERE).OR. ((AV.NE.0).AND.(J.EQ.AV))) ! 601: & GO TO 60200 ! 602: IF(J.EQ.0) GO TO 60150 ! 603: C !INSIDE? ! 604: IF(.NOT.QOPEN(J)) GO TO 60150 ! 605: C !OPEN? ! 606: IF(QHERE(J,HERE).OR.((AV.NE.0).AND.(OCAN(J).EQ.AV))) ! 607: & GO TO 60200 ! 608: 60150 CALL RSPEAK(461) ! 609: C !CANT REACH IT. ! 610: RETURN ! 611: C ! 612: 60200 CALL RSPSUB(462,ODO2) ! 613: C !BURN IT. ! 614: CALL NEWSTA(PRSO,0,0,0,0) ! 615: RETURN ! 616: C ! 617: 60300 CALL RSPSUB(463,ODO2) ! 618: C !CANT BURN IT. ! 619: RETURN ! 620: C ! 621: 60400 CALL RSPSUB(301,ODI2) ! 622: C !CANT BURN IT WITH THAT. ! 623: RETURN ! 624: C VAPPLI, PAGE 9 ! 625: C ! 626: C V138-- MUNG. GO TO COMMON ATTACK CODE. ! 627: C ! 628: 63000 I=466 ! 629: C !CHOOSE PHRASE. ! 630: IF(and(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66100 ! 631: IF(.NOT.OBJACT(X)) CALL RSPSB2(466,ODO2,RMK) ! 632: RETURN ! 633: C ! 634: C V139-- KILL. GO TO COMMON ATTACK CODE. ! 635: C ! 636: 64000 I=467 ! 637: C !CHOOSE PHRASE. ! 638: GO TO 66100 ! 639: C ! 640: C V140-- SWING. INVERT OBJECTS, FALL THRU TO ATTACK. ! 641: C ! 642: 65000 J=PRSO ! 643: C !INVERT. ! 644: PRSO=PRSI ! 645: PRSI=J ! 646: J=ODO2 ! 647: ODO2=ODI2 ! 648: ODI2=J ! 649: PRSA=ATTACW ! 650: C !FOR OBJACT. ! 651: C ! 652: C V141-- ATTACK. FALL THRU TO ATTACK CODE. ! 653: C ! 654: 66000 I=468 ! 655: C ! 656: C COMMON MUNG/ATTACK/SWING/KILL CODE. ! 657: C ! 658: 66100 IF(PRSO.NE.0) GO TO 66200 ! 659: C !ANYTHING? ! 660: CALL RSPEAK(469) ! 661: C !NO, JOKE. ! 662: RETURN ! 663: C ! 664: 66200 IF(OBJACT(X)) RETURN ! 665: C !OBJ HANDLE? ! 666: IF(and(OFLAG2(PRSO),VILLBT).NE.0) GO TO 66300 ! 667: IF(and(OFLAG1(PRSO),VICTBT).EQ.0) ! 668: & CALL RSPSUB(470,ODO2) ! 669: RETURN ! 670: C ! 671: 66300 J=471 ! 672: C !ASSUME NO WEAPON. ! 673: IF(PRSI.EQ.0) GO TO 66500 ! 674: IF(and(OFLAG2(PRSI),WEAPBT).EQ.0) GO TO 66400 ! 675: MELEE=1 ! 676: C !ASSUME SWORD. ! 677: IF(PRSI.NE.SWORD) MELEE=2 ! 678: C !MUST BE KNIFE. ! 679: I=BLOW(PLAYER,PRSO,MELEE,.TRUE.,0) ! 680: C !STRIKE BLOW. ! 681: RETURN ! 682: C ! 683: 66400 J=472 ! 684: C !NOT A WEAPON. ! 685: 66500 CALL RSPSB2(I,ODO2,J) ! 686: C !JOKE. ! 687: RETURN ! 688: C VAPPLI, PAGE 10 ! 689: C ! 690: C V142-- WALK. PROCESSED EXTERNALLY. ! 691: C ! 692: 68000 VAPPLI=WALK(X) ! 693: RETURN ! 694: C ! 695: C V143-- TELL. PROCESSED IN GAME. ! 696: C ! 697: 69000 CALL RSPEAK(603) ! 698: RETURN ! 699: C ! 700: C V144-- PUT. PROCESSED EXTERNALLY. ! 701: C ! 702: 70000 VAPPLI=PUT(.TRUE.) ! 703: RETURN ! 704: C ! 705: C V145,V146,V147,V148-- DROP/GIVE/POUR/THROW ! 706: C ! 707: 71000 CONTINUE ! 708: 72000 CONTINUE ! 709: 73000 CONTINUE ! 710: 74000 VAPPLI=DROP(.FALSE.) ! 711: RETURN ! 712: C ! 713: C V149-- SAVE ! 714: C ! 715: 77000 IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 77100 ! 716: CALL RSPEAK(828) ! 717: C !NO SAVES IN ENDGAME. ! 718: RETURN ! 719: C ! 720: 77100 CALL SAVEGM ! 721: RETURN ! 722: C ! 723: C V150-- RESTORE ! 724: C ! 725: #ifdef PDP ! 726: 78000 call restor ! 727: #else ! 728: 78000 IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 78100 ! 729: CALL RSPEAK(829) ! 730: C !NO RESTORES IN ENDGAME. ! 731: RETURN ! 732: C ! 733: 78100 CALL RSTRGM ! 734: #endif PDP ! 735: RETURN ! 736: C VAPPLI, PAGE 11 ! 737: C ! 738: C V151-- HELLO ! 739: C ! 740: 80000 IF(PRSO.NE.0) GO TO 80100 ! 741: C !ANY OBJ? ! 742: CALL RSPEAK(346+RND(4)) ! 743: C !NO, VANILLA HELLO. ! 744: RETURN ! 745: C ! 746: 80100 IF(PRSO.NE.AVIAT) GO TO 80200 ! 747: C !HELLO AVIATOR? ! 748: CALL RSPEAK(350) ! 749: C !NOTHING HAPPENS. ! 750: RETURN ! 751: C ! 752: 80200 IF(PRSO.NE.SAILO) GO TO 80300 ! 753: C !HELLO SAILOR? ! 754: HS=HS+1 ! 755: C !COUNT. ! 756: I=351 ! 757: C !GIVE NORMAL OR ! 758: IF(MOD(HS,10).EQ.0) I=352 ! 759: C !RANDOM MESSAGE. ! 760: IF(MOD(HS,20).EQ.0) I=353 ! 761: CALL RSPEAK(I) ! 762: C !SPEAK UP. ! 763: RETURN ! 764: C ! 765: 80300 IF(OBJACT(X)) RETURN ! 766: C !OBJ HANDLE? ! 767: I=354 ! 768: C !ASSUME VILLAIN. ! 769: IF(and(OFLAG2(PRSO),(VILLBT+ACTRBT)).EQ.0) I=355 ! 770: CALL RSPSUB(I,ODO2) ! 771: C !HELLO THERE ! 772: C ! ! 773: RETURN ! 774: C ! 775: C V152-- LOOK INTO ! 776: C ! 777: 81000 IF(OBJACT(X)) RETURN ! 778: C !OBJ HANDLE? ! 779: IF(and(OFLAG1(PRSO),DOORBT).EQ.0) GO TO 81300 ! 780: IF(.NOT.QOPEN(PRSO)) GO TO 81200 ! 781: C !OPEN? ! 782: CALL RSPSUB(628,ODO2) ! 783: C !OPEN DOOR- UNINTERESTING. ! 784: RETURN ! 785: C ! 786: 81200 CALL RSPSUB(525,ODO2) ! 787: C !CLOSED DOOR- CANT SEE. ! 788: RETURN ! 789: C ! 790: 81300 IF(and(OFLAG2(PRSO),VEHBT).NE.0) GO TO 81400 ! 791: IF(QOPEN(PRSO).OR.(and(OFLAG1(PRSO),TRANBT).NE.0)) ! 792: & GO TO 81400 ! 793: IF(and(OFLAG1(PRSO),CONTBT).NE.0) GO TO 81200 ! 794: CALL RSPSUB(630,ODO2) ! 795: C !CANT LOOK INSIDE. ! 796: RETURN ! 797: C ! 798: 81400 IF(QEMPTY(PRSO)) GO TO 81500 ! 799: C !VEH OR SEE IN. EMPTY? ! 800: CALL PRINCO(PRSO,573) ! 801: C !NO, LIST CONTENTS. ! 802: RETURN ! 803: C ! 804: 81500 CALL RSPSUB(629,ODO2) ! 805: C !EMPTY. ! 806: RETURN ! 807: C ! 808: C V153-- LOOK UNDER ! 809: C ! 810: 82000 IF(.NOT.OBJACT(X)) CALL RSPEAK(631) ! 811: C !OBJECT HANDLE? ! 812: RETURN ! 813: C VAPPLI, PAGE 12 ! 814: C ! 815: C V154-- PUMP ! 816: C ! 817: 83000 IF((OROOM(PUMP).EQ.HERE).OR.(OADV(PUMP).EQ.WINNER)) ! 818: & GO TO 83100 ! 819: CALL RSPEAK(632) ! 820: C !NO. ! 821: RETURN ! 822: C ! 823: 83100 PRSI=PUMP ! 824: C !BECOMES INFLATE ! 825: PRSA=INFLAW ! 826: C !X WITH PUMP. ! 827: GO TO 22000 ! 828: C !DONE. ! 829: C ! 830: C V155-- WIND ! 831: C ! 832: 84000 IF(.NOT.OBJACT(X)) CALL RSPSUB(634,ODO2) ! 833: C !OBJ HANDLE? ! 834: RETURN ! 835: C ! 836: C V156-- CLIMB ! 837: C V157-- CLIMB UP ! 838: C V158-- CLIMB DOWN ! 839: C ! 840: 85000 CONTINUE ! 841: 86000 CONTINUE ! 842: 87000 I=XUP ! 843: C !ASSUME UP. ! 844: IF(PRSA.EQ.CLMBDW) I=XDOWN ! 845: C !UNLESS CLIMB DN. ! 846: F=(and(OFLAG2(PRSO),CLMBBT)).NE.0 ! 847: IF(F.AND.FINDXT(I,HERE)) GO TO 87500 ! 848: C !ANYTHING TO CLIMB? ! 849: IF(OBJACT(X)) RETURN ! 850: C !OBJ HANDLE? ! 851: I=657 ! 852: IF(F) I=524 ! 853: C !VARIETY OF JOKES. ! 854: IF(.NOT.F .AND.((PRSO.EQ.WALL).OR. ! 855: & ((PRSO.GE.WNORT).AND.(PRSO.LE.WNORT+3)))) ! 856: & I=656 ! 857: CALL RSPEAK(I) ! 858: C !JOKE. ! 859: RETURN ! 860: C ! 861: 87500 PRSA=WALKW ! 862: C !WALK ! 863: PRSO=I ! 864: C !IN SPECIFIED DIR. ! 865: VAPPLI=WALK(X) ! 866: RETURN ! 867: C ! 868: END ! 869: C CLOCKD- CLOCK DEMON FOR INTERMOVE CLOCK EVENTS ! 870: C ! 871: C DECLARATIONS ! 872: C ! 873: LOGICAL FUNCTION CLOCKD(X) ! 874: IMPLICIT INTEGER (A-Z) ! 875: C ! 876: C CLOCK INTERRUPTS ! 877: C ! 878: #include "clock.h" ! 879: C ! 880: CLOCKD=.FALSE. ! 881: C !ASSUME NO ACTION. ! 882: DO 100 I=1,CLNT ! 883: IF(.NOT.CFLAG(I) .OR.(CTICK(I).EQ.0)) GO TO 100 ! 884: IF(CTICK(I).LT.0) GO TO 50 ! 885: C !PERMANENT ENTRY? ! 886: CTICK(I)=CTICK(I)-1 ! 887: IF(CTICK(I).NE.0) GO TO 100 ! 888: C !TIMER EXPIRED? ! 889: 50 CLOCKD=.TRUE. ! 890: CALL CEVAPP(CACTIO(I)) ! 891: C !DO ACTION. ! 892: 100 CONTINUE ! 893: RETURN ! 894: C ! 895: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.