[unix-history] / usr / src / contrib / dungeon / np3.F

C SYNMCH--	SYNTAX MATCHER
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
C THIS ROUTINE DETAILS ON BIT 4 OF PRSFLG
C
	LOGICAL FUNCTION SYNMCH()
	IMPLICIT INTEGER(A-Z)
	LOGICAL SYNEQL,TAKEIT
#include "parser.h"
#include "vocab.h"
#include "debug.h"
C
C   THE FOLLOWING DATA STATEMENT WAS ORIGINALLY:
C
C	DATA R50MIN/1RA/
C
	DATA R50MIN/1600/
C
	SYNMCH=.FALSE.
#ifdef debug
	DFLAG=and(PRSFLG, 16).NE.0
	if(dflag) write(0,*) "synflags=",sdir,sind,sstd,sflip,sdriv,svmask
#endif
	J=ACT
C						!SET UP PTR TO SYNTAX.
	DRIVE=0
C						!NO DEFAULT.
	DFORCE=0
C						!NO FORCED DEFAULT.
	QPREP=and(OFLAG,OPREP)
100	J=J+2
C						!FIND START OF SYNTAX.
	IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100
	LIMIT=J+VVOC(J)+1
C						!COMPUTE LIMIT.
	J=J+1
C						!ADVANCE TO NEXT.
C
200	CALL UNPACK(J,NEWJ)
C						!UNPACK SYNTAX.
#ifdef debug
	IF(DFLAG) PRINT 60,O1,P1,DOBJ,DFL1,DFL2
#ifdef NOCC
60	FORMAT('SYNMCH INPUTS TO SYNEQL- ',5I7)
#else NOCC
60	FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7)
#endif NOCC
#endif
	SPREP=and(DOBJ,VPMASK)
	IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000
#ifdef debug
	IF(DFLAG) PRINT 60,O2,P2,IOBJ,IFL1,IFL2
#endif
	SPREP=and(IOBJ,VPMASK)
	IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000
C
C SYNTAX MATCH FAILS, TRY NEXT ONE.
C
	IF(O2) 3000,500,3000
C						!IF O2=0, SET DFLT.
1000	IF(O1) 3000,500,3000
C						!IF O1=0, SET DFLT.
500	IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J
C						!IF PREP MCH.
	IF((and(VFLAG,SDRIV)).NE.0) DRIVE=J
3000	J=NEWJ
	IF(J.LT.LIMIT) GO TO 200
C						!MORE TO DO?
C SYNMCH, PAGE 2
C
C MATCH HAS FAILED.  IF DEFAULT SYNTAX EXISTS, TRY TO SNARF
C ORPHANS OR GWIMS, OR MAKE NEW ORPHANS.
C
#ifdef debug
	IF(DFLAG) PRINT 20,DRIVE,DFORCE
#ifdef NOCC
20	FORMAT('SYNMCH, DRIVE=',2I6)
#else NOCC
20	FORMAT(' SYNMCH, DRIVE=',2I6)
#endif NOCC
#endif
	IF(DRIVE.EQ.0) DRIVE=DFORCE
C						!NO DRIVER? USE FORCE.
	IF(DRIVE.EQ.0) GO TO 10000
C						!ANY DRIVER?
	CALL UNPACK(DRIVE,DFORCE)
