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