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

       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: 755 |