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