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
|
Last modified: 1988-10-21
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 2052 |
|