1: C TAKE-- BASIC TAKE SEQUENCE 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 TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.) 8: C 9: LOGICAL FUNCTION TAKE(FLG) 10: C 11: C DECLARATIONS 12: C 13: IMPLICIT INTEGER (A-Z) 14: LOGICAL FLG,OBJACT,OAPPLI,QOPEN,QHERE 15: #include "parser.h" 16: #include "gamestate.h" 17: #include "state.h" 18: COMMON /STAR/ MBASE,STRBIT 19: #include "objects.h" 20: #include "oflags.h" 21: C 22: #include "advers.h" 23: C 24: C FUNCTIONS AND DATA 25: C 26: QOPEN(O)=(and(OFLAG2(O),OPENBT).NE.0) 27: C TAKE, PAGE 2 28: C 29: TAKE=.FALSE. 30: C !ASSUME LOSES. 31: OA=OACTIO(PRSO) 32: C !GET OBJECT ACTION. 33: IF(PRSO.LE.STRBIT) GO TO 100 34: C !STAR? 35: TAKE=OBJACT(X) 36: C !YES, LET IT HANDLE. 37: RETURN 38: C 39: 100 X=OCAN(PRSO) 40: C !INSIDE? 41: IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400 42: C !HIS VEHICLE? 43: CALL RSPEAK(672) 44: C !DUMMY. 45: RETURN 46: C 47: 400 IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500 48: IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+RND(5)) 49: RETURN 50: C 51: C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN. 52: C 53: 500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600 54: IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557) 55: C !ALREADY GOT IT? 56: RETURN 57: C 58: 600 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR. 59: & ((WEIGHT(0,PRSO,WINNER)+OSIZE(PRSO)).LE.MXLOAD)) 60: & GO TO 700 61: CALL RSPEAK(558) 62: C !TOO MUCH WEIGHT. 63: RETURN 64: C 65: 700 TAKE=.TRUE. 66: C !AT LAST. 67: IF(OAPPLI(OA,0)) RETURN 68: C !DID IT HANDLE? 69: CALL NEWSTA(PRSO,0,0,0,WINNER) 70: C !TAKE OBJECT FOR WINNER. 71: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 72: CALL SCRUPD(OFVAL(PRSO)) 73: C !UPDATE SCORE. 74: OFVAL(PRSO)=0 75: C !CANT BE SCORED AGAIN. 76: IF(FLG) CALL RSPEAK(559) 77: C !TELL TAKEN. 78: RETURN 79: C 80: END 81: C DROP- DROP VERB PROCESSOR 82: C 83: C DECLARATIONS 84: C 85: LOGICAL FUNCTION DROP(Z) 86: IMPLICIT INTEGER (A-Z) 87: LOGICAL F,PUT,OBJACT 88: #include "parser.h" 89: #include "gamestate.h" 90: C 91: C ROOMS 92: #include "rindex.h" 93: #include "objects.h" 94: #include "oflags.h" 95: C 96: #include "advers.h" 97: #include "verbs.h" 98: C DROP, PAGE 2 99: C 100: DROP=.TRUE. 101: C !ASSUME WINS. 102: X=OCAN(PRSO) 103: C !GET CONTAINER. 104: IF(X.EQ.0) GO TO 200 105: C !IS IT INSIDE? 106: IF(OADV(X).NE.WINNER) GO TO 1000 107: C !IS HE CARRYING CON? 108: IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 300 109: CALL RSPSUB(525,ODESC2(X)) 110: C !CANT REACH. 111: RETURN 112: C 113: 200 IF(OADV(PRSO).NE.WINNER) GO TO 1000 114: C !IS HE CARRYING OBJ? 115: 300 IF(AVEHIC(WINNER).EQ.0) GO TO 400 116: C !IS HE IN VEHICLE? 117: PRSI=AVEHIC(WINNER) 118: C !YES, 119: F=PUT(.TRUE.) 120: C !DROP INTO VEHICLE. 121: PRSI=0 122: C !DISARM PARSER. 123: RETURN 124: C !DONE. 125: C 126: 400 CALL NEWSTA(PRSO,0,HERE,0,0) 127: C !DROP INTO ROOM. 128: IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0) 129: CALL SCRUPD(OFVAL(PRSO)) 130: C !SCORE OBJECT. 131: OFVAL(PRSO)=0 132: C !CANT BE SCORED AGAIN. 133: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 134: C 135: IF(OBJACT(X)) RETURN 136: C !DID IT HANDLE? 137: I=0 138: C !ASSUME NOTHING TO SAY. 139: IF(PRSA.EQ.DROPW) I=528 140: IF(PRSA.EQ.THROWW) I=529 141: IF((I.NE.0).AND.(HERE.EQ.MTREE)) I=659 142: CALL RSPSUB(I,ODESC2(PRSO)) 143: RETURN 144: C 145: 1000 CALL RSPEAK(527) 146: C !DONT HAVE IT. 147: RETURN 148: C 149: END 150: C PUT- PUT VERB PROCESSOR 151: C 152: C DECLARATIONS 153: C 154: LOGICAL FUNCTION PUT(FLG) 155: IMPLICIT INTEGER (A-Z) 156: LOGICAL TAKE,QOPEN,QHERE,OBJACT,FLG 157: #include "parser.h" 158: #include "gamestate.h" 159: C 160: C MISCELLANEOUS VARIABLES 161: C 162: COMMON /STAR/ MBASE,STRBIT 163: #include "objects.h" 164: #include "oflags.h" 165: #include "advers.h" 166: #include "verbs.h" 167: C 168: C FUNCTIONS AND DATA 169: C 170: QOPEN(R)=((and(OFLAG2(R),OPENBT)).NE.0) 171: C PUT, PAGE 2 172: C 173: PUT=.FALSE. 174: IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200 175: IF(.NOT.OBJACT(X)) CALL RSPEAK(560) 176: C !STAR 177: PUT=.TRUE. 178: RETURN 179: C 180: 200 IF((QOPEN(PRSI)) 181: & .OR.(and(OFLAG1(PRSI),(DOORBT+CONTBT)).NE.0) 182: & .OR.(and(OFLAG2(PRSI),VEHBT).NE.0)) GO TO 300 183: CALL RSPEAK(561) 184: C !CANT PUT IN THAT. 185: RETURN 186: C 187: 300 IF(QOPEN(PRSI)) GO TO 400 188: C !IS IT OPEN? 189: CALL RSPEAK(562) 190: C !NO, JOKE 191: RETURN 192: C 193: 400 IF(PRSO.NE.PRSI) GO TO 500 194: C !INTO ITSELF? 195: CALL RSPEAK(563) 196: C !YES, JOKE. 197: RETURN 198: C 199: 500 IF(OCAN(PRSO).NE.PRSI) GO TO 600 200: C !ALREADY INSIDE. 201: CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI)) 202: PUT=.TRUE. 203: RETURN 204: C 205: 600 IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO)) 206: & .LE.OCAPAC(PRSI)) GO TO 700 207: CALL RSPEAK(565) 208: C !THEN CANT DO IT. 209: RETURN 210: C 211: C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM 212: C 213: 700 J=PRSO 214: C !START SEARCH. 215: 725 IF(QHERE(J,HERE)) GO TO 750 216: C !IS IT HERE? 217: J=OCAN(J) 218: IF(J.NE.0) GO TO 725 219: C !MORE TO DO? 220: GO TO 800 221: C !NO, SCH FAILS. 222: C 223: 750 SVO=PRSO 224: C !SAVE PARSER. 225: SVI=PRSI 226: PRSA=TAKEW 227: PRSI=0 228: IF(.NOT.TAKE(.FALSE.)) RETURN 229: C !TAKE OBJECT. 230: PRSA=PUTW 231: PRSO=SVO 232: PRSI=SVI 233: GO TO 1000 234: C 235: C NOW SEE IF OBJECT IS ON PERSON. 236: C 237: 800 IF(OCAN(PRSO).EQ.0) GO TO 1000 238: C !INSIDE? 239: IF(QOPEN(OCAN(PRSO))) GO TO 900 240: C !OPEN? 241: CALL RSPSUB(566,ODESC2(PRSO)) 242: C !LOSE. 243: RETURN 244: C 245: 900 CALL SCRUPD(OFVAL(PRSO)) 246: C !SCORE OBJECT. 247: OFVAL(PRSO)=0 248: OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 249: CALL NEWSTA(PRSO,0,0,0,WINNER) 250: C !TEMPORARILY ON WINNER. 251: C 252: 1000 IF(OBJACT(X)) RETURN 253: C !NO, GIVE OBJECT A SHOT. 254: CALL NEWSTA(PRSO,2,0,PRSI,0) 255: C !CONTAINED INSIDE. 256: PUT=.TRUE. 257: RETURN 258: C 259: END 260: C VALUAC- HANDLES VALUABLES/EVERYTHING 261: C 262: C DECLARATIONS 263: C 264: SUBROUTINE VALUAC(V) 265: IMPLICIT INTEGER (A-Z) 266: LOGICAL LIT,F,F1,TAKE,PUT,DROP,NOTVAL,QHERE 267: #include "parser.h" 268: #include "gamestate.h" 269: #include "objects.h" 270: #include "oflags.h" 271: #include "verbs.h" 272: C 273: C FUNCTIONS AND DATA 274: C 275: NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0) 276: C VALUAC, PAGE 2 277: C 278: F=.TRUE. 279: C !ASSUME NO ACTIONS. 280: I=579 281: C !ASSUME NOT LIT. 282: IF(.NOT.LIT(HERE)) GO TO 4000 283: C !IF NOT LIT, PUNT. 284: I=677 285: C !ASSUME WRONG VERB. 286: SAVEP=PRSO 287: C !SAVE PRSO. 288: SAVEH=HERE 289: C !SAVE HERE. 290: C 291: 100 IF(PRSA.NE.TAKEW) GO TO 1000 292: C !TAKE EVERY/VALUA? 293: DO 500 PRSO=1,OLNT 294: C !LOOP THRU OBJECTS. 295: IF(.NOT.QHERE(PRSO,HERE).OR. 296: & (and(OFLAG1(PRSO),VISIBT).EQ.0).OR. 297: & (and(OFLAG2(PRSO),ACTRBT).NE.0).OR. 298: & NOTVAL(PRSO)) GO TO 500 299: IF((and(OFLAG1(PRSO),TAKEBT).EQ.0).AND. 300: & (and(OFLAG2(PRSO),TRYBT).EQ.0)) GO TO 500 301: F=.FALSE. 302: CALL RSPSUB(580,ODESC2(PRSO)) 303: F1=TAKE(.TRUE.) 304: IF(SAVEH.NE.HERE) RETURN 305: 500 CONTINUE 306: GO TO 3000 307: C 308: 1000 IF(PRSA.NE.DROPW) GO TO 2000 309: C !DROP EVERY/VALUA? 310: DO 1500 PRSO=1,OLNT 311: IF((OADV(PRSO).NE.WINNER).OR.NOTVAL(PRSO)) 312: & GO TO 1500 313: F=.FALSE. 314: CALL RSPSUB(580,ODESC2(PRSO)) 315: F1=DROP(.TRUE.) 316: IF(SAVEH.NE.HERE) RETURN 317: 1500 CONTINUE 318: GO TO 3000 319: C 320: 2000 IF(PRSA.NE.PUTW) GO TO 3000 321: C !PUT EVERY/VALUA? 322: DO 2500 PRSO=1,OLNT 323: C !LOOP THRU OBJECTS. 324: IF((OADV(PRSO).NE.WINNER) 325: & .OR.(PRSO.EQ.PRSI).OR.NOTVAL(PRSO).OR. 326: & (and(OFLAG1(PRSO),VISIBT).EQ.0)) GO TO 2500 327: F=.FALSE. 328: CALL RSPSUB(580,ODESC2(PRSO)) 329: F1=PUT(.TRUE.) 330: IF(SAVEH.NE.HERE) RETURN 331: 2500 CONTINUE 332: C 333: 3000 I=581 334: IF(SAVEP.EQ.V) I=582 335: C !CHOOSE MESSAGE. 336: 4000 IF(F) CALL RSPEAK(I) 337: C !IF NOTHING, REPORT. 338: RETURN 339: END
|
Last modified: 1988-10-21
Generated: 2016-12-26 |
Generated by src2html V0.67
page hit count: 1884 |
|