# 2.11BSD#431 - /usr/src/new/PORT/dungeon/demons.F

       1: C FIGHTD- INTERMOVE FIGHT DEMON
       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:         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"
      21: C
      22:         LOGICAL F
      23: C
      24: C FUNCTIONS AND DATA
      25: C
      26:         DATA ROUT/1/
      27: C FIGHTD, PAGE 2
      28: C
      29:         DO 2400 I=1,VLNT
      30: C						!LOOP THRU VILLAINS.
      31:           VOPPS(I)=0
      32: C						!CLEAR OPPONENT SLOT.
      33:           OBJ=VILLNS(I)
      34: C						!GET OBJECT NO.
      35:           RA=OACTIO(OBJ)
      36: C						!GET HIS ACTION.
      37:           IF(HERE.NE.OROOM(OBJ)) GO TO 2200
      38: C						!ADVENTURER STILL HERE?
      39:           IF((OBJ.EQ.THIEF).AND.THFENF) GO TO 2400
      40: C						!THIEF ENGROSSED?
      41:           IF(OCAPAC(OBJ).GE.0) GO TO 2050
      42: C						!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
      48: C						!ANYTHING TO DO?
      49:           PRSA=INXW
      50: C						!YES, WAKE HIM UP.
      51:           F=OAPPLI(RA,0)
      52:           GO TO 2400
      53: C						!NOTHING ELSE HAPPENS.
      54: C
      55: 2025      VPROB(I)=VPROB(I)+10
      56: C						!INCREASE WAKEUP PROB.
      57:           GO TO 2400
      58: C						!NOTHING ELSE.
      59: C
      60: 2050      IF((and(OFLAG2(OBJ),FITEBT)).EQ.0) GO TO 2100
      61:           VOPPS(I)=OBJ
      62: C						!FIGHTING, SET UP OPP.
      63:           GO TO 2400
      64: C
      65: 2100      IF(RA.EQ.0) GO TO 2400
      66: C						!NOT FIGHTING,
      67:           PRSA=FRSTQW
      68: C						!SET UP PROBABILITY
      69:           IF(.NOT.OAPPLI(RA,0)) GO TO 2400
      70: C						!OF FIGHTING.
      71:           OFLAG2(OBJ)=or(OFLAG2(OBJ),FITEBT)
      72:           VOPPS(I)=OBJ
      73: C						!SET UP OPP.
      74:           GO TO 2400
      75: C
      76: 2200      IF((and(OFLAG2(OBJ),FITEBT).EQ.0).OR.(RA.EQ.0))
      77: &               GO TO 2300
      78:           PRSA=FIGHTW
      79: C						!HAVE A FIGHT.
      80:           F=OAPPLI(RA,0)
      81: 2300      IF(OBJ.EQ.THIEF) THFENF=.FALSE.
      82: C						!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
      88: C						!WAKE HIM UP.
      89:           F=OAPPLI(RA,0)
      90:           OCAPAC(OBJ)=IABS(OCAPAC(OBJ))
      91: 2400    CONTINUE
      92: C FIGHTD, PAGE 3
      93: C
      94: C NOW DO ACTUAL COUNTERBLOWS.
      95: C
      96:         OUT=0
      97: C						!ASSUME HERO OK.
      98: 2600    DO 2700 I=1,VLNT
      99: C						!LOOP THRU OPPS.
     100:           J=VOPPS(I)
     101:           IF(J.EQ.0) GO TO 2700
     102: C						!SLOT EMPTY?
     103:           PRSCON=1
     104: C						!STOP CMD STREAM.
     105:           RA=OACTIO(J)
     106:           IF(RA.EQ.0) GO TO 2650
     107: C						!VILLAIN ACTION?
     108:           PRSA=FIGHTW
     109: C						!SEE IF
     110:           IF(OAPPLI(RA,0)) GO TO 2700
     111: C						!SPECIAL ACTION.
     112: 2650      RES=BLOW(PLAYER,J,VMELEE(I),.FALSE.,OUT)
     113: C						!STRIKE BLOW.
     114:           IF(RES.LT.0) RETURN
     115: C						!IF HERO DEAD, EXIT.
     116:           IF(RES.EQ.ROUT) OUT=2+RND(3)
     117: C						!IF HERO OUT, SET FLG.
     118: 2700    CONTINUE
     119:         OUT=OUT-1
     120: C						!DECREMENT OUT COUNT.
     121:         IF(OUT.GT.0) GO TO 2600
     122: C						!IF STILL OUT, GO AGAIN.
     123:         RETURN
     124: C
     125:         END
     126: C BLOW- STRIKE BLOW
     127: C
     128: C DECLARATIONS
     129: C
     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"
     137: C
     138: C PARSE VECTOR
     139: C
     140:         LOGICAL PRSWON
     141: #include "parser.h"
     142: C
     143: C MISCELLANEOUS VARIABLES
     144: C
     145:         COMMON /STAR/ MBASE,STRBIT
     146: #include "objects.h"
     147: #include "oflags.h"
     148: C
     149: #include "clock.h"
     150:
     151: #include "advers.h"
     152: #include "verbs.h"
     153: C
     154:         LOGICAL F
     155: C
     156: C FUNCTIONS AND DATA
     157: C
     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/
     163: C
     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/
     175: C BLOW, PAGE 3
     176: C
     177:         RA=OACTIO(V)
     178: C						!GET VILLAIN ACTION,
     179:         DV=ODESC2(V)
     180: C						!DESCRIPTION.
     181:         BLOW=RMISS
     182: C						!ASSUME NO RESULT.
     183: #ifdef debug
     184:         IF(DFLAG) PRINT 10,H,V,RMK,HFLG,OUT
     185: #ifdef NOCC
     186: 10      FORMAT('BLOW 10-- ',3I7,L7,I7)
     187: #else NOCC
     188: 10      FORMAT(' BLOW 10-- ',3I7,L7,I7)
     189: #endif NOCC
     190: #endif debug
     191:         IF(.NOT.HFLG) GO TO 1000
     192: C						!HERO STRIKING BLOW?
     193: C
     194: C HERO IS ATTACKER, VILLAIN IS DEFENDER.
     195: C
     196:         PBLOSE=10
     197: C						!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)
     201: C						!YES, CANT FIGHT.
     202:         AFLAG(H)=and(AFLAG(H), not(ASTAG))
     203:         RETURN
     204: C
     205: 100     ATT=FIGHTS(H,.TRUE.)
     206: C						!GET HIS STRENGTH.
     207:         OA=ATT
     208:         DEF=VILSTR(V)
     209: C						!GET VILL STRENGTH.
     210:         OD=DEF
     211:         DWEAP=0
     212: C						!ASSUME NO WEAPON.
     213:         DO 200 I=1,OLNT
     214: C						!SEARCH VILLAIN.
     215:           IF((OCAN(I).EQ.V).AND.(and(OFLAG2(I),WEAPBT).NE.0))
     216: &               DWEAP=I
     217: 200     CONTINUE
     218:         IF(V.EQ.AOBJ(PLAYER)) GO TO 300
     219: C						!KILLING SELF?
     220:         IF(DEF.NE.0) GO TO 2000
     221: C						!DEFENDER ALIVE?
     222:         CALL RSPSUB(592,DV)
     223: C						!VILLAIN DEAD.
     224:         RETURN
     225: C
     226: 300     CALL JIGSUP(593)
     227: C						!KILLING SELF.
     228:         RETURN
     229: C
     230: C VILLAIN IS ATTACKER, HERO IS DEFENDER.
     231: C
     232: 1000    PBLOSE=50
     233: C						!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)
     238: C						!DESCRIBE.
     239:         RETURN
     240: C
     241: 1200    ATT=VILSTR(V)
     242: C						!SET UP ATT, DEF.
     243:         OA=ATT
     244:         DEF=FIGHTS(H,.TRUE.)
     245:         IF(DEF.LE.0) RETURN
     246: C						!DONT ALLOW DEAD DEF.
     247:         OD=FIGHTS(H,.FALSE.)
     248:         DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
     249: C						!FIND A WEAPON.
     250: C BLOW, PAGE 4
     251: C
     252: C PARTIES ARE NOW EQUIPPED.  DEF CANNOT BE ZERO.
     253: C ATT MUST BE > 0.
     254: C
     255: 2000    CONTINUE
     256: #ifdef debug
     257:         IF(DFLAG) PRINT 2050,ATT,OA,DEF,OD,DWEAP
     258: #ifdef NOCC
     259: 2050    FORMAT('BLOW 2050-- ',5I7)
     260: #else NOCC
     261: 2050    FORMAT(' BLOW 2050-- ',5I7)
     262: #endif NOCC
     263: #endif debug
     264:         IF(DEF.GT.0) GO TO 2100
     265: C						!DEF ALIVE?
     266:         RES=RKILL
     267:         IF(HFLG) CALL RSPSUB(595,DV)
     268: C						!DEADER.
     269:         GO TO 3000
     270: C
     271: 2100    IF(DEF-2) 2200,2300,2400
     272: C						!DEF <2,=2,>2
     273: 2200    ATT=MIN0(ATT,3)
     274: C						!SCALE ATT.
     275:         TBL=DEF1R(ATT)
     276: C						!CHOOSE TABLE.
     277:         GO TO 2500
     278: C
     279: 2300    ATT=MIN0(ATT,4)
     280: C						!SCALE ATT.
     281:         TBL=DEF2R(ATT)
     282: C						!CHOOSE TABLE.
     283:         GO TO 2500
     284: C
     285: 2400    ATT=ATT-DEF
     286: C						!SCALE ATT.
     287:         ATT=MIN0(2,MAX0(-2,ATT))+3
     288:         TBL=DEF3R(ATT)
     289: C
     290: 2500    RES=RVECTR(TBL+RND(10))
     291: C						!GET RESULT.
     292:         IF(OUT.EQ.0) GO TO 2600
     293: C						!WAS HE OUT?
     294:         IF(RES.EQ.RSTAG) GO TO 2550
     295: C						!YES, STAG--> HES.
     296:         RES=RSIT
     297: C						!OTHERWISE, SITTING.
     298:         GO TO 2600
     299: 2550    RES=RHES
     300: 2600    IF((RES.EQ.RSTAG).AND.(DWEAP.NE.0).AND.PROB(25,PBLOSE))
     301: &               RES=RLOSE
     302: C
     303:         MI=RSTATE(((RMK-1)*9)+RES+1)
     304: C						!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
     312: 2650    FORMAT('BLOW 2650-- ',5I7)
     313: #else NOCC
     314: 2650    FORMAT(' BLOW 2650-- ',5I7)
     315: #endif NOCC
     316: #endif debug
     317:         CALL RSPSUB(I,J)
     318: C						!PRESENT RESULT.
     319: C BLOW, PAGE 5
     320: C
     321: C NOW APPLY RESULT
     322: C
     323: 3000    GO TO (4000,3100,3200,3300,3400,3500,3600,4000,3200),RES+1
     324: C
     325: 3100    IF(HFLG) DEF=-DEF
     326: C						!UNCONSCIOUS.
     327:         GO TO 4000
     328: C
     329: 3200    DEF=0
     330: C						!KILLED OR SITTING DUCK.
     331:         GO TO 4000
     332: C
     333: 3300    DEF=MAX0(0,DEF-1)
     334: C						!LIGHT WOUND.
     335:         GO TO 4000
     336: C
     337: 3400    DEF=MAX0(0,DEF-2)
     338: C						!SERIOUS WOUND.
     339:         GO TO 4000
     340: C
     341: 3500    IF(HFLG) GO TO 3550
     342: C						!STAGGERED.
     343:         AFLAG(H)=or(AFLAG(H),ASTAG)
     344:         GO TO 4000
     345: C
     346: 3550    OFLAG2(V)=or(OFLAG2(V),STAGBT)
     347:         GO TO 4000
     348: C
     349: 3600    CALL NEWSTA(DWEAP,0,HERE,0,0)
     350: C						!LOSE WEAPON.
     351:         DWEAP=0
     352:         IF(HFLG) GO TO 4000
     353: C						!IF HERO, DONE.
     354:         DWEAP=IABS(FWIM(0,WEAPBT,0,0,H,.TRUE.))
     355: C						!GET NEW.
     356:         IF(DWEAP.NE.0) CALL RSPSUB(605,ODESC2(DWEAP))
     357: C BLOW, PAGE 6
     358: C
     359: 4000    BLOW=RES
     360: C						!RETURN RESULT.
     361:         IF(.NOT.HFLG) GO TO 4500
     362: C						!HERO?
     363:         OCAPAC(V)=DEF
     364: C						!STORE NEW CAPACITY.
     365:         IF(DEF.NE.0) GO TO 4100
     366: C						!DEAD?
     367:         OFLAG2(V)=and(OFLAG2(V), not(FITEBT))
     368:         CALL RSPSUB(572,DV)
     369: C						!HE DIES.
     370:         CALL NEWSTA(V,0,0,0,0)
     371: C						!MAKE HIM DISAPPEAR.
     372:         IF(RA.EQ.0) RETURN
     373: C						!IF NX TO DO, EXIT.
     374:         PRSA=DEADXW
     375: C						!LET HIM KNOW.
     376:         F=OAPPLI(RA,0)
     377:         RETURN
     378: C
     379: 4100    IF((RES.NE.ROUT).OR.(RA.EQ.0)) RETURN
     380:         PRSA=OUTXW
     381: C						!LET HIM BE OUT.
     382:         F=OAPPLI(RA,0)
     383:         RETURN
     384: C
     385: 4500    ASTREN(H)=-10000
     386: C						!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.
     391: 4600    IF(FIGHTS(H,.TRUE.).GT.0) RETURN
     392:         ASTREN(H)=1-FIGHTS(H,.FALSE.)
     393: C						!HE'S DEAD.
     394:         CALL JIGSUP(596)
     395:         BLOW=-1
     396:         RETURN
     397: C
     398:         END
     399: C SWORDD- SWORD INTERMOVE DEMON
     400: C
     401: C DECLARATIONS
     402: C
     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"
     413: C SWORDD, PAGE 2
     414: C
     415:         IF(OADV(SWORD).NE.PLAYER) GO TO 500
     416: C						!HOLDING SWORD?
     417:         NG=2
     418: C						!ASSUME VILL CLOSE.
     419:         IF(INFEST(HERE)) GO TO 300
     420: C						!VILL HERE?
     421:         NG=1
     422:         DO 200 I=XMIN,XMAX,XMIN
     423: C						!NO, SEARCH ROOMS.
     424:           IF(.NOT.FINDXT(I,HERE)) GO TO 200
     425: C						!ROOM THAT WAY?
     426:           GO TO (50,200,50,50),XTYPE
     427: C						!SEE IF ROOM AT ALL.
     428: 50        IF(INFEST(XROOM1)) GO TO 300
     429: C						!CHECK ROOM.
     430: 200     CONTINUE
     431:         NG=0
     432: C						!NO GLOW.
     433: C
     434: 300     IF(NG.EQ.SWDSTA) RETURN
     435: C						!ANY STATE CHANGE?
     436:         CALL RSPEAK(NG+495)
     437: C						!YES, TELL NEW STATE.
     438:         SWDSTA=NG
     439:         RETURN
     440: C
     441: 500     SWDACT=.FALSE.
     442: C						!DROPPED SWORD,
     443:         RETURN
     444: C						!DISABLE DEMON.
     445:         END
     446: C INFEST-	SUBROUTINE TO TEST FOR INFESTED ROOM
     447: C
     448: C DECLARATIONS
     449: C
     450:         LOGICAL FUNCTION INFEST(R)
     451:         IMPLICIT INTEGER(A-Z)
     452: C
     453: C ROOMS
     454: #include "rindex.h"
     455: #include "objects.h"
     456: #include "oindex.h"
     457: #include "villians.h"
     458: #include "flags.h"
     459: C
     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

Last modified: 1988-10-21 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 624 |