xref: /original-bsd/contrib/dungeon/actors.F (revision f1324ba5)
1C AAPPLI- APPLICABLES FOR ADVENTURERS
2C
3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
5C WRITTEN BY R. M. SUPNIK
6C
7C DECLARATIONS
8C
9	LOGICAL FUNCTION AAPPLI(RI)
10	IMPLICIT INTEGER (A-Z)
11	LOGICAL F,MOVETO
12#include "parser.h"
13#include "gamestate.h"
14#include "rooms.h"
15#include "rflag.h"
16#include "rindex.h"
17#include "xsrch.h"
18#include "objects.h"
19#include "oflags.h"
20#include "oindex.h"
21#include "clock.h"
22#include "advers.h"
23#include "verbs.h"
24#include "flags.h"
25C AAPPLI, PAGE 2
26C
27	IF(RI.EQ.0) GO TO 10
28C						!IF ZERO, NO APP.
29	AAPPLI=.TRUE.
30C						!ASSUME WINS.
31	GO TO (1000,2000),RI
32C						!BRANCH ON ADV.
33	CALL BUG(11,RI)
34C
35C COMMON FALSE RETURN.
36C
3710	AAPPLI=.FALSE.
38	RETURN
39C
40C A1--	ROBOT.  PROCESS MOST COMMANDS GIVEN TO ROBOT.
41C
421000	IF((PRSA.NE.RAISEW).OR.(PRSO.NE.RCAGE)) GO TO 1200
43	CFLAG(CEVSPH)=.FALSE.
44C						!ROBOT RAISED CAGE.
45	WINNER=PLAYER
46C						!RESET FOR PLAYER.
47	F=MOVETO(CAGER,WINNER)
48C						!MOVE TO NEW ROOM.
49	CALL NEWSTA(CAGE,567,CAGER,0,0)
50C						!INSTALL CAGE IN ROOM.
51	CALL NEWSTA(ROBOT,0,CAGER,0,0)
52C						!INSTALL ROBOT IN ROOM.
53	AROOM(AROBOT)=CAGER
54C						!ALSO MOVE ROBOT/ADV.
55	CAGESF=.TRUE.
56C						!CAGE SOLVED.
57	OFLAG1(ROBOT)=and(OFLAG1(ROBOT),not(NDSCBT))
58	OFLAG1(SPHER)=or(OFLAG1(SPHER),TAKEBT)
59	RETURN
60C
611200	IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 1300
62	CALL RSPEAK(568)
63C						!EAT OR DRINK, JOKE.
64	RETURN
65C
661300	IF(PRSA.NE.READW) GO TO 1400
67C						!READ,
68	CALL RSPEAK(569)
69C						!JOKE.
70	RETURN
71C
721400	IF((PRSA.EQ.WALKW).OR.(PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW)
73&	 .OR.(PRSA.EQ.PUTW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.THROWW)
74&	 .OR.(PRSA.EQ.TURNW).OR.(PRSA.EQ.LEAPW)) GO TO 10
75	CALL RSPEAK(570)
76C						!JOKE.
77	RETURN
78C AAPPLI, PAGE 3
79C
80C A2--	MASTER.  PROCESS MOST COMMANDS GIVEN TO MASTER.
81C
822000	IF(and(OFLAG2(QDOOR),OPENBT).NE.0) GO TO 2100
83	CALL RSPEAK(783)
84C						!NO MASTER YET.
85	RETURN
86C
872100	IF(PRSA.NE.WALKW) GO TO 2200
88C						!WALK?
89	I=784
90C						!ASSUME WONT.
91	IF(((HERE.EQ.SCORR).AND.
92&		((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XENTER))).OR.
93&	  ((HERE.EQ.NCORR).AND.
94&		((PRSO.EQ.XSOUTH).OR.(PRSO.EQ.XENTER))))
95&		I=785
96	CALL RSPEAK(I)
97	RETURN
98C
992200	IF((PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW).OR.(PRSA.EQ.PUTW).OR.
100&	  (PRSA.EQ.THROWW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.TURNW).OR.
101&	  (PRSA.EQ.SPINW).OR.(PRSA.EQ.TRNTOW).OR.(PRSA.EQ.FOLLOW).OR.
102&	  (PRSA.EQ.STAYW).OR.(PRSA.EQ.OPENW).OR.(PRSA.EQ.CLOSEW).OR.
103&	  (PRSA.EQ.KILLW)) GO TO 10
104	CALL RSPEAK(786)
105C						!MASTER CANT DO IT.
106	RETURN
107C
108	END
109C THIEFD-	INTERMOVE THIEF DEMON
110C
111C DECLARATIONS
112C
113	SUBROUTINE THIEFD
114	IMPLICIT INTEGER (A-Z)
115	LOGICAL ONCE,PROB,QHERE,QSTILL,LIT,WINNIN
116#include "gamestate.h"
117C
118#include "debug.h"
119#include "rooms.h"
120#include "rflag.h"
121#include "rindex.h"
122#include "objects.h"
123#include "oflags.h"
124#include "oindex.h"
125#include "villians.h"
126#include "flags.h"
127C
128C FUNCTIONS AND DATA
129C
130	QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF))
131C THIEFD, PAGE 2
132C
133#ifdef debug
134	DFLAG=and(PRSFLG, 32768).NE.0
135#endif debug
136C						!SET UP DETAIL FLAG.
137	ONCE=.FALSE.
138C						!INIT FLAG.
1391025	RHERE=OROOM(THIEF)
140C						!VISIBLE POS.
141	IF(RHERE.NE.0) THFPOS=RHERE
142C
143	IF(THFPOS.EQ.HERE) GO TO 1100
144C						!THIEF IN WIN RM?
145	IF(THFPOS.NE.TREAS) GO TO 1400
146C						!THIEF NOT IN TREAS?
147C
148C THIEF IS IN TREASURE ROOM, AND WINNER IS NOT.
149C
150#ifdef debug
151	IF(DFLAG) PRINT 10
152#ifdef NOCC
15310	FORMAT('THIEFD-- IN TREASURE ROOM')
154#else NOCC
15510	FORMAT(' THIEFD-- IN TREASURE ROOM')
156#endif
157#endif debug
158	IF(RHERE.EQ.0) GO TO 1050
159C						!VISIBLE?
160	CALL NEWSTA(THIEF,0,0,0,0)
161C						!YES, VANISH.
162	RHERE=0
163	IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0)
1641050	I=ROBADV(-THIEF,THFPOS,0,0)
165C						!DROP VALUABLES.
166	IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=or(OFLAG2(EGG),OPENBT)
167	GO TO 1700
168C
169C THIEF AND WINNER IN SAME ROOM.
170C
1711100	IF(THFPOS.EQ.TREAS) GO TO 1700
172C						!IF TREAS ROOM, NOTHING.
173	IF(and(RFLAG(THFPOS),RLIGHT).NE.0) GO TO 1400
174#ifdef debug
175	IF(DFLAG) PRINT 20
176#ifdef NOCC
17720	FORMAT('THIEFD-- IN ADV ROOM')
178#else NOCC
17920	FORMAT(' THIEFD-- IN ADV ROOM')
180#endif NOCC
181#endif debug
182	IF(THFFLG) GO TO 1300
183C						!THIEF ANNOUNCED?
184	IF((RHERE.NE.0).OR.PROB(70,70)) GO TO 1150
185C						!IF INVIS AND 30%.
186	IF(OCAN(STILL).NE.THIEF) GO TO 1700
187C						!ABORT IF NO STILLETTO.
188	CALL NEWSTA(THIEF,583,THFPOS,0,0)
189C						!INSERT THIEF INTO ROOM.
190	THFFLG=.TRUE.
191C						!THIEF IS ANNOUNCED.
192	RETURN
193C
1941150	IF((RHERE.EQ.0).OR.(and(OFLAG2(THIEF),FITEBT).EQ.0))
195&		GO TO 1200
196	IF(WINNIN(THIEF,WINNER)) GO TO 1175
197C						!WINNING?
198	CALL NEWSTA(THIEF,584,0,0,0)
199C						!NO, VANISH THIEF.
200	OFLAG2(THIEF)=and(OFLAG2(THIEF), not(FITEBT))
201	IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
202	RETURN
203C
2041175	IF(PROB(90,90)) GO TO 1700
205C						!90% CHANCE TO STAY.
206C
2071200	IF((RHERE.EQ.0).OR.PROB(70,70)) GO TO 1250
208C						!IF VISIBLE AND 30%
209	CALL NEWSTA(THIEF,585,0,0,0)
210C						!VANISH THIEF.
211	IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0)
212	RETURN
213C
2141300	IF(RHERE.EQ.0) GO TO 1700
215C						!ANNOUNCED.  VISIBLE?
2161250	IF(PROB(70,70)) RETURN
217C						!70% CHANCE TO DO NOTHING.
218	THFFLG=.TRUE.
219	NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(WINNER,0,0,-THIEF)
220	I=586
221C						!ROBBED EM.
222	IF(RHERE.NE.0) I=588
223C						!WAS HE VISIBLE?
224	IF(NR.NE.0) I=I+1
225C						!DID HE GET ANYTHING?
226	CALL NEWSTA(THIEF,I,0,0,0)
227C						!VANISH THIEF.
228	IF(QSTILL(THFPOS))
229&		CALL NEWSTA(STILL,0,0,THIEF,0)
230	IF((NR.NE.0).AND..NOT.LIT(THFPOS)) CALL RSPEAK(406)
231	RHERE=0
232	GO TO 1700
233C						!ONWARD.
234C
235C NOT IN ADVENTURERS ROOM.
236C
2371400	CALL NEWSTA(THIEF,0,0,0,0)
238C						!VANISH.
239	RHERE=0
240#ifdef debug
241	IF(DFLAG) PRINT 30,THFPOS
242#ifdef NOCC
24330	FORMAT('THIEFD-- IN ROOM ',I4)
244#else NOCC
24530	FORMAT(' THIEFD-- IN ROOM ',I4)
246#endif NOCC
247#endif debug
248	IF(QSTILL(THFPOS))
249&		CALL NEWSTA(STILL,0,0,THIEF,0)
250	IF(and(RFLAG(THFPOS),RSEEN).EQ.0) GO TO 1700
251	I=ROBRM(THFPOS,75,0,0,-THIEF)
252C						!ROB ROOM 75%.
253	IF((THFPOS.LT.MAZE1).OR.(THFPOS.GT.MAZ15).OR.
254&		(HERE.LT.MAZE1).OR.(HERE.GT.MAZ15)) GO TO 1500
255	DO 1450 I=1,OLNT
256C						!BOTH IN MAZE.
257	  IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR.
258&		(and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
259&		GO TO 1450
260	  CALL RSPSUB(590,ODESC2(I))
261C						!TAKE OBJECT.
262	  IF(PROB(40,20)) GO TO 1700
263	  CALL NEWSTA(I,0,0,0,-THIEF)
264C						!MOST OF THE TIME.
265	  OFLAG2(I)=or(OFLAG2(I),TCHBT)
266	  GO TO 1700
2671450	CONTINUE
268	GO TO 1700
269C
2701500	DO 1550 I=1,OLNT
271C						!NOT IN MAZE.
272	  IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.PROB(80,60).OR.
273&		(and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT)))
274&		GO TO 1550
275	  CALL NEWSTA(I,0,0,0,-THIEF)
276	  OFLAG2(I)=or(OFLAG2(I),TCHBT)
277	  GO TO 1700
2781550	CONTINUE
279C
280C NOW MOVE TO NEW ROOM.
281C
2821700	IF(OADV(ROPE).EQ.-THIEF) DOMEF=.FALSE.
283	IF(ONCE) GO TO 1800
284	ONCE=.NOT.ONCE
2851750	THFPOS=THFPOS-1
286C						!NEXT ROOM.
287	IF(THFPOS.LE.0) THFPOS=RLNT
288	IF(and(RFLAG(THFPOS),(RLAND+RSACRD+REND)).NE.RLAND)
289&		GO TO 1750
290	THFFLG=.FALSE.
291C						!NOT ANNOUNCED.
292	GO TO 1025
293C						!ONCE MORE.
294C
295C ALL DONE.
296C
2971800	IF(THFPOS.EQ.TREAS) RETURN
298C						!IN TREASURE ROOM?
299	J=591
300C						!NO, DROP STUFF.
301	IF(THFPOS.NE.HERE) J=0
302	DO 1850 I=1,OLNT
303	  IF((OADV(I).NE.-THIEF).OR.PROB(70,70).OR.
304&		(OTVAL(I).GT.0)) GO TO 1850
305	  CALL NEWSTA(I,J,THFPOS,0,0)
306	  J=0
3071850	CONTINUE
308	RETURN
309C
310	END
311