usr/src/contrib/dungeon/demons.F

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