![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to np2.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 np2.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 1: C GETOBJ-- FIND OBJ DESCRIBED BY ADJ, NAME PAIR
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: C THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG
10: C
11: INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ)
12: IMPLICIT INTEGER(A-Z)
13: LOGICAL THISIT,GHERE,LIT,CHOMP
14: #include "parser.h"
15: #include "gamestate.h"
16: C
17: C MISCELLANEOUS VARIABLES
18: C
19: COMMON /STAR/ MBASE,STRBIT
20: #include "debug.h"
21: #include "objects.h"
22: #include "oflags.h"
23: #include "advers.h"
24: #include "vocab.h"
25: C GETOBJ, PAGE 2
26: C
27: #ifdef debug
28: DFLAG=and(PRSFLG, 8).NE.0
29: #endif debug
30: CHOMP=.FALSE.
31: AV=AVEHIC(WINNER)
32: OBJ=0
33: C !ASSUME DARK.
34: IF(.NOT.LIT(HERE)) GO TO 200
35: C !LIT?
36: C
37: OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ)
38: C !SEARCH ROOM.
39: #ifdef debug
40: IF(DFLAG) PRINT 10,OBJ
41: #ifdef NOCC
42: 10 FORMAT('SCHLST- ROOM SCH ',I6)
43: #else NOCC
44: 10 FORMAT(' SCHLST- ROOM SCH ',I6)
45: #endif NOCC
46: #endif debug
47: IF(OBJ) 1000,200,100
48: C !TEST RESULT.
49: 100 IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.
50: & (and(OFLAG2(OBJ),FINDBT).NE.0)) GO TO 200
51: IF(OCAN(OBJ).EQ.AV) GO TO 200
52: C !TEST IF REACHABLE.
53: CHOMP=.TRUE.
54: C !PROBABLY NOT.
55: C
56: 200 IF(AV.EQ.0) GO TO 400
57: C !IN VEHICLE?
58: NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ)
59: C !SEARCH VEHICLE.
60: #ifdef debug
61: IF(DFLAG) PRINT 20,NOBJ
62: #ifdef NOCC
63: 20 FORMAT('SCHLST- VEH SCH ',I6)
64: #else NOCC
65: 20 FORMAT(' SCHLST- VEH SCH ',I6)
66: #endif NOCC
67: #endif debug
68: IF(NOBJ) 1100,400,300
69: C !TEST RESULT.
70: 300 CHOMP=.FALSE.
71: C !REACHABLE.
72: IF(OBJ.EQ.NOBJ) GO TO 400
73: C !SAME AS BEFORE?
74: IF(OBJ.NE.0) NOBJ=-NOBJ
75: C !AMB RESULT?
76: OBJ=NOBJ
77: C
78: 400 NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ)
79: C !SEARCH ADVENTURER.
80: #ifdef debug
81: IF(DFLAG) PRINT 30,NOBJ
82: #ifdef NOCC
83: 30 FORMAT('SCHLST- ADV SCH ',I6)
84: #else NOCC
85: 30 FORMAT(' SCHLST- ADV SCH ',I6)
86: #endif NOCC
87: #endif debug
88: IF(NOBJ) 1100,600,500
89: C !TEST RESULT
90: 500 IF(OBJ.NE.0) NOBJ=-NOBJ
91: C !AMB RESULT?
92: 1100 OBJ=NOBJ
93: C !RETURN NEW OBJECT.
94: 600 IF(CHOMP) OBJ=-10000
95: C !UNREACHABLE.
96: 1000 GETOBJ=OBJ
97: C
98: IF(GETOBJ.NE.0) GO TO 1500
99: C !GOT SOMETHING?
100: DO 1200 I=STRBIT+1,OLNT
101: C !NO, SEARCH GLOBALS.
102: IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200
103: IF(.NOT.GHERE(I,HERE)) GO TO 1200
104: C !CAN IT BE HERE?
105: IF(GETOBJ.NE.0) GETOBJ=-I
106: C !AMB MATCH?
107: IF(GETOBJ.EQ.0) GETOBJ=I
108: 1200 CONTINUE
109: C
110: 1500 CONTINUE
111: C !END OF SEARCH.
112: #ifdef debug
113: IF(DFLAG) PRINT 40,GETOBJ
114: #ifdef NOCC
115: 40 FORMAT('SCHLST- RESULT ',I6)
116: #else NOCC
117: 40 FORMAT(' SCHLST- RESULT ',I6)
118: #endif NOCC
119: #endif debug
120: RETURN
121: END
122: C SCHLST-- SEARCH FOR OBJECT
123: C
124: C DECLARATIONS
125: C
126: INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
127: IMPLICIT INTEGER(A-Z)
128: LOGICAL THISIT,QHERE,NOTRAN,NOVIS
129: C
130: COMMON /STAR/ MBASE,STRBIT
131: #include "objects.h"
132: #include "oflags.h"
133: C
134: C FUNCTIONS AND DATA
135: C
136: NOTRAN(O)=(and(OFLAG1(O),TRANBT).EQ.0).AND.
137: & (and(OFLAG2(O),OPENBT).EQ.0)
138: NOVIS(O)=(and(OFLAG1(O),VISIBT).EQ.0)
139: C
140: SCHLST=0
141: C !NO RESULT.
142: DO 1000 I=1,OLNT
143: C !SEARCH OBJECTS.
144: IF(NOVIS(I).OR.
145: & (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND.
146: & ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND.
147: & ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000
148: IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200
149: IF(SCHLST.NE.0) GO TO 2000
150: C !GOT ONE ALREADY?
151: SCHLST=I
152: C !NO.
153: C
154: C IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF.
155: C
156: 200 IF(NOTRAN(I)) GO TO 1000
157: C
158: C SEARCH IS CONDUCTED IN REVERSE. ALL OBJECTS ARE CHECKED TO
159: C SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'.
160: C IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT
161: C CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY
162: C AS A POTENTIAL MATCH.
163: C
164: DO 500 J=1,OLNT
165: C !SEARCH OBJECTS.
166: IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
167: & GO TO 500
168: X=OCAN(J)
169: C !GET CONTAINER.
170: 300 IF(X.EQ.I) GO TO 400
171: C !INSIDE TARGET?
172: IF(X.EQ.0) GO TO 500
173: C !INSIDE ANYTHING?
174: IF(NOVIS(X).OR.NOTRAN(X).OR.
175: & (and(OFLAG2(X),SCHBT).EQ.0)) GO TO 500
176: X=OCAN(X)
177: C !GO ANOTHER LEVEL.
178: GO TO 300
179: C
180: 400 IF(SCHLST.NE.0) GO TO 2000
181: C !ALREADY GOT ONE?
182: SCHLST=J
183: C !NO.
184: 500 CONTINUE
185: C
186: 1000 CONTINUE
187: RETURN
188: C
189: 2000 SCHLST=-SCHLST
190: C !AMB RETURN.
191: RETURN
192: C
193: END
194: C
195: C THISIT-- VALIDATE OBJECT VS DESCRIPTION
196: C
197: C DECLARATIONS
198: C
199: LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ)
200: IMPLICIT INTEGER(A-Z)
201: LOGICAL NOTEST
202: #include "vocab.h"
203: C
204: C FUNCTIONS AND DATA
205: C
206: NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN)
207: C
208: C THE FOLLOWING DATA STATEMENT USED RADIX-50 NOTATION (R50MIN/1RA/)
209: C IN RADIX-50 NOTATION, AN "A" IN THE FIRST POSITION IS
210: C ENCODED AS 1*40*40 = 1600.
211: C
212: DATA R50MIN/1600/
213: C
214: THISIT=.FALSE.
215: C !ASSUME NO MATCH.
216: IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
217: C
218: C CHECK FOR OBJECT NAMES
219: C
220: I=OIDX+1
221: 100 I=I+1
222: IF(NOTEST(OVOC(I))) RETURN
223: C !IF DONE, LOSE.
224: IF(OVOC(I).NE.OBJ) GO TO 100
225: C !IF FAIL, CONT.
226: C
227: IF(AIDX.EQ.0) GO TO 500
228: C !ANY ADJ?
229: I=AIDX+1
230: 200 I=I+1
231: IF(NOTEST(AVOC(I))) RETURN
232: C !IF DONE, LOSE.
233: IF(AVOC(I).NE.OBJ) GO TO 200
234: C !IF FAIL, CONT.
235: C
236: 500 THISIT=.TRUE.
237: RETURN
238: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.