|
|
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.