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: 2100 |
|