# 2.11BSD#431 - /usr/src/new/PORT/dungeon/np2.F

       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: 628 |