1: C AAPPLI- APPLICABLES FOR ADVENTURERS 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: LOGICAL FUNCTION AAPPLI(RI) 10: IMPLICIT INTEGER (A-Z) 11: LOGICAL F,MOVETO 12: #include "parser.h" 13: #include "gamestate.h" 14: #include "rooms.h" 15: #include "rflag.h" 16: #include "rindex.h" 17: #include "xsrch.h" 18: #include "objects.h" 19: #include "oflags.h" 20: #include "oindex.h" 21: #include "clock.h" 22: #include "advers.h" 23: #include "verbs.h" 24: #include "flags.h" 25: C AAPPLI, PAGE 2 26: C 27: IF(RI.EQ.0) GO TO 10 28: C !IF ZERO, NO APP. 29: AAPPLI=.TRUE. 30: C !ASSUME WINS. 31: GO TO (1000,2000),RI 32: C !BRANCH ON ADV. 33: CALL BUG(11,RI) 34: C 35: C COMMON FALSE RETURN. 36: C 37: 10 AAPPLI=.FALSE. 38: RETURN 39: C 40: C A1-- ROBOT. PROCESS MOST COMMANDS GIVEN TO ROBOT. 41: C 42: 1000 IF((PRSA.NE.RAISEW).OR.(PRSO.NE.RCAGE)) GO TO 1200 43: CFLAG(CEVSPH)=.FALSE. 44: C !ROBOT RAISED CAGE. 45: WINNER=PLAYER 46: C !RESET FOR PLAYER. 47: F=MOVETO(CAGER,WINNER) 48: C !MOVE TO NEW ROOM. 49: CALL NEWSTA(CAGE,567,CAGER,0,0) 50: C !INSTALL CAGE IN ROOM. 51: CALL NEWSTA(ROBOT,0,CAGER,0,0) 52: C !INSTALL ROBOT IN ROOM. 53: AROOM(AROBOT)=CAGER 54: C !ALSO MOVE ROBOT/ADV. 55: CAGESF=.TRUE. 56: C !CAGE SOLVED. 57: OFLAG1(ROBOT)=and(OFLAG1(ROBOT),not(NDSCBT)) 58: OFLAG1(SPHER)=or(OFLAG1(SPHER),TAKEBT) 59: RETURN 60: C 61: 1200 IF((PRSA.NE.DRINKW).AND.(PRSA.NE.EATW)) GO TO 1300 62: CALL RSPEAK(568) 63: C !EAT OR DRINK, JOKE. 64: RETURN 65: C 66: 1300 IF(PRSA.NE.READW) GO TO 1400 67: C !READ, 68: CALL RSPEAK(569) 69: C !JOKE. 70: RETURN 71: C 72: 1400 IF((PRSA.EQ.WALKW).OR.(PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW) 73: & .OR.(PRSA.EQ.PUTW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.THROWW) 74: & .OR.(PRSA.EQ.TURNW).OR.(PRSA.EQ.LEAPW)) GO TO 10 75: CALL RSPEAK(570) 76: C !JOKE. 77: RETURN 78: C AAPPLI, PAGE 3 79: C 80: C A2-- MASTER. PROCESS MOST COMMANDS GIVEN TO MASTER. 81: C 82: 2000 IF(and(OFLAG2(QDOOR),OPENBT).NE.0) GO TO 2100 83: CALL RSPEAK(783) 84: C !NO MASTER YET. 85: RETURN 86: C 87: 2100 IF(PRSA.NE.WALKW) GO TO 2200 88: C !WALK? 89: I=784 90: C !ASSUME WONT. 91: IF(((HERE.EQ.SCORR).AND. 92: & ((PRSO.EQ.XNORTH).OR.(PRSO.EQ.XENTER))).OR. 93: & ((HERE.EQ.NCORR).AND. 94: & ((PRSO.EQ.XSOUTH).OR.(PRSO.EQ.XENTER)))) 95: & I=785 96: CALL RSPEAK(I) 97: RETURN 98: C 99: 2200 IF((PRSA.EQ.TAKEW).OR.(PRSA.EQ.DROPW).OR.(PRSA.EQ.PUTW).OR. 100: & (PRSA.EQ.THROWW).OR.(PRSA.EQ.PUSHW).OR.(PRSA.EQ.TURNW).OR. 101: & (PRSA.EQ.SPINW).OR.(PRSA.EQ.TRNTOW).OR.(PRSA.EQ.FOLLOW).OR. 102: & (PRSA.EQ.STAYW).OR.(PRSA.EQ.OPENW).OR.(PRSA.EQ.CLOSEW).OR. 103: & (PRSA.EQ.KILLW)) GO TO 10 104: CALL RSPEAK(786) 105: C !MASTER CANT DO IT. 106: RETURN 107: C 108: END 109: C THIEFD- INTERMOVE THIEF DEMON 110: C 111: C DECLARATIONS 112: C 113: SUBROUTINE THIEFD 114: IMPLICIT INTEGER (A-Z) 115: LOGICAL ONCE,PROB,QHERE,QSTILL,LIT,WINNIN 116: #include "gamestate.h" 117: C 118: #include "debug.h" 119: #include "rooms.h" 120: #include "rflag.h" 121: #include "rindex.h" 122: #include "objects.h" 123: #include "oflags.h" 124: #include "oindex.h" 125: #include "villians.h" 126: #include "flags.h" 127: C 128: C FUNCTIONS AND DATA 129: C 130: QSTILL(R)=(QHERE(STILL,R).OR.(OADV(STILL).EQ.-THIEF)) 131: C THIEFD, PAGE 2 132: C 133: #ifdef debug 134: DFLAG=and(PRSFLG, 32768).NE.0 135: #endif debug 136: C !SET UP DETAIL FLAG. 137: ONCE=.FALSE. 138: C !INIT FLAG. 139: 1025 RHERE=OROOM(THIEF) 140: C !VISIBLE POS. 141: IF(RHERE.NE.0) THFPOS=RHERE 142: C 143: IF(THFPOS.EQ.HERE) GO TO 1100 144: C !THIEF IN WIN RM? 145: IF(THFPOS.NE.TREAS) GO TO 1400 146: C !THIEF NOT IN TREAS? 147: C 148: C THIEF IS IN TREASURE ROOM, AND WINNER IS NOT. 149: C 150: #ifdef debug 151: IF(DFLAG) PRINT 10 152: #ifdef NOCC 153: 10 FORMAT('THIEFD-- IN TREASURE ROOM') 154: #else NOCC 155: 10 FORMAT(' THIEFD-- IN TREASURE ROOM') 156: #endif 157: #endif debug 158: IF(RHERE.EQ.0) GO TO 1050 159: C !VISIBLE? 160: CALL NEWSTA(THIEF,0,0,0,0) 161: C !YES, VANISH. 162: RHERE=0 163: IF(QSTILL(TREAS)) CALL NEWSTA(STILL,0,0,THIEF,0) 164: 1050 I=ROBADV(-THIEF,THFPOS,0,0) 165: C !DROP VALUABLES. 166: IF(QHERE(EGG,THFPOS)) OFLAG2(EGG)=or(OFLAG2(EGG),OPENBT) 167: GO TO 1700 168: C 169: C THIEF AND WINNER IN SAME ROOM. 170: C 171: 1100 IF(THFPOS.EQ.TREAS) GO TO 1700 172: C !IF TREAS ROOM, NOTHING. 173: IF(and(RFLAG(THFPOS),RLIGHT).NE.0) GO TO 1400 174: #ifdef debug 175: IF(DFLAG) PRINT 20 176: #ifdef NOCC 177: 20 FORMAT('THIEFD-- IN ADV ROOM') 178: #else NOCC 179: 20 FORMAT(' THIEFD-- IN ADV ROOM') 180: #endif NOCC 181: #endif debug 182: IF(THFFLG) GO TO 1300 183: C !THIEF ANNOUNCED? 184: IF((RHERE.NE.0).OR.PROB(70,70)) GO TO 1150 185: C !IF INVIS AND 30%. 186: IF(OCAN(STILL).NE.THIEF) GO TO 1700 187: C !ABORT IF NO STILLETTO. 188: CALL NEWSTA(THIEF,583,THFPOS,0,0) 189: C !INSERT THIEF INTO ROOM. 190: THFFLG=.TRUE. 191: C !THIEF IS ANNOUNCED. 192: RETURN 193: C 194: 1150 IF((RHERE.EQ.0).OR.(and(OFLAG2(THIEF),FITEBT).EQ.0)) 195: & GO TO 1200 196: IF(WINNIN(THIEF,WINNER)) GO TO 1175 197: C !WINNING? 198: CALL NEWSTA(THIEF,584,0,0,0) 199: C !NO, VANISH THIEF. 200: OFLAG2(THIEF)=and(OFLAG2(THIEF), not(FITEBT)) 201: IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0) 202: RETURN 203: C 204: 1175 IF(PROB(90,90)) GO TO 1700 205: C !90% CHANCE TO STAY. 206: C 207: 1200 IF((RHERE.EQ.0).OR.PROB(70,70)) GO TO 1250 208: C !IF VISIBLE AND 30% 209: CALL NEWSTA(THIEF,585,0,0,0) 210: C !VANISH THIEF. 211: IF(QSTILL(THFPOS)) CALL NEWSTA(STILL,0,0,THIEF,0) 212: RETURN 213: C 214: 1300 IF(RHERE.EQ.0) GO TO 1700 215: C !ANNOUNCED. VISIBLE? 216: 1250 IF(PROB(70,70)) RETURN 217: C !70% CHANCE TO DO NOTHING. 218: THFFLG=.TRUE. 219: NR=ROBRM(THFPOS,100,0,0,-THIEF)+ROBADV(WINNER,0,0,-THIEF) 220: I=586 221: C !ROBBED EM. 222: IF(RHERE.NE.0) I=588 223: C !WAS HE VISIBLE? 224: IF(NR.NE.0) I=I+1 225: C !DID HE GET ANYTHING? 226: CALL NEWSTA(THIEF,I,0,0,0) 227: C !VANISH THIEF. 228: IF(QSTILL(THFPOS)) 229: & CALL NEWSTA(STILL,0,0,THIEF,0) 230: IF((NR.NE.0).AND..NOT.LIT(THFPOS)) CALL RSPEAK(406) 231: RHERE=0 232: GO TO 1700 233: C !ONWARD. 234: C 235: C NOT IN ADVENTURERS ROOM. 236: C 237: 1400 CALL NEWSTA(THIEF,0,0,0,0) 238: C !VANISH. 239: RHERE=0 240: #ifdef debug 241: IF(DFLAG) PRINT 30,THFPOS 242: #ifdef NOCC 243: 30 FORMAT('THIEFD-- IN ROOM ',I4) 244: #else NOCC 245: 30 FORMAT(' THIEFD-- IN ROOM ',I4) 246: #endif NOCC 247: #endif debug 248: IF(QSTILL(THFPOS)) 249: & CALL NEWSTA(STILL,0,0,THIEF,0) 250: IF(and(RFLAG(THFPOS),RSEEN).EQ.0) GO TO 1700 251: I=ROBRM(THFPOS,75,0,0,-THIEF) 252: C !ROB ROOM 75%. 253: IF((THFPOS.LT.MAZE1).OR.(THFPOS.GT.MAZ15).OR. 254: & (HERE.LT.MAZE1).OR.(HERE.GT.MAZ15)) GO TO 1500 255: DO 1450 I=1,OLNT 256: C !BOTH IN MAZE. 257: IF(.NOT.QHERE(I,THFPOS).OR.PROB(60,60).OR. 258: & (and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT))) 259: & GO TO 1450 260: CALL RSPSUB(590,ODESC2(I)) 261: C !TAKE OBJECT. 262: IF(PROB(40,20)) GO TO 1700 263: CALL NEWSTA(I,0,0,0,-THIEF) 264: C !MOST OF THE TIME. 265: OFLAG2(I)=or(OFLAG2(I),TCHBT) 266: GO TO 1700 267: 1450 CONTINUE 268: GO TO 1700 269: C 270: 1500 DO 1550 I=1,OLNT 271: C !NOT IN MAZE. 272: IF(.NOT.QHERE(I,THFPOS).OR.(OTVAL(I).NE.0).OR.PROB(80,60).OR. 273: & (and(OFLAG1(I),(VISIBT+TAKEBT)).NE.(VISIBT+TAKEBT))) 274: & GO TO 1550 275: CALL NEWSTA(I,0,0,0,-THIEF) 276: OFLAG2(I)=or(OFLAG2(I),TCHBT) 277: GO TO 1700 278: 1550 CONTINUE 279: C 280: C NOW MOVE TO NEW ROOM. 281: C 282: 1700 IF(OADV(ROPE).EQ.-THIEF) DOMEF=.FALSE. 283: IF(ONCE) GO TO 1800 284: ONCE=.NOT.ONCE 285: 1750 THFPOS=THFPOS-1 286: C !NEXT ROOM. 287: IF(THFPOS.LE.0) THFPOS=RLNT 288: IF(and(RFLAG(THFPOS),(RLAND+RSACRD+REND)).NE.RLAND) 289: & GO TO 1750 290: THFFLG=.FALSE. 291: C !NOT ANNOUNCED. 292: GO TO 1025 293: C !ONCE MORE. 294: C 295: C ALL DONE. 296: C 297: 1800 IF(THFPOS.EQ.TREAS) RETURN 298: C !IN TREASURE ROOM? 299: J=591 300: C !NO, DROP STUFF. 301: IF(THFPOS.NE.HERE) J=0 302: DO 1850 I=1,OLNT 303: IF((OADV(I).NE.-THIEF).OR.PROB(70,70).OR. 304: & (OTVAL(I).GT.0)) GO TO 1850 305: CALL NEWSTA(I,J,THFPOS,0,0) 306: J=0 307: 1850 CONTINUE 308: RETURN 309: C 310: END
|
Last modified: 1988-10-21
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1898 |
|