xref: /csrg-svn/contrib/dungeon/demons.F (revision 35973)

C FIGHTD- INTERMOVE FIGHT DEMON
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
	SUBROUTINE FIGHTD
	IMPLICIT INTEGER (A-Z)
	LOGICAL PROB,OAPPLI
#include "parser.h"
#include "gamestate.h"
#include "objects.h"
#include "oflags.h"
#include "oindex.h"
#include "villians.h"
#include "advers.h"
#include "verbs.h"
#include "flags.h"
C
	LOGICAL F
C
C FUNCTIONS AND DATA
C
	DATA ROUT/1/
C FIGHTD, PAGE 2
C
	DO 2400 I=1,VLNT
C						!LOOP THRU VILLAINS.
	  VOPPS(I)=0
C						!CLEAR OPPONENT SLOT.
	  OBJ=VILLNS(I)
C						!GET OBJECT NO.
	  RA=OACTIO(OBJ)
C						!GET HIS ACTION.
	  IF(HERE.NE.OROOM(OBJ)) GO TO 2200
C						!ADVENTURER STILL HERE?
	  IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400
C						!THIEF ENGROSSED?
	  IF(OCAPAC(OBJ).GE.0) GO TO 2050
C						!YES, VILL AWAKE?
	  IF((VPROB(I).EQ.0).OR..NOT.PROB(VPROB(I),VPROB(I)))
&		GO TO 2025
	  OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
	  VPROB(I)=0
	  IF(RA.EQ.0) GO TO 2400
C						!ANYTHING TO DO?
	  PRSA=INXW
C						!YES, WAKE HIM UP.
	  F=OAPPLI(RA,0)
	  GO TO 2400
C						!NOTHING ELSE HAPPENS.
C
2025	  VPROB(I)=VPROB(I)+10
C						!INCREASE WAKEUP PROB.
	  GO TO 2400
