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: 613
Valid CSS Valid XHTML 1.0 Strict