![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dverb1.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 dverb1.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 1: C TAKE-- BASIC TAKE SEQUENCE
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 TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.)
8: C
9: LOGICAL FUNCTION TAKE(FLG)
10: C
11: C DECLARATIONS
12: C
13: IMPLICIT INTEGER (A-Z)
14: LOGICAL FLG,OBJACT,OAPPLI,QOPEN,QHERE
15: #include "parser.h"
16: #include "gamestate.h"
17: #include "state.h"
18: COMMON /STAR/ MBASE,STRBIT
19: #include "objects.h"
20: #include "oflags.h"
21: C
22: #include "advers.h"
23: C
24: C FUNCTIONS AND DATA
25: C
26: QOPEN(O)=(and(OFLAG2(O),OPENBT).NE.0)
27: C TAKE, PAGE 2
28: C
29: TAKE=.FALSE.
30: C !ASSUME LOSES.
31: OA=OACTIO(PRSO)
32: C !GET OBJECT ACTION.
33: IF(PRSO.LE.STRBIT) GO TO 100
34: C !STAR?
35: TAKE=OBJACT(X)
36: C !YES, LET IT HANDLE.
37: RETURN
38: C
39: 100 X=OCAN(PRSO)
40: C !INSIDE?
41: IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400
42: C !HIS VEHICLE?
43: CALL RSPEAK(672)
44: C !DUMMY.
45: RETURN
46: C
47: 400 IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500
48: IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+RND(5))
49: RETURN
50: C
51: C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN.
52: C
53: 500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600
54: IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557)
55: C !ALREADY GOT IT?
56: RETURN
57: C
58: 600 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
59: & ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD))
60: & GO TO 700
61: CALL RSPEAK(558)
62: C !TOO MUCH WEIGHT.
63: RETURN
64: C
65: 700 TAKE=.TRUE.
66: C !AT LAST.
67: IF(OAPPLI(OA,0)) RETURN
68: C !DID IT HANDLE?
69: CALL NEWSTA(PRSO,0,0,0,WINNER)
70: C !TAKE OBJECT FOR WINNER.
71: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
72: CALL SCRUPD(OFVAL(PRSO))
73: C !UPDATE SCORE.
74: OFVAL(PRSO)=0
75: C !CANT BE SCORED AGAIN.
76: IF(FLG) CALL RSPEAK(559)
77: C !TELL TAKEN.
78: RETURN
79: C
80: END
81: C DROP- DROP VERB PROCESSOR
82: C
83: C DECLARATIONS
84: C
85: LOGICAL FUNCTION DROP(Z)
86: IMPLICIT INTEGER (A-Z)
87: LOGICAL F,PUT,OBJACT
88: #include "parser.h"
89: #include "gamestate.h"
90: C
91: C ROOMS
92: #include "rindex.h"
93: #include "objects.h"
94: #include "oflags.h"
95: C
96: #include "advers.h"
97: #include "verbs.h"
98: C DROP, PAGE 2
99: C
100: DROP=.TRUE.
101: C !ASSUME WINS.
102: X=OCAN(PRSO)
103: C !GET CONTAINER.
104: IF(X.EQ.0) GO TO 200
105: C !IS IT INSIDE?
106: IF(OADV(X).NE.WINNER) GO TO 1000
107: C !IS HE CARRYING CON?
108: IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 300
109: CALL RSPSUB(525,ODESC2(X))
110: C !CANT REACH.
111: RETURN
112: C
113: 200 IF(OADV(PRSO).NE.WINNER) GO TO 1000
114: C !IS HE CARRYING OBJ?
115: 300 IF(AVEHIC(WINNER).EQ.0) GO TO 400
116: C !IS HE IN VEHICLE?
117: PRSI=AVEHIC(WINNER)
118: C !YES,
119: F=PUT(.TRUE.)
120: C !DROP INTO VEHICLE.
121: PRSI=0
122: C !DISARM PARSER.
123: RETURN
124: C !DONE.
125: C
126: 400 CALL NEWSTA(PRSO,0,HERE,0,0)
127: C !DROP INTO ROOM.
128: IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0)
129: CALL SCRUPD(OFVAL(PRSO))
130: C !SCORE OBJECT.
131: OFVAL(PRSO)=0
132: C !CANT BE SCORED AGAIN.
133: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
134: C
135: IF(OBJACT(X)) RETURN
136: C !DID IT HANDLE?
137: I=0
138: C !ASSUME NOTHING TO SAY.
139: IF(PRSA.EQ.DROPW) I=528
140: IF(PRSA.EQ.THROWW) I=529
141: IF((I.NE.0).AND.(HERE.EQ.MTREE)) I=659
142: CALL RSPSUB(I,ODESC2(PRSO))
143: RETURN
144: C
145: 1000 CALL RSPEAK(527)
146: C !DONT HAVE IT.
147: RETURN
148: C
149: END
150: C PUT- PUT VERB PROCESSOR
151: C
152: C DECLARATIONS
153: C
154: LOGICAL FUNCTION PUT(FLG)
155: IMPLICIT INTEGER (A-Z)
156: LOGICAL TAKE,QOPEN,QHERE,OBJACT,FLG
157: #include "parser.h"
158: #include "gamestate.h"
159: C
160: C MISCELLANEOUS VARIABLES
161: C
162: COMMON /STAR/ MBASE,STRBIT
163: #include "objects.h"
164: #include "oflags.h"
165: #include "advers.h"
166: #include "verbs.h"
167: C
168: C FUNCTIONS AND DATA
169: C
170: QOPEN(R)=((and(OFLAG2(R),OPENBT)).NE.0)
171: C PUT, PAGE 2
172: C
173: PUT=.FALSE.
174: IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200
175: IF(.NOT.OBJACT(X)) CALL RSPEAK(560)
176: C !STAR
177: PUT=.TRUE.
178: RETURN
179: C
180: 200 IF((QOPEN(PRSI))
181: & .OR.(and(OFLAG1(PRSI),(DOORBT+CONTBT)).NE.0)
182: & .OR.(and(OFLAG2(PRSI),VEHBT).NE.0)) GO TO 300
183: CALL RSPEAK(561)
184: C !CANT PUT IN THAT.
185: RETURN
186: C
187: 300 IF(QOPEN(PRSI)) GO TO 400
188: C !IS IT OPEN?
189: CALL RSPEAK(562)
190: C !NO, JOKE
191: RETURN
192: C
193: 400 IF(PRSO.NE.PRSI) GO TO 500
194: C !INTO ITSELF?
195: CALL RSPEAK(563)
196: C !YES, JOKE.
197: RETURN
198: C
199: 500 IF(OCAN(PRSO).NE.PRSI) GO TO 600
200: C !ALREADY INSIDE.
201: CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI))
202: PUT=.TRUE.
203: RETURN
204: C
205: 600 IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO))
206: & .LE.OCAPAC(PRSI)) GO TO 700
207: CALL RSPEAK(565)
208: C !THEN CANT DO IT.
209: RETURN
210: C
211: C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM
212: C
213: 700 J=PRSO
214: C !START SEARCH.
215: 725 IF(QHERE(J,HERE)) GO TO 750
216: C !IS IT HERE?
217: J=OCAN(J)
218: IF(J.NE.0) GO TO 725
219: C !MORE TO DO?
220: GO TO 800
221: C !NO, SCH FAILS.
222: C
223: 750 SVO=PRSO
224: C !SAVE PARSER.
225: SVI=PRSI
226: PRSA=TAKEW
227: PRSI=0
228: IF(.NOT.TAKE(.FALSE.)) RETURN
229: C !TAKE OBJECT.
230: PRSA=PUTW
231: PRSO=SVO
232: PRSI=SVI
233: GO TO 1000
234: C
235: C NOW SEE IF OBJECT IS ON PERSON.
236: C
237: 800 IF(OCAN(PRSO).EQ.0) GO TO 1000
238: C !INSIDE?
239: IF(QOPEN(OCAN(PRSO))) GO TO 900
240: C !OPEN?
241: CALL RSPSUB(566,ODESC2(PRSO))
242: C !LOSE.
243: RETURN
244: C
245: 900 CALL SCRUPD(OFVAL(PRSO))
246: C !SCORE OBJECT.
247: OFVAL(PRSO)=0
248: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT)
249: CALL NEWSTA(PRSO,0,0,0,WINNER)
250: C !TEMPORARILY ON WINNER.
251: C
252: 1000 IF(OBJACT(X)) RETURN
253: C !NO, GIVE OBJECT A SHOT.
254: CALL NEWSTA(PRSO,2,0,PRSI,0)
255: C !CONTAINED INSIDE.
256: PUT=.TRUE.
257: RETURN
258: C
259: END
260: C VALUAC- HANDLES VALUABLES/EVERYTHING
261: C
262: C DECLARATIONS
263: C
264: SUBROUTINE VALUAC(V)
265: IMPLICIT INTEGER (A-Z)
266: LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTVAL,QHERE
267: #include "parser.h"
268: #include "gamestate.h"
269: #include "objects.h"
270: #include "oflags.h"
271: #include "verbs.h"
272: C
273: C FUNCTIONS AND DATA
274: C
275: NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0)
276: C VALUAC, PAGE 2
277: C
278: F=.TRUE.
279: C !ASSUME NO ACTIONS.
280: I=579
281: C !ASSUME NOT LIT.
282: IF(.NOT.LIT(HERE)) GO TO 4000
283: C !IF NOT LIT, PUNT.
284: I=677
285: C !ASSUME WRONG VERB.
286: SAVEP=PRSO
287: C !SAVE PRSO.
288: SAVEH=HERE
289: C !SAVE HERE.
290: C
291: 100 IF(PRSA.NE.TAKEW) GO TO 1000
292: C !TAKE EVERY/VALUA?
293: DO 500 PRSO=1,OLNT
294: C !LOOP THRU OBJECTS.
295: IF(.NOT.QHERE(PRSO,HERE).OR.
296: & (and(OFLAG1(PRSO),VISIBT).EQ.0).OR.
297: & (and(OFLAG2(PRSO),ACTRBT).NE.0).OR.
298: & NOTVAL(PRSO)) GO TO 500
299: IF((and(OFLAG1(PRSO),TAKEBT).EQ.0).AND.
300: & (and(OFLAG2(PRSO),TRYBT).EQ.0)) GO TO 500
301: F=.FALSE.
302: CALL RSPSUB(580,ODESC2(PRSO))
303: F1=TAKE(.TRUE.)
304: IF(SAVEH.NE.HERE) RETURN
305: 500 CONTINUE
306: GO TO 3000
307: C
308: 1000 IF(PRSA.NE.DROPW) GO TO 2000
309: C !DROP EVERY/VALUA?
310: DO 1500 PRSO=1,OLNT
311: IF((OADV(PRSO).NE.WINNER).OR.NOTVAL(PRSO))
312: & GO TO 1500
313: F=.FALSE.
314: CALL RSPSUB(580,ODESC2(PRSO))
315: F1=DROP(.TRUE.)
316: IF(SAVEH.NE.HERE) RETURN
317: 1500 CONTINUE
318: GO TO 3000
319: C
320: 2000 IF(PRSA.NE.PUTW) GO TO 3000
321: C !PUT EVERY/VALUA?
322: DO 2500 PRSO=1,OLNT
323: C !LOOP THRU OBJECTS.
324: IF((OADV(PRSO).NE.WINNER)
325: & .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR.
326: & (and(OFLAG1(PRSO),VISIBT).EQ.0)) GO TO 2500
327: F=.FALSE.
328: CALL RSPSUB(580,ODESC2(PRSO))
329: F1=PUT(.TRUE.)
330: IF(SAVEH.NE.HERE) RETURN
331: 2500 CONTINUE
332: C
333: 3000 I=581
334: IF(SAVEP.EQ.V) I=582
335: C !CHOOSE MESSAGE.
336: 4000 IF(F) CALL RSPEAK(I)
337: C !IF NOTHING, REPORT.
338: RETURN
339: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.