xref: /original-bsd/contrib/dungeon/demons.F (revision 5133e8a4)
1C FIGHTD- INTERMOVE FIGHT DEMON
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	SUBROUTINE FIGHTD
10	IMPLICIT INTEGER (A-Z)
11	LOGICAL PROB,OAPPLI
12#include "parser.h"
13#include "gamestate.h"
14#include "objects.h"
15#include "oflags.h"
16#include "oindex.h"
17#include "villians.h"
18#include "advers.h"
19#include "verbs.h"
20#include "flags.h"
21C
22	LOGICAL F
23C
24C FUNCTIONS AND DATA
25C
26	DATA ROUT/1/
27C FIGHTD, PAGE 2
28C
29	DO 2400 I=1,VLNT
30C						!LOOP THRU VILLAINS.
31	  VOPPS(I)=0
32C						!CLEAR OPPONENT SLOT.
33	  OBJ=VILLNS(I)
34C						!GET OBJECT NO.
35	  RA=OACTIO(OBJ)
36C						!GET HIS ACTION.
37	  IF(HERE.NE.OROOM(OBJ)) GO TO 2200
38C						!ADVENTURER STILL HERE?
39	  IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400
40C						!THIEF ENGROSSED?
41	  IF(OCAPAC(OBJ).GE.0) GO TO 2050
42C						!YES, VILL AWAKE?
43	  IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),VPROB(I)))
44&		GO TO 2025
45	  OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
46	  VPROB(I)=0
47	  IF(RA.EQ.0) GO TO 2400
48C						!ANYTHING TO DO?
49	  PRSA=INXW
50C						!YES, WAKE HIM UP.
51	  F=OAPPLI(RA,0)
52	  GO TO 2400
53C						!NOTHING ELSE HAPPENS.
54C
552025	  VPROB(I)=VPROB(I)+10
56C						!INCREASE WAKEUP PROB.
57	  GO TO 2400
58C						!NOTHING ELSE.
59C
602050	  IF((and(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
61	  VOPPS(I)=OBJ
62C						!FIGHTING, SET UP OPP.
63	  GO TO 2400
64C
652100	  IF(RA.EQ.0) GO TO 2400
66C						!NOT FIGHTING,
67	  PRSA=FRSTQW
68C						!SET UP PROBABILITY
69	  IF(.NOT.OAPPLI(RA,0)) GO TO 2400
70C						!OF FIGHTING.
71	  OFLAG2(OBJ)=or(OFLAG2(OBJ),FITEBT)
72	  VOPPS(I)=OBJ
73C						!SET UP OPP.
74	  GO TO 2400
75C
762200	  IF((and(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
77&		GO TO 2300
78	  PRSA=FIGHTW
79C						!HAVE A FIGHT.
80	  F=OAPPLI(RA,0)
812300	  IF(OBJ.EQ.THIEF) THFENF=.FALSE.
82C						!TURN OFF ENGROSSED.
83	  AFLAG(PLAYER)=and(AFLAG(PLAYER), not(ASTAG))
84	  OFLAG2(OBJ)=and(OFLAG2(OBJ), not(STAGBT+FITEBT))
85	  IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
86&		GO TO 2400
87	  PRSA=INXW
88C						!WAKE HIM UP.
89	  F=OAPPLI(RA,0)
90	  OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
912400	CONTINUE
92C FIGHTD, PAGE 3
93C
94C NOW DO ACTUAL COUNTERBLOWS.
95C
96	OUT=0
97C						!ASSUME HERO OK.
982600	DO 2700 I=1,VLNT
99C						!LOOP THRU OPPS.
100	  J=VOPPS(I)
101	  IF(J.EQ.0) GO TO 2700
102C						!SLOT EMPTY?
103	  PRSCON=1
104C						!STOP CMD STREAM.
105	  RA=OACTIO(J)
106	  IF(RA.EQ.0) GO TO 2650
107C						!VILLAIN ACTION?
108	  PRSA=FIGHTW
109C						!SEE IF
110	  IF(OAPPLI(RA,0)) GO TO 2700
111C						!SPECIAL ACTION.
1122650	  RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT)
113C						!STRIKE BLOW.
114	  IF(RES.LT.0) RETURN
115C						!IF HERO DEAD, EXIT.
116	  IF(RES.EQ.ROUT) OUT=2+RND(3)
117C						!IF HERO OUT, SET FLG.
1182700	CONTINUE
119	OUT=OUT-1
120C						!DECREMENT OUT COUNT.
121	IF(OUT.GT.0) GO TO 2600
122C						!IF STILL OUT, GO AGAIN.
123	RETURN
124C
125	END
126C BLOW- STRIKE BLOW
127C
128C DECLARATIONS
129C
130	INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
131	IMPLICIT INTEGER (A-Z)
132	LOGICAL HFLG,OAPPLI,PROB
133	INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
134	INTEGER RVECTR(66),RSTATE(45)
135#include "gamestate.h"
136#include "debug.h"
137C
138C PARSE VECTOR
139C
140	LOGICAL PRSWON
141#include "parser.h"
142C
143C MISCELLANEOUS VARIABLES
144C
145	COMMON /STAR/ MBASE,STRBIT
146#include "objects.h"
147#include "oflags.h"
148C
149#include "clock.h"
150
151#include "advers.h"
152#include "verbs.h"
153C
154	LOGICAL F
155C
156C FUNCTIONS AND DATA
157C
158	DATA RMISS/0/,ROUT/1/,RKILL/2/,RLIGHT/3/
159	DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/
160	DATA DEF1R/1,2,3/
161	DATA DEF2R/13,23,24,25/
162	DATA DEF3R/35,36,46,47,57/
163C
164	DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
165&		0,0,0,0,0,5,5,3,3,1,
166&		0,0,0,5,5,3,3,3,1,2,2,2,
167&		0,0,0,0,0,5,5,3,3,4,4,
168&		0,0,0,5,5,3,3,3,4,4,4,
169&		0,5,5,3,3,3,3,4,4,4/
170	DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
171&		5022,3027,3030,4033,3037,3040,1043,0,0,
172&		4044,2048,4050,4054,5058,4063,4067,3071,1074,
173&		4075,1079,4080,4084,4088,4092,4096,4100,1104,
174&		4105,2109,4111,4115,4119,4123,4127,3131,3134/
175C BLOW, PAGE 3
176C
177	RA=OACTIO(V)
178C						!GET VILLAIN ACTION,
179	DV=ODESC2(V)
180C						!DESCRIPTION.
181	BLOW=RMISS
182C						!ASSUME NO RESULT.
183#ifdef debug
184	IF(DFLAG) PRINT 10,H,V,RMK,HFLG,OUT
185#ifdef NOCC
18610	FORMAT('BLOW 10-- ',3I7,L7,I7)
187#else NOCC
18810	FORMAT(' BLOW 10-- ',3I7,L7,I7)
189#endif NOCC
190#endif debug
191	IF(.NOT.HFLG) GO TO 1000
192C						!HERO STRIKING BLOW?
193C
194C HERO IS ATTACKER, VILLAIN IS DEFENDER.
195C
196	PBLOSE=10
197C						!BAD LK PROB.
198	OFLAG2(V)=or(OFLAG2(V),FITEBT)
199	IF(and(AFLAG(H),ASTAG).EQ.0) GO TO 100
200	CALL RSPEAK(591)
201C						!YES, CANT FIGHT.
202	AFLAG(H)=and(AFLAG(H), not(ASTAG))
203	RETURN
204C
205100	ATT=FIGHTS(H,.TRUE.)
206C						!GET HIS STRENGTH.
207	OA=ATT
208	DEF=VILSTR(V)
209C						!GET VILL STRENGTH.
210	OD=DEF
211	DWEAP=0
212C						!ASSUME NO WEAPON.
213	DO 200 I=1,OLNT
214C						!SEARCH VILLAIN.
215	  IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
216&		DWEAP=I
217200	CONTINUE
218	IF(V.EQ.AOBJ(PLAYER)) GO TO 300
219C						!KILLING SELF?
220	IF(DEF.NE.0) GO TO 2000
221C						!DEFENDER ALIVE?
222	CALL RSPSUB(592,DV)
223C						!VILLAIN DEAD.
224	RETURN
225C
226300	CALL JIGSUP(593)
227C						!KILLING SELF.
228	RETURN
229C
230C VILLAIN IS ATTACKER, HERO IS DEFENDER.
231C
2321000	PBLOSE=50
233C						!BAD LK PROB.
234	AFLAG(H)=and(AFLAG(H),not(ASTAG))
235	IF(and(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
236	OFLAG2(V)=and(OFLAG2(V), not(STAGBT))
237	CALL RSPSUB(594,DV)
238C						!DESCRIBE.
239	RETURN
240C
2411200	ATT=VILSTR(V)
242C						!SET UP ATT, DEF.
243	OA=ATT
244	DEF=FIGHTS(H,.TRUE.)
245	IF(DEF.LE.0) RETURN
246C						!DONT ALLOW DEAD DEF.
247	OD=FIGHTS(H,.FALSE.)
248	DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
249C						!FIND A WEAPON.
250C BLOW, PAGE 4
251C
252C PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
253C ATT MUST BE > 0.
254C
2552000	CONTINUE
256#ifdef debug
257	IF(DFLAG) PRINT 2050,ATT,OA,DEF,OD,DWEAP
258#ifdef NOCC
2592050	FORMAT('BLOW 2050-- ',5I7)
260#else NOCC
2612050	FORMAT(' BLOW 2050-- ',5I7)
262#endif NOCC
263#endif debug
264	IF(DEF.GT.0) GO TO 2100
265C						!DEF ALIVE?
266	RES=RKILL
267	IF(HFLG) CALL RSPSUB(595,DV)
268C						!DEADER.
269	GO TO 3000
270C
2712100	IF(DEF-2) 2200,2300,2400
272C						!DEF <2,=2,>2
2732200	ATT=MIN0(ATT,3)
274C						!SCALE ATT.
275	TBL=DEF1R(ATT)
276C						!CHOOSE TABLE.
277	GO TO 2500
278C
2792300	ATT=MIN0(ATT,4)
280C						!SCALE ATT.
281	TBL=DEF2R(ATT)
282C						!CHOOSE TABLE.
283	GO TO 2500
284C
2852400	ATT=ATT-DEF
286C						!SCALE ATT.
287	ATT=MIN0(2,MAX0(-2,ATT))+3
288	TBL=DEF3R(ATT)
289C
2902500	RES=RVECTR(TBL+RND(10))
291C						!GET RESULT.
292	IF(OUT.EQ.0) GO TO 2600
293C						!WAS HE OUT?
294	IF(RES.EQ.RSTAG) GO TO 2550
295C						!YES, STAG--> HES.
296	RES=RSIT
297C						!OTHERWISE, SITTING.
298	GO TO 2600
2992550	RES=RHES
3002600	IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
301&		RES=RLOSE
302C
303	MI=RSTATE(((RMK-1)*9)+RES+1)
304C						!CHOOSE TABLE ENTRY.
305	IF(MI.EQ.0) GO TO 3000
306	I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
307	J=DV
308	IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
309#ifdef debug
310	IF(DFLAG) PRINT 2650,RES,MI,I,J,MBASE
311#ifdef NOCC
3122650	FORMAT('BLOW 2650-- ',5I7)
313#else NOCC
3142650	FORMAT(' BLOW 2650-- ',5I7)
315#endif NOCC
316#endif debug
317	CALL RSPSUB(I,J)
318C						!PRESENT RESULT.
319C BLOW, PAGE 5
320C
321C NOW APPLY RESULT
322C
3233000	GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
324C
3253100	IF(HFLG) DEF=-DEF
326C						!UNCONSCIOUS.
327	GO TO 4000
328C
3293200	DEF=0
330C						!KILLED OR SITTING DUCK.
331	GO TO 4000
332C
3333300	DEF=MAX0(0,DEF-1)
334C						!LIGHT WOUND.
335	GO TO 4000
336C
3373400	DEF=MAX0(0,DEF-2)
338C						!SERIOUS WOUND.
339	GO TO 4000
340C
3413500	IF(HFLG) GO TO 3550
342C						!STAGGERED.
343	AFLAG(H)=or(AFLAG(H),ASTAG)
344	GO TO 4000
345C
3463550	OFLAG2(V)=or(OFLAG2(V),STAGBT)
347	GO TO 4000
348C
3493600	CALL NEWSTA(DWEAP,0,HERE,0,0)
350C						!LOSE WEAPON.
351	DWEAP=0
352	IF(HFLG) GO TO 4000
353C						!IF HERO, DONE.
354	DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
355C						!GET NEW.
356	IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
357C BLOW, PAGE 6
358C
3594000	BLOW=RES
360C						!RETURN RESULT.
361	IF(.NOT.HFLG) GO TO 4500
362C						!HERO?
363	OCAPAC(V)=DEF
364C						!STORE NEW CAPACITY.
365	IF(DEF.NE.0) GO TO 4100
366C						!DEAD?
367	OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
368	CALL RSPSUB(572,DV)
369C						!HE DIES.
370	CALL NEWSTA(V,0,0,0,0)
371C						!MAKE HIM DISAPPEAR.
372	IF(RA.EQ.0) RETURN
373C						!IF NX TO DO, EXIT.
374	PRSA=DEADXW
375C						!LET HIM KNOW.
376	F=OAPPLI(RA,0)
377	RETURN
378C
3794100	IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
380	PRSA=OUTXW
381C						!LET HIM BE OUT.
382	F=OAPPLI(RA,0)
383	RETURN
384C
3854500	ASTREN(H)=-10000
386C						!ASSUME DEAD.
387	IF(DEF.NE.0) ASTREN(H)=DEF-OD
388	IF(DEF.GE.OD) GO TO 4600
389	CTICK(CEVCUR)=30
390	CFLAG(CEVCUR)=.TRUE.
3914600	IF(FIGHTS(H,.TRUE.).GT.0) RETURN
392	ASTREN(H)=1-FIGHTS(H,.FALSE.)
393C						!HE'S DEAD.
394	CALL JIGSUP(596)
395	BLOW=-1
396	RETURN
397C
398	END
399C SWORDD- SWORD INTERMOVE DEMON
400C
401C DECLARATIONS
402C
403	SUBROUTINE SWORDD
404	IMPLICIT INTEGER(A-Z)
405	LOGICAL INFEST,FINDXT
406#include "gamestate.h"
407#include "curxt.h"
408#include "xsrch.h"
409#include "objects.h"
410#include "oindex.h"
411#include "villians.h"
412#include "advers.h"
413C SWORDD, PAGE 2
414C
415	IF(OADV(SWORD).NE.PLAYER) GO TO 500
416C						!HOLDING SWORD?
417	NG=2
418C						!ASSUME VILL CLOSE.
419	IF(INFEST(HERE)) GO TO 300
420C						!VILL HERE?
421	NG=1
422	DO 200 I=XMIN,XMAX,XMIN
423C						!NO, SEARCH ROOMS.
424	  IF(.NOT.FINDXT(I,HERE)) GO TO 200
425C						!ROOM THAT WAY?
426	  GO TO (50,200,50,50),XTYPE
427C						!SEE IF ROOM AT ALL.
42850	  IF(INFEST(XROOM1)) GO TO 300
429C						!CHECK ROOM.
430200	CONTINUE
431	NG=0
432C						!NO GLOW.
433C
434300	IF(NG.EQ.SWDSTA) RETURN
435C						!ANY STATE CHANGE?
436	CALL RSPEAK(NG+495)
437C						!YES, TELL NEW STATE.
438	SWDSTA=NG
439	RETURN
440C
441500	SWDACT=.FALSE.
442C						!DROPPED SWORD,
443	RETURN
444C						!DISABLE DEMON.
445	END
446C INFEST-	SUBROUTINE TO TEST FOR INFESTED ROOM
447C
448C DECLARATIONS
449C
450	LOGICAL FUNCTION INFEST(R)
451	IMPLICIT INTEGER(A-Z)
452C
453C ROOMS
454#include "rindex.h"
455#include "objects.h"
456#include "oindex.h"
457#include "villians.h"
458#include "flags.h"
459C
460	IF(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
461&		(OROOM(TROLL).EQ.R).OR.
462&		((OROOM(THIEF).EQ.R).AND.THFACT)
463	IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
464&		(R.EQ.MRGW).OR.
465&		((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
466	RETURN
467	END
468