C						!UNPACK DFLT SYNTAX.
C
C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
	IF((and(VFLAG,SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000
C
C FIRST TRY TO SNARF ORPHAN OBJECT.
C
	O1=and(OFLAG,OSLOT)
	IF(O1.EQ.0) GO TO 3500
C						!ANY ORPHAN?
	IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000
C
C ORPHAN FAILS, TRY GWIM.
C
3500	O1=GWIM(DOBJ,DFW1,DFW2)
C						!GET GWIM.
#ifdef debug
	IF(DFLAG) PRINT 30,O1
#ifdef NOCC
30	FORMAT('SYNMCH- DO GWIM= ',I6)
#else NOCC
30	FORMAT(' SYNMCH- DO GWIM= ',I6)
#endif NOCC
#endif debug
	IF(O1.GT.0) GO TO 4000
C						!TEST RESULT.
	CALL ORPHAN(-1,ACT,0,and(DOBJ,VPMASK),0)
	CALL RSPEAK(623)
	RETURN
C
C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
C
4000	IF((and(VFLAG,SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000
	O2=GWIM(IOBJ,IFW1,IFW2)
C						!GWIM.
#ifdef debug
	IF(DFLAG) PRINT 40,O2
#ifdef NOCC
40	FORMAT('SYNMCH- IO GWIM= ',I6)
#else NOCC
40	FORMAT(' SYNMCH- IO GWIM= ',I6)
#endif NOCC
#endif debug
	IF(O2.GT.0) GO TO 6000
	IF(O1.EQ.0) O1=and(OFLAG,OSLOT)
	CALL ORPHAN(-1,ACT,O1,and(DOBJ,VPMASK),0)
	CALL RSPEAK(624)
	RETURN
C
C TOTAL CHOMP
C
10000	CALL RSPEAK(601)
C						!CANT DO ANYTHING.
	RETURN
C SYNMCH, PAGE 3
C
C NOW TRY TO TAKE INDIVIDUAL OBJECTS AND
C IN GENERAL CLEAN UP THE PARSE VECTOR.
C
6000	IF(and(VFLAG,SFLIP).EQ.0) GO TO 5000
	J=O1
C						!YES.
	O1=O2
	O2=J
C
5000	PRSA=and(VFLAG,SVMASK)
	PRSO=O1
C						!GET DIR OBJ.
	PRSI=O2
C						!GET IND OBJ.
	IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN
C						!TRY TAKE.
	IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN
C						!TRY TAKE.
	SYNMCH=.TRUE.
#ifdef debug
	IF(DFLAG) PRINT 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2
#ifdef NOCC
50	FORMAT('SYNMCH- RESULTS ',L1,6I7)
#else NOCC
50	FORMAT(' SYNMCH- RESULTS ',L1,6I7)
#endif NOCC
#endif
	RETURN
C
	END
C UNPACK-	UNPACK SYNTAX SPECIFICATION, ADV POINTER
C
C DECLARATIONS
C
	SUBROUTINE UNPACK(OLDJ,J)
	IMPLICIT INTEGER(A-Z)
#include "vocab.h"
#include "parser.h"
C
	DO 10 I=1,11
C						!CLEAR SYNTAX.
	  SYN(I)=0
10	CONTINUE
C
	VFLAG=VVOC(OLDJ)
	J=OLDJ+1
	IF(and(VFLAG,SDIR).EQ.0) RETURN
	DFL1=-1
C						!ASSUME STD.
	DFL2=-1
	IF(and(VFLAG,SSTD).EQ.0) GO TO 100
	DFW1=-1
C						!YES.
	DFW2=-1
	DOBJ=VABIT+VRBIT+VFBIT
	GO TO 200
C
100	DOBJ=VVOC(J)
C						!NOT STD.
	DFW1=VVOC(J+1)
	DFW2=VVOC(J+2)
	J=J+3
	IF(and(DOBJ,VEBIT).EQ.0) GO TO 200
	DFL1=DFW1
C						!YES.
	DFL2=DFW2
C
200	IF(and(VFLAG,SIND).EQ.0) RETURN
	IFL1=-1
C						!ASSUME STD.
	IFL2=-1
	IOBJ=VVOC(J)
	IFW1=VVOC(J+1)
	IFW2=VVOC(J+2)
	J=J+3
	IF(and(IOBJ,VEBIT).EQ.0) RETURN
	IFL1=IFW1
C						!YES.
	IFL2=IFW2
	RETURN
C
	END
C SYNEQL-	TEST FOR SYNTAX EQUALITY
C
C DECLARATIONS
C
	LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
	IMPLICIT INTEGER(A-Z)
#include "objects.h"
#include "parser.h"
C
	IF(OBJ.EQ.0) GO TO 100
C						!ANY OBJECT?
	SYNEQL=(PREP.EQ.and(SPREP,VPMASK)).AND.
&		(or(and(SFL1,OFLAG1(OBJ)),
&		  and(SFL2,OFLAG2(OBJ))).NE.0)
	RETURN
C
100	SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
	RETURN
C
	END
C TAKEIT-	PARSER BASED TAKE OF OBJECT
C
C DECLARATIONS
C
	LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
	IMPLICIT INTEGER(A-Z)
#include "parser.h"
	COMMON /STAR/ MBASE,STRBIT
#include "gamestate.h"
#include "state.h"
#include "objects.h"
#include "oflags.h"
#include "advers.h"
C TAKEIT, PAGE 2
C
	TAKEIT=.FALSE.
C						!ASSUME LOSES.
	IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000
C						!NULL/STARS WIN.
	ODO2=ODESC2(OBJ)
C						!GET DESC.
	X=OCAN(OBJ)
C						!GET CONTAINER.
	IF((X.EQ.0).OR.(and(SFLAG,VFBIT).EQ.0)) GO TO 500
	IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 500
	CALL RSPSUB(566,ODO2)
C						!CANT REACH.
	RETURN
C
500	IF(and(SFLAG,VRBIT).EQ.0) GO TO 1000
	IF(and(SFLAG,VTBIT).EQ.0) GO TO 2000
C
C SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0)
C
	IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
C						!IF NOT, OK.
C
C ITS IN THE ROOM AND CAN BE TAKEN.
C
	IF((and(OFLAG1(OBJ),TAKEBT).NE.0).AND.
&		(and(OFLAG2(OBJ),TRYBT).EQ.0)) GO TO 3000
C
C NOT TAKEABLE.  IF WE CARE, FAIL.
C
	IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
	CALL RSPSUB(445,ODO2)
	RETURN
C
C 1000--	IT SHOULD NOT BE IN THE ROOM.
C 2000--	IT CANT BE TAKEN.
C
2000	IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
1000	IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
	CALL RSPSUB(665,ODO2)
	RETURN
C TAKEIT, PAGE 3
C
C OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER,
C AND IS TAKEABLE IN GENERAL.  IT IS NOT A STAR.
C TAKING IT SHOULD NOT HAVE SIDE AFFECTS.
C IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN.
C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE.
C
3000	IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500
C						!TAKE VEHICLE?
	CALL RSPEAK(672)
	RETURN
C
3500	IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
&	 ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD))
&	 GO TO 3700
	CALL RSPEAK(558)
C						!TOO BIG.
	RETURN
C
3700	CALL NEWSTA(OBJ,559,0,0,WINNER)
C						!DO TAKE.
	OFLAG2(OBJ)=or(OFLAG2(OBJ),TCHBT)
	CALL SCRUPD(OFVAL(OBJ))
	OFVAL(OBJ)=0
C
4000	TAKEIT=.TRUE.
C						!SUCCESS.
	RETURN
C
	END
C
C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS
C
C DECLARATIONS
C
	INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
	IMPLICIT INTEGER(A-Z)
	LOGICAL TAKEIT,NOCARE
#include "parser.h"
	COMMON /STAR/ MBASE,STRBIT
#include "gamestate.h"
#include "objects.h"
#include "oflags.h"
#include "advers.h"
C GWIM, PAGE 2
C
	GWIM=-1
C						!ASSUME LOSE.
	AV=AVEHIC(WINNER)
	NOBJ=0
	NOCARE=and(SFLAG,VCBIT).EQ.0
C
C FIRST SEARCH ADVENTURER
C
	IF(and(SFLAG,VABIT).NE.0)
&		NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
	IF(and(SFLAG,VRBIT).NE.0) GO TO 100
50	GWIM=NOBJ
	RETURN
C
C ALSO SEARCH ROOM
C
100	ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
	IF(ROBJ) 500,50,200
C						!TEST RESULT.
C
C ROBJ > 0
C
200	IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
&		(and(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300
	IF(OCAN(ROBJ).NE.AV) GO TO 50
C						!UNREACHABLE? TRY NOBJ
300	IF(NOBJ.NE.0) RETURN
C						!IF AMBIGUOUS, RETURN.
	IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN
C						!IF UNTAKEABLE, RETURN
	GWIM=ROBJ
500	RETURN
C
	END
Commit	Line	Data
8b22683c KB	1	C SYNMCH-- SYNTAX MATCHER
	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 4 OF PRSFLG
	10	C
	11	LOGICAL FUNCTION SYNMCH()
	12	IMPLICIT INTEGER(A-Z)
	13	LOGICAL SYNEQL,TAKEIT
	14	#include "parser.h"
	15	#include "vocab.h"
	16	#include "debug.h"
	17	C
	18	C THE FOLLOWING DATA STATEMENT WAS ORIGINALLY:
	19	C
	20	C DATA R50MIN/1RA/
	21	C
	22	DATA R50MIN/1600/
	23	C
	24	SYNMCH=.FALSE.
	25	#ifdef debug
	26	DFLAG=and(PRSFLG, 16).NE.0
	27	if(dflag) write(0,*) "synflags=",sdir,sind,sstd,sflip,sdriv,svmask
	28	#endif
	29	J=ACT
	30	C !SET UP PTR TO SYNTAX.
	31	DRIVE=0
	32	C !NO DEFAULT.
	33	DFORCE=0
	34	C !NO FORCED DEFAULT.
	35	QPREP=and(OFLAG,OPREP)
	36	100 J=J+2
	37	C !FIND START OF SYNTAX.
	38	IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100
	39	LIMIT=J+VVOC(J)+1
	40	C !COMPUTE LIMIT.
	41	J=J+1
	42	C !ADVANCE TO NEXT.
	43	C
	44	200 CALL UNPACK(J,NEWJ)
	45	C !UNPACK SYNTAX.
	46	#ifdef debug
	47	IF(DFLAG) PRINT 60,O1,P1,DOBJ,DFL1,DFL2
	48	#ifdef NOCC
	49	60 FORMAT('SYNMCH INPUTS TO SYNEQL- ',5I7)
	50	#else NOCC
	51	60 FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7)
	52	#endif NOCC
	53	#endif
	54	SPREP=and(DOBJ,VPMASK)
	55	IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000
	56	#ifdef debug
	57	IF(DFLAG) PRINT 60,O2,P2,IOBJ,IFL1,IFL2
	58	#endif
	59	SPREP=and(IOBJ,VPMASK)
	60	IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000
	61	C
	62	C SYNTAX MATCH FAILS, TRY NEXT ONE.
	63	C
	64	IF(O2) 3000,500,3000
65	C !IF O2=0, SET DFLT.
66	1000 IF(O1) 3000,500,3000
67	C !IF O1=0, SET DFLT.
68	500 IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J
69	C !IF PREP MCH.
70	IF((and(VFLAG,SDRIV)).NE.0) DRIVE=J
71	3000 J=NEWJ
72	IF(J.LT.LIMIT) GO TO 200
73	C !MORE TO DO?
74	C SYNMCH, PAGE 2
75	C
76	C MATCH HAS FAILED. IF DEFAULT SYNTAX EXISTS, TRY TO SNARF
77	C ORPHANS OR GWIMS, OR MAKE NEW ORPHANS.
78	C
79	#ifdef debug
80	IF(DFLAG) PRINT 20,DRIVE,DFORCE
81	#ifdef NOCC
82	20 FORMAT('SYNMCH, DRIVE=',2I6)
83	#else NOCC
84	20 FORMAT(' SYNMCH, DRIVE=',2I6)
85	#endif NOCC
86	#endif
87	IF(DRIVE.EQ.0) DRIVE=DFORCE
88	C !NO DRIVER? USE FORCE.
89	IF(DRIVE.EQ.0) GO TO 10000
90	C !ANY DRIVER?
91	CALL UNPACK(DRIVE,DFORCE)
92	C !UNPACK DFLT SYNTAX.
93	C
94	C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
95	C
96	IF((and(VFLAG,SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000
97	C
98	C FIRST TRY TO SNARF ORPHAN OBJECT.
99	C
100	O1=and(OFLAG,OSLOT)
101	IF(O1.EQ.0) GO TO 3500
102	C !ANY ORPHAN?
103	IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000
104	C
105	C ORPHAN FAILS, TRY GWIM.
106	C
107	3500 O1=GWIM(DOBJ,DFW1,DFW2)
108	C !GET GWIM.
109	#ifdef debug
110	IF(DFLAG) PRINT 30,O1
111	#ifdef NOCC
112	30 FORMAT('SYNMCH- DO GWIM= ',I6)
113	#else NOCC
114	30 FORMAT(' SYNMCH- DO GWIM= ',I6)
115	#endif NOCC
116	#endif debug
117	IF(O1.GT.0) GO TO 4000
118	C !TEST RESULT.
119	CALL ORPHAN(-1,ACT,0,and(DOBJ,VPMASK),0)
120	CALL RSPEAK(623)
121	RETURN
122	C
123	C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM.
124	C
125	4000 IF((and(VFLAG,SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000
126	O2=GWIM(IOBJ,IFW1,IFW2)
127	C !GWIM.
128	#ifdef debug
129	IF(DFLAG) PRINT 40,O2
130	#ifdef NOCC
131	40 FORMAT('SYNMCH- IO GWIM= ',I6)
132	#else NOCC
133	40 FORMAT(' SYNMCH- IO GWIM= ',I6)
134	#endif NOCC
135	#endif debug
136	IF(O2.GT.0) GO TO 6000
137	IF(O1.EQ.0) O1=and(OFLAG,OSLOT)
138	CALL ORPHAN(-1,ACT,O1,and(DOBJ,VPMASK),0)
139	CALL RSPEAK(624)
140	RETURN
141	C
142	C TOTAL CHOMP
143	C
144	10000 CALL RSPEAK(601)
145	C !CANT DO ANYTHING.
146	RETURN
147	C SYNMCH, PAGE 3
148	C
149	C NOW TRY TO TAKE INDIVIDUAL OBJECTS AND
150	C IN GENERAL CLEAN UP THE PARSE VECTOR.
151	C
152	6000 IF(and(VFLAG,SFLIP).EQ.0) GO TO 5000
153	J=O1
154	C !YES.
155	O1=O2
156	O2=J
157	C
158	5000 PRSA=and(VFLAG,SVMASK)
159	PRSO=O1
160	C !GET DIR OBJ.
161	PRSI=O2
162	C !GET IND OBJ.
163	IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN
164	C !TRY TAKE.
165	IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN
166	C !TRY TAKE.
167	SYNMCH=.TRUE.
168	#ifdef debug
169	IF(DFLAG) PRINT 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2
170	#ifdef NOCC
171	50 FORMAT('SYNMCH- RESULTS ',L1,6I7)
172	#else NOCC
173	50 FORMAT(' SYNMCH- RESULTS ',L1,6I7)
174	#endif NOCC
175	#endif
176	RETURN
177	C
178	END
179	C UNPACK- UNPACK SYNTAX SPECIFICATION, ADV POINTER
180	C
181	C DECLARATIONS
182	C
183	SUBROUTINE UNPACK(OLDJ,J)
184	IMPLICIT INTEGER(A-Z)
185	#include "vocab.h"
186	#include "parser.h"
187	C
188	DO 10 I=1,11
189	C !CLEAR SYNTAX.
190	SYN(I)=0
191	10 CONTINUE
192	C
193	VFLAG=VVOC(OLDJ)
194	J=OLDJ+1
195	IF(and(VFLAG,SDIR).EQ.0) RETURN
196	DFL1=-1
197	C !ASSUME STD.
198	DFL2=-1
199	IF(and(VFLAG,SSTD).EQ.0) GO TO 100
200	DFW1=-1
201	C !YES.
202	DFW2=-1
203	DOBJ=VABIT+VRBIT+VFBIT
204	GO TO 200
205	C
206	100 DOBJ=VVOC(J)
207	C !NOT STD.
208	DFW1=VVOC(J+1)
209	DFW2=VVOC(J+2)
210	J=J+3
211	IF(and(DOBJ,VEBIT).EQ.0) GO TO 200
212	DFL1=DFW1
213	C !YES.
214	DFL2=DFW2
215	C
216	200 IF(and(VFLAG,SIND).EQ.0) RETURN
217	IFL1=-1
218	C !ASSUME STD.
219	IFL2=-1
220	IOBJ=VVOC(J)
221	IFW1=VVOC(J+1)
222	IFW2=VVOC(J+2)
223	J=J+3
224	IF(and(IOBJ,VEBIT).EQ.0) RETURN
225	IFL1=IFW1
226	C !YES.
227	IFL2=IFW2
228	RETURN
229	C
230	END
231	C SYNEQL- TEST FOR SYNTAX EQUALITY
232	C
233	C DECLARATIONS
234	C
235	LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2)
236	IMPLICIT INTEGER(A-Z)
237	#include "objects.h"
238	#include "parser.h"
239	C
240	IF(OBJ.EQ.0) GO TO 100
241	C !ANY OBJECT?
242	SYNEQL=(PREP.EQ.and(SPREP,VPMASK)).AND.
243	& (or(and(SFL1,OFLAG1(OBJ)),
244	& and(SFL2,OFLAG2(OBJ))).NE.0)
245	RETURN
246	C
247	100 SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0)
248	RETURN
249	C
250	END
251	C TAKEIT- PARSER BASED TAKE OF OBJECT
252	C
253	C DECLARATIONS
254	C
255	LOGICAL FUNCTION TAKEIT(OBJ,SFLAG)
256	IMPLICIT INTEGER(A-Z)
257	#include "parser.h"
258	COMMON /STAR/ MBASE,STRBIT
259	#include "gamestate.h"
260	#include "state.h"
261	#include "objects.h"
262	#include "oflags.h"
263	#include "advers.h"
264	C TAKEIT, PAGE 2
265	C
266	TAKEIT=.FALSE.
267	C !ASSUME LOSES.
268	IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000
269	C !NULL/STARS WIN.
270	ODO2=ODESC2(OBJ)
271	C !GET DESC.
272	X=OCAN(OBJ)
273	C !GET CONTAINER.
274	IF((X.EQ.0).OR.(and(SFLAG,VFBIT).EQ.0)) GO TO 500
275	IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 500
276	CALL RSPSUB(566,ODO2)
277	C !CANT REACH.
278	RETURN
279	C
280	500 IF(and(SFLAG,VRBIT).EQ.0) GO TO 1000
281	IF(and(SFLAG,VTBIT).EQ.0) GO TO 2000
282	C
283	C SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0)
284	C
285	IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
286	C !IF NOT, OK.
287	C
288	C ITS IN THE ROOM AND CAN BE TAKEN.
289	C
290	IF((and(OFLAG1(OBJ),TAKEBT).NE.0).AND.
291	& (and(OFLAG2(OBJ),TRYBT).EQ.0)) GO TO 3000
292	C
293	C NOT TAKEABLE. IF WE CARE, FAIL.
294	C
295	IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
296	CALL RSPSUB(445,ODO2)
297	RETURN
298	C
299	C 1000-- IT SHOULD NOT BE IN THE ROOM.
300	C 2000-- IT CANT BE TAKEN.
301	C
302	2000 IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000
303	1000 IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000
304	CALL RSPSUB(665,ODO2)
305	RETURN
306	C TAKEIT, PAGE 3
307	C
308	C OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER,
309	C AND IS TAKEABLE IN GENERAL. IT IS NOT A STAR.
310	C TAKING IT SHOULD NOT HAVE SIDE AFFECTS.
311	C IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN.
312	C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE.
313	C
314	3000 IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500
315	C !TAKE VEHICLE?
316	CALL RSPEAK(672)
317	RETURN
318	C
319	3500 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR.
320	& ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD))
321	& GO TO 3700
322	CALL RSPEAK(558)
323	C !TOO BIG.
324	RETURN
325	C
326	3700 CALL NEWSTA(OBJ,559,0,0,WINNER)
327	C !DO TAKE.
328	OFLAG2(OBJ)=or(OFLAG2(OBJ),TCHBT)
329	CALL SCRUPD(OFVAL(OBJ))
330	OFVAL(OBJ)=0
331	C
332	4000 TAKEIT=.TRUE.
333	C !SUCCESS.
334	RETURN
335	C
336	END
337	C
338	C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS
339	C
340	C DECLARATIONS
341	C
342	INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2)
343	IMPLICIT INTEGER(A-Z)
344	LOGICAL TAKEIT,NOCARE
345	#include "parser.h"
346	COMMON /STAR/ MBASE,STRBIT
347	#include "gamestate.h"
348	#include "objects.h"
349	#include "oflags.h"
350	#include "advers.h"
351	C GWIM, PAGE 2
352	C
353	GWIM=-1
354	C !ASSUME LOSE.
355	AV=AVEHIC(WINNER)
356	NOBJ=0
357	NOCARE=and(SFLAG,VCBIT).EQ.0
358	C
359	C FIRST SEARCH ADVENTURER
360	C
361	IF(and(SFLAG,VABIT).NE.0)
362	& NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE)
363	IF(and(SFLAG,VRBIT).NE.0) GO TO 100
364	50 GWIM=NOBJ
365	RETURN
366	C
367	C ALSO SEARCH ROOM
368	C
369	100 ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE)
370	IF(ROBJ) 500,50,200
371	C !TEST RESULT.
372	C
373	C ROBJ > 0
374	C
375	200 IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR.
376	& (and(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300
377	IF(OCAN(ROBJ).NE.AV) GO TO 50
378	C !UNREACHABLE? TRY NOBJ
379	300 IF(NOBJ.NE.0) RETURN
380	C !IF AMBIGUOUS, RETURN.
381	IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN
382	C !IF UNTAKEABLE, RETURN
383	GWIM=ROBJ
384	500 RETURN
385	C
386	END