Commit | Line | Data |
---|---|---|
8b22683c KB |
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 |