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