projects / unix-history / blame
| Commit | Line | Data |
|---|---|---|
| 8b22683c KB |
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 |