![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to demons.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to demons.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 ! root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.