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: 1888
Valid CSS Valid XHTML 1.0 Strict