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