1C TAKE-- BASIC TAKE SEQUENCE 2C 3C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142 4C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED 5C WRITTEN BY R. M. SUPNIK 6C 7C TAKE AN OBJECT (FOR VERBS TAKE, PUT, DROP, READ, ETC.) 8C 9 LOGICAL FUNCTION TAKE(FLG) 10C 11C DECLARATIONS 12C 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" 21C 22#include "advers.h" 23C 24C FUNCTIONS AND DATA 25C 26 QOPEN(O)=(and(OFLAG2(O),OPENBT).NE.0) 27C TAKE, PAGE 2 28C 29 TAKE=.FALSE. 30C !ASSUME LOSES. 31 OA=OACTIO(PRSO) 32C !GET OBJECT ACTION. 33 IF(PRSO.LE.STRBIT) GO TO 100 34C !STAR? 35 TAKE=OBJACT(X) 36C !YES, LET IT HANDLE. 37 RETURN 38C 39100 X=OCAN(PRSO) 40C !INSIDE? 41 IF(PRSO.NE.AVEHIC(WINNER)) GO TO 400 42C !HIS VEHICLE? 43 CALL RSPEAK(672) 44C !DUMMY. 45 RETURN 46C 47400 IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 500 48 IF(.NOT.OAPPLI(OA,0)) CALL RSPEAK(552+RND(5)) 49 RETURN 50C 51C OBJECT IS TAKEABLE AND IN POSITION TO BE TAKEN. 52C 53500 IF((X.NE.0).OR. QHERE(PRSO,HERE)) GO TO 600 54 IF(OADV(PRSO).EQ.WINNER) CALL RSPEAK(557) 55C !ALREADY GOT IT? 56 RETURN 57C 58600 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) 62C !TOO MUCH WEIGHT. 63 RETURN 64C 65700 TAKE=.TRUE. 66C !AT LAST. 67 IF(OAPPLI(OA,0)) RETURN 68C !DID IT HANDLE? 69 CALL NEWSTA(PRSO,0,0,0,WINNER) 70C !TAKE OBJECT FOR WINNER. 71 OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 72 CALL SCRUPD(OFVAL(PRSO)) 73C !UPDATE SCORE. 74 OFVAL(PRSO)=0 75C !CANT BE SCORED AGAIN. 76 IF(FLG) CALL RSPEAK(559) 77C !TELL TAKEN. 78 RETURN 79C 80 END 81C DROP- DROP VERB PROCESSOR 82C 83C DECLARATIONS 84C 85 LOGICAL FUNCTION DROP(Z) 86 IMPLICIT INTEGER (A-Z) 87 LOGICAL F,PUT,OBJACT 88#include "parser.h" 89#include "gamestate.h" 90C 91C ROOMS 92#include "rindex.h" 93#include "objects.h" 94#include "oflags.h" 95C 96#include "advers.h" 97#include "verbs.h" 98C DROP, PAGE 2 99C 100 DROP=.TRUE. 101C !ASSUME WINS. 102 X=OCAN(PRSO) 103C !GET CONTAINER. 104 IF(X.EQ.0) GO TO 200 105C !IS IT INSIDE? 106 IF(OADV(X).NE.WINNER) GO TO 1000 107C !IS HE CARRYING CON? 108 IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 300 109 CALL RSPSUB(525,ODESC2(X)) 110C !CANT REACH. 111 RETURN 112C 113200 IF(OADV(PRSO).NE.WINNER) GO TO 1000 114C !IS HE CARRYING OBJ? 115300 IF(AVEHIC(WINNER).EQ.0) GO TO 400 116C !IS HE IN VEHICLE? 117 PRSI=AVEHIC(WINNER) 118C !YES, 119 F=PUT(.TRUE.) 120C !DROP INTO VEHICLE. 121 PRSI=0 122C !DISARM PARSER. 123 RETURN 124C !DONE. 125C 126400 CALL NEWSTA(PRSO,0,HERE,0,0) 127C !DROP INTO ROOM. 128 IF(HERE.EQ.MTREE) CALL NEWSTA(PRSO,0,FORE3,0,0) 129 CALL SCRUPD(OFVAL(PRSO)) 130C !SCORE OBJECT. 131 OFVAL(PRSO)=0 132C !CANT BE SCORED AGAIN. 133 OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 134C 135 IF(OBJACT(X)) RETURN 136C !DID IT HANDLE? 137 I=0 138C !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 144C 1451000 CALL RSPEAK(527) 146C !DONT HAVE IT. 147 RETURN 148C 149 END 150C PUT- PUT VERB PROCESSOR 151C 152C DECLARATIONS 153C 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" 159C 160C MISCELLANEOUS VARIABLES 161C 162 COMMON /STAR/ MBASE,STRBIT 163#include "objects.h" 164#include "oflags.h" 165#include "advers.h" 166#include "verbs.h" 167C 168C FUNCTIONS AND DATA 169C 170 QOPEN(R)=((and(OFLAG2(R),OPENBT)).NE.0) 171C PUT, PAGE 2 172C 173 PUT=.FALSE. 174 IF((PRSO.LE.STRBIT).AND.(PRSI.LE.STRBIT)) GO TO 200 175 IF(.NOT.OBJACT(X)) CALL RSPEAK(560) 176C !STAR 177 PUT=.TRUE. 178 RETURN 179C 180200 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) 184C !CANT PUT IN THAT. 185 RETURN 186C 187300 IF(QOPEN(PRSI)) GO TO 400 188C !IS IT OPEN? 189 CALL RSPEAK(562) 190C !NO, JOKE 191 RETURN 192C 193400 IF(PRSO.NE.PRSI) GO TO 500 194C !INTO ITSELF? 195 CALL RSPEAK(563) 196C !YES, JOKE. 197 RETURN 198C 199500 IF(OCAN(PRSO).NE.PRSI) GO TO 600 200C !ALREADY INSIDE. 201 CALL RSPSB2(564,ODESC2(PRSO),ODESC2(PRSI)) 202 PUT=.TRUE. 203 RETURN 204C 205600 IF((WEIGHT(0,PRSO,0)+WEIGHT(0,PRSI,0)+OSIZE(PRSO)) 206& .LE.OCAPAC(PRSI)) GO TO 700 207 CALL RSPEAK(565) 208C !THEN CANT DO IT. 209 RETURN 210C 211C NOW SEE IF OBJECT (OR ITS CONTAINER) IS IN ROOM 212C 213700 J=PRSO 214C !START SEARCH. 215725 IF(QHERE(J,HERE)) GO TO 750 216C !IS IT HERE? 217 J=OCAN(J) 218 IF(J.NE.0) GO TO 725 219C !MORE TO DO? 220 GO TO 800 221C !NO, SCH FAILS. 222C 223750 SVO=PRSO 224C !SAVE PARSER. 225 SVI=PRSI 226 PRSA=TAKEW 227 PRSI=0 228 IF(.NOT.TAKE(.FALSE.)) RETURN 229C !TAKE OBJECT. 230 PRSA=PUTW 231 PRSO=SVO 232 PRSI=SVI 233 GO TO 1000 234C 235C NOW SEE IF OBJECT IS ON PERSON. 236C 237800 IF(OCAN(PRSO).EQ.0) GO TO 1000 238C !INSIDE? 239 IF(QOPEN(OCAN(PRSO))) GO TO 900 240C !OPEN? 241 CALL RSPSUB(566,ODESC2(PRSO)) 242C !LOSE. 243 RETURN 244C 245900 CALL SCRUPD(OFVAL(PRSO)) 246C !SCORE OBJECT. 247 OFVAL(PRSO)=0 248 OFLAG2(PRSO)=or(OFLAG2(PRSO),TCHBT) 249 CALL NEWSTA(PRSO,0,0,0,WINNER) 250C !TEMPORARILY ON WINNER. 251C 2521000 IF(OBJACT(X)) RETURN 253C !NO, GIVE OBJECT A SHOT. 254 CALL NEWSTA(PRSO,2,0,PRSI,0) 255C !CONTAINED INSIDE. 256 PUT=.TRUE. 257 RETURN 258C 259 END 260C VALUAC- HANDLES VALUABLES/EVERYTHING 261C 262C DECLARATIONS 263C 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" 272C 273C FUNCTIONS AND DATA 274C 275 NOTVAL(R)=(SAVEP.EQ.V).AND.(OTVAL(R).LE.0) 276C VALUAC, PAGE 2 277C 278 F=.TRUE. 279C !ASSUME NO ACTIONS. 280 I=579 281C !ASSUME NOT LIT. 282 IF(.NOT.LIT(HERE)) GO TO 4000 283C !IF NOT LIT, PUNT. 284 I=677 285C !ASSUME WRONG VERB. 286 SAVEP=PRSO 287C !SAVE PRSO. 288 SAVEH=HERE 289C !SAVE HERE. 290C 291100 IF(PRSA.NE.TAKEW) GO TO 1000 292C !TAKE EVERY/VALUA? 293 DO 500 PRSO=1,OLNT 294C !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 305500 CONTINUE 306 GO TO 3000 307C 3081000 IF(PRSA.NE.DROPW) GO TO 2000 309C !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 3171500 CONTINUE 318 GO TO 3000 319C 3202000 IF(PRSA.NE.PUTW) GO TO 3000 321C !PUT EVERY/VALUA? 322 DO 2500 PRSO=1,OLNT 323C !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 3312500 CONTINUE 332C 3333000 I=581 334 IF(SAVEP.EQ.V) I=582 335C !CHOOSE MESSAGE. 3364000 IF(F) CALL RSPEAK(I) 337C !IF NOTHING, REPORT. 338 RETURN 339 END 340