1C GETOBJ-- FIND OBJ DESCRIBED BY ADJ, NAME PAIR 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 DECLARATIONS 8C 9C THIS ROUTINE DETAILS ON BIT 3 OF PRSFLG 10C 11 INTEGER FUNCTION GETOBJ(OIDX,AIDX,SPCOBJ) 12 IMPLICIT INTEGER(A-Z) 13 LOGICAL THISIT,GHERE,LIT,CHOMP 14#include "parser.h" 15#include "gamestate.h" 16C 17C MISCELLANEOUS VARIABLES 18C 19 COMMON /STAR/ MBASE,STRBIT 20#include "debug.h" 21#include "objects.h" 22#include "oflags.h" 23#include "advers.h" 24#include "vocab.h" 25C GETOBJ, PAGE 2 26C 27#ifdef debug 28 DFLAG=and(PRSFLG, 8).NE.0 29#endif debug 30 CHOMP=.FALSE. 31 AV=AVEHIC(WINNER) 32 OBJ=0 33C !ASSUME DARK. 34 IF(.NOT.LIT(HERE)) GO TO 200 35C !LIT? 36C 37 OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ) 38C !SEARCH ROOM. 39#ifdef debug 40 IF(DFLAG) PRINT 10,OBJ 41#ifdef NOCC 4210 FORMAT('SCHLST- ROOM SCH ',I6) 43#else NOCC 4410 FORMAT(' SCHLST- ROOM SCH ',I6) 45#endif NOCC 46#endif debug 47 IF(OBJ) 1000,200,100 48C !TEST RESULT. 49100 IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR. 50& (and(OFLAG2(OBJ),FINDBT).NE.0)) GO TO 200 51 IF(OCAN(OBJ).EQ.AV) GO TO 200 52C !TEST IF REACHABLE. 53 CHOMP=.TRUE. 54C !PROBABLY NOT. 55C 56200 IF(AV.EQ.0) GO TO 400 57C !IN VEHICLE? 58 NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ) 59C !SEARCH VEHICLE. 60#ifdef debug 61 IF(DFLAG) PRINT 20,NOBJ 62#ifdef NOCC 6320 FORMAT('SCHLST- VEH SCH ',I6) 64#else NOCC 6520 FORMAT(' SCHLST- VEH SCH ',I6) 66#endif NOCC 67#endif debug 68 IF(NOBJ) 1100,400,300 69C !TEST RESULT. 70300 CHOMP=.FALSE. 71C !REACHABLE. 72 IF(OBJ.EQ.NOBJ) GO TO 400 73C !SAME AS BEFORE? 74 IF(OBJ.NE.0) NOBJ=-NOBJ 75C !AMB RESULT? 76 OBJ=NOBJ 77C 78400 NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ) 79C !SEARCH ADVENTURER. 80#ifdef debug 81 IF(DFLAG) PRINT 30,NOBJ 82#ifdef NOCC 8330 FORMAT('SCHLST- ADV SCH ',I6) 84#else NOCC 8530 FORMAT(' SCHLST- ADV SCH ',I6) 86#endif NOCC 87#endif debug 88 IF(NOBJ) 1100,600,500 89C !TEST RESULT 90500 IF(OBJ.NE.0) NOBJ=-NOBJ 91C !AMB RESULT? 921100 OBJ=NOBJ 93C !RETURN NEW OBJECT. 94600 IF(CHOMP) OBJ=-10000 95C !UNREACHABLE. 961000 GETOBJ=OBJ 97C 98 IF(GETOBJ.NE.0) GO TO 1500 99C !GOT SOMETHING? 100 DO 1200 I=STRBIT+1,OLNT 101C !NO, SEARCH GLOBALS. 102 IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200 103 IF(.NOT.GHERE(I,HERE)) GO TO 1200 104C !CAN IT BE HERE? 105 IF(GETOBJ.NE.0) GETOBJ=-I 106C !AMB MATCH? 107 IF(GETOBJ.EQ.0) GETOBJ=I 1081200 CONTINUE 109C 1101500 CONTINUE 111C !END OF SEARCH. 112#ifdef debug 113 IF(DFLAG) PRINT 40,GETOBJ 114#ifdef NOCC 11540 FORMAT('SCHLST- RESULT ',I6) 116#else NOCC 11740 FORMAT(' SCHLST- RESULT ',I6) 118#endif NOCC 119#endif debug 120 RETURN 121 END 122C SCHLST-- SEARCH FOR OBJECT 123C 124C DECLARATIONS 125C 126 INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ) 127 IMPLICIT INTEGER(A-Z) 128 LOGICAL THISIT,QHERE,NOTRAN,NOVIS 129C 130 COMMON /STAR/ MBASE,STRBIT 131#include "objects.h" 132#include "oflags.h" 133C 134C FUNCTIONS AND DATA 135C 136 NOTRAN(O)=(and(OFLAG1(O),TRANBT).EQ.0).AND. 137& (and(OFLAG2(O),OPENBT).EQ.0) 138 NOVIS(O)=(and(OFLAG1(O),VISIBT).EQ.0) 139C 140 SCHLST=0 141C !NO RESULT. 142 DO 1000 I=1,OLNT 143C !SEARCH OBJECTS. 144 IF(NOVIS(I).OR. 145& (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND. 146& ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND. 147& ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000 148 IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200 149 IF(SCHLST.NE.0) GO TO 2000 150C !GOT ONE ALREADY? 151 SCHLST=I 152C !NO. 153C 154C IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF. 155C 156200 IF(NOTRAN(I)) GO TO 1000 157C 158C SEARCH IS CONDUCTED IN REVERSE. ALL OBJECTS ARE CHECKED TO 159C SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'. 160C IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT 161C CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY 162C AS A POTENTIAL MATCH. 163C 164 DO 500 J=1,OLNT 165C !SEARCH OBJECTS. 166 IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ))) 167& GO TO 500 168 X=OCAN(J) 169C !GET CONTAINER. 170300 IF(X.EQ.I) GO TO 400 171C !INSIDE TARGET? 172 IF(X.EQ.0) GO TO 500 173C !INSIDE ANYTHING? 174 IF(NOVIS(X).OR.NOTRAN(X).OR. 175& (and(OFLAG2(X),SCHBT).EQ.0)) GO TO 500 176 X=OCAN(X) 177C !GO ANOTHER LEVEL. 178 GO TO 300 179C 180400 IF(SCHLST.NE.0) GO TO 2000 181C !ALREADY GOT ONE? 182 SCHLST=J 183C !NO. 184500 CONTINUE 185C 1861000 CONTINUE 187 RETURN 188C 1892000 SCHLST=-SCHLST 190C !AMB RETURN. 191 RETURN 192C 193 END 194C 195C THISIT-- VALIDATE OBJECT VS DESCRIPTION 196C 197C DECLARATIONS 198C 199 LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ) 200 IMPLICIT INTEGER(A-Z) 201 LOGICAL NOTEST 202#include "vocab.h" 203C 204C FUNCTIONS AND DATA 205C 206 NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN) 207C 208C THE FOLLOWING DATA STATEMENT USED RADIX-50 NOTATION (R50MIN/1RA/) 209C IN RADIX-50 NOTATION, AN "A" IN THE FIRST POSITION IS 210C ENCODED AS 1*40*40 = 1600. 211C 212 DATA R50MIN/1600/ 213C 214 THISIT=.FALSE. 215C !ASSUME NO MATCH. 216 IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500 217C 218C CHECK FOR OBJECT NAMES 219C 220 I=OIDX+1 221100 I=I+1 222 IF(NOTEST(OVOC(I))) RETURN 223C !IF DONE, LOSE. 224 IF(OVOC(I).NE.OBJ) GO TO 100 225C !IF FAIL, CONT. 226C 227 IF(AIDX.EQ.0) GO TO 500 228C !ANY ADJ? 229 I=AIDX+1 230200 I=I+1 231 IF(NOTEST(AVOC(I))) RETURN 232C !IF DONE, LOSE. 233 IF(AVOC(I).NE.OBJ) GO TO 200 234C !IF FAIL, CONT. 235C 236500 THISIT=.TRUE. 237 RETURN 238 END 239