C						!NOTHING ELSE.
C
2050	  IF((and(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
	  VOPPS(I)=OBJ
C						!FIGHTING, SET UP OPP.
	  GO TO 2400
C
2100	  IF(RA.EQ.0) GO TO 2400
C						!NOT FIGHTING,
	  PRSA=FRSTQW
C						!SET UP PROBABILITY
	  IF(.NOT.OAPPLI(RA,0)) GO TO 2400
C						!OF FIGHTING.
	  OFLAG2(OBJ)=or(OFLAG2(OBJ),FITEBT)
	  VOPPS(I)=OBJ
C						!SET UP OPP.
	  GO TO 2400
C
2200	  IF((and(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
&		GO TO 2300
	  PRSA=FIGHTW
C						!HAVE A FIGHT.
	  F=OAPPLI(RA,0)
2300	  IF(OBJ.EQ.THIEF) THFENF=.FALSE.
C						!TURN OFF ENGROSSED.
	  AFLAG(PLAYER)=and(AFLAG(PLAYER), not(ASTAG))
	  OFLAG2(OBJ)=and(OFLAG2(OBJ), not(STAGBT+FITEBT))
	  IF((OCAPAC(OBJ).GE.0).OR.(RA.EQ.0))
&		GO TO 2400
	  PRSA=INXW
C						!WAKE HIM UP.
	  F=OAPPLI(RA,0)
	  OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
2400	CONTINUE
C FIGHTD, PAGE 3
C
C NOW DO ACTUAL COUNTERBLOWS.
C
	OUT=0
C						!ASSUME HERO OK.
2600	DO 2700 I=1,VLNT
C						!LOOP THRU OPPS.
	  J=VOPPS(I)
	  IF(J.EQ.0) GO TO 2700
C						!SLOT EMPTY?
	  PRSCON=1
C						!STOP CMD STREAM.
	  RA=OACTIO(J)
	  IF(RA.EQ.0) GO TO 2650
C						!VILLAIN ACTION?
	  PRSA=FIGHTW
C						!SEE IF
	  IF(OAPPLI(RA,0)) GO TO 2700
C						!SPECIAL ACTION.
2650	  RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT)
C						!STRIKE BLOW.
	  IF(RES.LT.0) RETURN
C						!IF HERO DEAD, EXIT.
	  IF(RES.EQ.ROUT) OUT=2+RND(3)
C						!IF HERO OUT, SET FLG.
2700	CONTINUE
	OUT=OUT-1
C						!DECREMENT OUT COUNT.
	IF(OUT.GT.0) GO TO 2600
C						!IF STILL OUT, GO AGAIN.
	RETURN
C
	END
C BLOW- STRIKE BLOW
C
C DECLARATIONS
C
	INTEGER FUNCTION BLOW(H,V,RMK,HFLG,OUT)
	IMPLICIT INTEGER (A-Z)
	LOGICAL HFLG,OAPPLI,PROB
	INTEGER DEF1R(3),DEF2R(4),DEF3R(5)
	INTEGER RVECTR(66),RSTATE(45)
#include "gamestate.h"
#include "debug.h"
C
C PARSE VECTOR
C
	LOGICAL PRSWON
#include "parser.h"
C
C MISCELLANEOUS VARIABLES
C
	COMMON /STAR/ MBASE,STRBIT
#include "objects.h"
#include "oflags.h"
C
#include "clock.h"

#include "advers.h"
#include "verbs.h"
C
	LOGICAL F
C
C FUNCTIONS AND DATA
C
	DATA RMISS/0/,ROUT/1/,RKILL/2/,RLIGHT/3/
	DATA RSER/4/,RSTAG/5/,RLOSE/6/,RHES/7/,RSIT/8/
	DATA DEF1R/1,2,3/
	DATA DEF2R/13,23,24,25/
	DATA DEF3R/35,36,46,47,57/
C
	DATA RVECTR/0,0,0,0,5,5,1,1,2,2,2,2,
&		0,0,0,0,0,5,5,3,3,1,
&		0,0,0,5,5,3,3,3,1,2,2,2,
&		0,0,0,0,0,5,5,3,3,4,4,
&		0,0,0,5,5,3,3,3,4,4,4,
&		0,5,5,3,3,3,3,4,4,4/
	DATA RSTATE/5000,3005,3008,4011,3015,3018,1021,0,0,
&		5022,3027,3030,4033,3037,3040,1043,0,0,
&		4044,2048,4050,4054,5058,4063,4067,3071,1074,
&		4075,1079,4080,4084,4088,4092,4096,4100,1104,
&		4105,2109,4111,4115,4119,4123,4127,3131,3134/
C BLOW, PAGE 3
C
	RA=OACTIO(V)
C						!GET VILLAIN ACTION,
	DV=ODESC2(V)
C						!DESCRIPTION.
	BLOW=RMISS
C						!ASSUME NO RESULT.
#ifdef debug
	IF(DFLAG) PRINT 10,H,V,RMK,HFLG,OUT
#ifdef NOCC
10	FORMAT('BLOW 10-- ',3I7,L7,I7)
#else NOCC
10	FORMAT(' BLOW 10-- ',3I7,L7,I7)
#endif NOCC
#endif debug
	IF(.NOT.HFLG) GO TO 1000
C						!HERO STRIKING BLOW?
C
C HERO IS ATTACKER, VILLAIN IS DEFENDER.
C
	PBLOSE=10
C						!BAD LK PROB.
	OFLAG2(V)=or(OFLAG2(V),FITEBT)
	IF(and(AFLAG(H),ASTAG).EQ.0) GO TO 100
	CALL RSPEAK(591)
C						!YES, CANT FIGHT.
	AFLAG(H)=and(AFLAG(H), not(ASTAG))
	RETURN
C
100	ATT=FIGHTS(H,.TRUE.)
C						!GET HIS STRENGTH.
	OA=ATT
	DEF=VILSTR(V)
C						!GET VILL STRENGTH.
	OD=DEF
	DWEAP=0
C						!ASSUME NO WEAPON.
	DO 200 I=1,OLNT
C						!SEARCH VILLAIN.
	  IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
&		DWEAP=I
200	CONTINUE
	IF(V.EQ.AOBJ(PLAYER)) GO TO 300
C						!KILLING SELF?
	IF(DEF.NE.0) GO TO 2000
C						!DEFENDER ALIVE?
	CALL RSPSUB(592,DV)
C						!VILLAIN DEAD.
	RETURN
C
300	CALL JIGSUP(593)
C						!KILLING SELF.
	RETURN
C
C VILLAIN IS ATTACKER, HERO IS DEFENDER.
C
1000	PBLOSE=50
C						!BAD LK PROB.
	AFLAG(H)=and(AFLAG(H),not(ASTAG))
	IF(and(OFLAG2(V),STAGBT).EQ.0) GO TO 1200
	OFLAG2(V)=and(OFLAG2(V), not(STAGBT))
	CALL RSPSUB(594,DV)
C						!DESCRIBE.
	RETURN
C
1200	ATT=VILSTR(V)
C						!SET UP ATT, DEF.
	OA=ATT
	DEF=FIGHTS(H,.TRUE.)
	IF(DEF.LE.0) RETURN
C						!DONT ALLOW DEAD DEF.
	OD=FIGHTS(H,.FALSE.)
	DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
C						!FIND A WEAPON.
C BLOW, PAGE 4
C
C PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
C ATT MUST BE > 0.
C
2000	CONTINUE
#ifdef debug
	IF(DFLAG) PRINT 2050,ATT,OA,DEF,OD,DWEAP
#ifdef NOCC
2050	FORMAT('BLOW 2050-- ',5I7)
#else NOCC
2050	FORMAT(' BLOW 2050-- ',5I7)
#endif NOCC
#endif debug
	IF(DEF.GT.0) GO TO 2100
C						!DEF ALIVE?
	RES=RKILL
	IF(HFLG) CALL RSPSUB(595,DV)
C						!DEADER.
	GO TO 3000
C
2100	IF(DEF-2) 2200,2300,2400
C						!DEF <2,=2,>2
2200	ATT=MIN0(ATT,3)
C						!SCALE ATT.
	TBL=DEF1R(ATT)
C						!CHOOSE TABLE.
	GO TO 2500
C
2300	ATT=MIN0(ATT,4)
C						!SCALE ATT.
	TBL=DEF2R(ATT)
C						!CHOOSE TABLE.
	GO TO 2500
C
2400	ATT=ATT-DEF
C						!SCALE ATT.
	ATT=MIN0(2,MAX0(-2,ATT))+3
	TBL=DEF3R(ATT)
C
2500	RES=RVECTR(TBL+RND(10))
C						!GET RESULT.
	IF(OUT.EQ.0) GO TO 2600
C						!WAS HE OUT?
	IF(RES.EQ.RSTAG) GO TO 2550
C						!YES, STAG--> HES.
	RES=RSIT
C						!OTHERWISE, SITTING.
	GO TO 2600
2550	RES=RHES
2600	IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
&		RES=RLOSE
C
	MI=RSTATE(((RMK-1)*9)+RES+1)
C						!CHOOSE TABLE ENTRY.
	IF(MI.EQ.0) GO TO 3000
	I=(MOD(MI,1000)+RND(MI/1000))+MBASE+1
	J=DV
	IF(.NOT.HFLG .AND.(DWEAP.NE.0)) J=ODESC2(DWEAP)
#ifdef debug
	IF(DFLAG) PRINT 2650,RES,MI,I,J,MBASE
#ifdef NOCC
2650	FORMAT('BLOW 2650-- ',5I7)
#else NOCC
2650	FORMAT(' BLOW 2650-- ',5I7)
#endif NOCC
#endif debug
	CALL RSPSUB(I,J)
C						!PRESENT RESULT.
C BLOW, PAGE 5
C
C NOW APPLY RESULT
C
3000	GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
C
3100	IF(HFLG) DEF=-DEF
C						!UNCONSCIOUS.
	GO TO 4000
C
3200	DEF=0
C						!KILLED OR SITTING DUCK.
	GO TO 4000
C
3300	DEF=MAX0(0,DEF-1)
C						!LIGHT WOUND.
	GO TO 4000
C
3400	DEF=MAX0(0,DEF-2)
C						!SERIOUS WOUND.
	GO TO 4000
C
3500	IF(HFLG) GO TO 3550
C						!STAGGERED.
	AFLAG(H)=or(AFLAG(H),ASTAG)
	GO TO 4000
C
3550	OFLAG2(V)=or(OFLAG2(V),STAGBT)
	GO TO 4000
C
3600	CALL NEWSTA(DWEAP,0,HERE,0,0)
C						!LOSE WEAPON.
	DWEAP=0
	IF(HFLG) GO TO 4000
C						!IF HERO, DONE.
	DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
C						!GET NEW.
	IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
C BLOW, PAGE 6
C
4000	BLOW=RES
C						!RETURN RESULT.
	IF(.NOT.HFLG) GO TO 4500
C						!HERO?
	OCAPAC(V)=DEF
C						!STORE NEW CAPACITY.
	IF(DEF.NE.0) GO TO 4100
C						!DEAD?
	OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
	CALL RSPSUB(572,DV)
C						!HE DIES.
	CALL NEWSTA(V,0,0,0,0)
C						!MAKE HIM DISAPPEAR.
	IF(RA.EQ.0) RETURN
C						!IF NX TO DO, EXIT.
	PRSA=DEADXW
C						!LET HIM KNOW.
	F=OAPPLI(RA,0)
	RETURN
C
4100	IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
	PRSA=OUTXW
C						!LET HIM BE OUT.
	F=OAPPLI(RA,0)
	RETURN
C
4500	ASTREN(H)=-10000
C						!ASSUME DEAD.
	IF(DEF.NE.0) ASTREN(H)=DEF-OD
	IF(DEF.GE.OD) GO TO 4600
	CTICK(CEVCUR)=30
	CFLAG(CEVCUR)=.TRUE.
4600	IF(FIGHTS(H,.TRUE.).GT.0) RETURN
	ASTREN(H)=1-FIGHTS(H,.FALSE.)
C						!HE'S DEAD.
	CALL JIGSUP(596)
	BLOW=-1
	RETURN
C
	END
C SWORDD- SWORD INTERMOVE DEMON
C
C DECLARATIONS
C
	SUBROUTINE SWORDD
	IMPLICIT INTEGER(A-Z)
	LOGICAL INFEST,FINDXT
#include "gamestate.h"
#include "curxt.h"
#include "xsrch.h"
#include "objects.h"
#include "oindex.h"
#include "villians.h"
#include "advers.h"
C SWORDD, PAGE 2
C
	IF(OADV(SWORD).NE.PLAYER) GO TO 500
C						!HOLDING SWORD?
	NG=2
C						!ASSUME VILL CLOSE.
	IF(INFEST(HERE)) GO TO 300
C						!VILL HERE?
	NG=1
	DO 200 I=XMIN,XMAX,XMIN
C						!NO, SEARCH ROOMS.
	  IF(.NOT.FINDXT(I,HERE)) GO TO 200
C						!ROOM THAT WAY?
	  GO TO (50,200,50,50),XTYPE
C						!SEE IF ROOM AT ALL.
50	  IF(INFEST(XROOM1)) GO TO 300
C						!CHECK ROOM.
200	CONTINUE
	NG=0
C						!NO GLOW.
C
300	IF(NG.EQ.SWDSTA) RETURN
C						!ANY STATE CHANGE?
	CALL RSPEAK(NG+495)
C						!YES, TELL NEW STATE.
	SWDSTA=NG
	RETURN
C
500	SWDACT=.FALSE.
C						!DROPPED SWORD,
	RETURN
C						!DISABLE DEMON.
	END
C INFEST-	SUBROUTINE TO TEST FOR INFESTED ROOM
C
C DECLARATIONS
C
	LOGICAL FUNCTION INFEST(R)
	IMPLICIT INTEGER(A-Z)
C
C ROOMS
#include "rindex.h"
#include "objects.h"
#include "oindex.h"
#include "villians.h"
#include "flags.h"
C
	IF(.NOT.ENDGMF) INFEST=(OROOM(CYCLO).EQ.R).OR.
&		(OROOM(TROLL).EQ.R).OR.
&		((OROOM(THIEF).EQ.R).AND.THFACT)
	IF(ENDGMF) INFEST=(R.EQ.MRG).OR.(R.EQ.MRGE).OR.
&		(R.EQ.MRGW).OR.
&		((R.EQ.INMIR).AND.(MLOC.EQ.MRG))
	RETURN
	END