![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to np3.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 np3.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 ! root 1: C SYNMCH-- SYNTAX MATCHER ! 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 4 OF PRSFLG ! 10: C ! 11: LOGICAL FUNCTION SYNMCH() ! 12: IMPLICIT INTEGER(A-Z) ! 13: LOGICAL SYNEQL,TAKEIT ! 14: #include "parser.h" ! 15: #include "vocab.h" ! 16: #include "debug.h" ! 17: C ! 18: C THE FOLLOWING DATA STATEMENT WAS ORIGINALLY: ! 19: C ! 20: C DATA R50MIN/1RA/ ! 21: C ! 22: DATA R50MIN/1600/ ! 23: C ! 24: SYNMCH=.FALSE. ! 25: #ifdef debug ! 26: DFLAG=and(PRSFLG, 16).NE.0 ! 27: if(dflag) write(0,*) "synflags=",sdir,sind,sstd,sflip,sdriv,svmask ! 28: #endif ! 29: J=ACT ! 30: C !SET UP PTR TO SYNTAX. ! 31: DRIVE=0 ! 32: C !NO DEFAULT. ! 33: DFORCE=0 ! 34: C !NO FORCED DEFAULT. ! 35: QPREP=and(OFLAG,OPREP) ! 36: 100 J=J+2 ! 37: C !FIND START OF SYNTAX. ! 38: IF((VVOC(J).LE.0).OR.(VVOC(J).GE.R50MIN)) GO TO 100 ! 39: LIMIT=J+VVOC(J)+1 ! 40: C !COMPUTE LIMIT. ! 41: J=J+1 ! 42: C !ADVANCE TO NEXT. ! 43: C ! 44: 200 CALL UNPACK(J,NEWJ) ! 45: C !UNPACK SYNTAX. ! 46: #ifdef debug ! 47: IF(DFLAG) PRINT 60,O1,P1,DOBJ,DFL1,DFL2 ! 48: #ifdef NOCC ! 49: 60 FORMAT('SYNMCH INPUTS TO SYNEQL- ',5I7) ! 50: #else NOCC ! 51: 60 FORMAT(' SYNMCH INPUTS TO SYNEQL- ',5I7) ! 52: #endif NOCC ! 53: #endif ! 54: SPREP=and(DOBJ,VPMASK) ! 55: IF(.NOT.SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 1000 ! 56: #ifdef debug ! 57: IF(DFLAG) PRINT 60,O2,P2,IOBJ,IFL1,IFL2 ! 58: #endif ! 59: SPREP=and(IOBJ,VPMASK) ! 60: IF(SYNEQL(P2,O2,IOBJ,IFL1,IFL2)) GO TO 6000 ! 61: C ! 62: C SYNTAX MATCH FAILS, TRY NEXT ONE. ! 63: C ! 64: IF(O2) 3000,500,3000 ! 65: C !IF O2=0, SET DFLT. ! 66: 1000 IF(O1) 3000,500,3000 ! 67: C !IF O1=0, SET DFLT. ! 68: 500 IF((QPREP.EQ.0).OR.(QPREP.EQ.SPREP)) DFORCE=J ! 69: C !IF PREP MCH. ! 70: IF((and(VFLAG,SDRIV)).NE.0) DRIVE=J ! 71: 3000 J=NEWJ ! 72: IF(J.LT.LIMIT) GO TO 200 ! 73: C !MORE TO DO? ! 74: C SYNMCH, PAGE 2 ! 75: C ! 76: C MATCH HAS FAILED. IF DEFAULT SYNTAX EXISTS, TRY TO SNARF ! 77: C ORPHANS OR GWIMS, OR MAKE NEW ORPHANS. ! 78: C ! 79: #ifdef debug ! 80: IF(DFLAG) PRINT 20,DRIVE,DFORCE ! 81: #ifdef NOCC ! 82: 20 FORMAT('SYNMCH, DRIVE=',2I6) ! 83: #else NOCC ! 84: 20 FORMAT(' SYNMCH, DRIVE=',2I6) ! 85: #endif NOCC ! 86: #endif ! 87: IF(DRIVE.EQ.0) DRIVE=DFORCE ! 88: C !NO DRIVER? USE FORCE. ! 89: IF(DRIVE.EQ.0) GO TO 10000 ! 90: C !ANY DRIVER? ! 91: CALL UNPACK(DRIVE,DFORCE) ! 92: C !UNPACK DFLT SYNTAX. ! 93: C ! 94: C TRY TO FILL DIRECT OBJECT SLOT IF THAT WAS THE PROBLEM. ! 95: C ! 96: IF((and(VFLAG,SDIR).EQ.0).OR.(O1.NE.0)) GO TO 4000 ! 97: C ! 98: C FIRST TRY TO SNARF ORPHAN OBJECT. ! 99: C ! 100: O1=and(OFLAG,OSLOT) ! 101: IF(O1.EQ.0) GO TO 3500 ! 102: C !ANY ORPHAN? ! 103: IF(SYNEQL(P1,O1,DOBJ,DFL1,DFL2)) GO TO 4000 ! 104: C ! 105: C ORPHAN FAILS, TRY GWIM. ! 106: C ! 107: 3500 O1=GWIM(DOBJ,DFW1,DFW2) ! 108: C !GET GWIM. ! 109: #ifdef debug ! 110: IF(DFLAG) PRINT 30,O1 ! 111: #ifdef NOCC ! 112: 30 FORMAT('SYNMCH- DO GWIM= ',I6) ! 113: #else NOCC ! 114: 30 FORMAT(' SYNMCH- DO GWIM= ',I6) ! 115: #endif NOCC ! 116: #endif debug ! 117: IF(O1.GT.0) GO TO 4000 ! 118: C !TEST RESULT. ! 119: CALL ORPHAN(-1,ACT,0,and(DOBJ,VPMASK),0) ! 120: CALL RSPEAK(623) ! 121: RETURN ! 122: C ! 123: C TRY TO FILL INDIRECT OBJECT SLOT IF THAT WAS THE PROBLEM. ! 124: C ! 125: 4000 IF((and(VFLAG,SIND).EQ.0).OR.(O2.NE.0)) GO TO 6000 ! 126: O2=GWIM(IOBJ,IFW1,IFW2) ! 127: C !GWIM. ! 128: #ifdef debug ! 129: IF(DFLAG) PRINT 40,O2 ! 130: #ifdef NOCC ! 131: 40 FORMAT('SYNMCH- IO GWIM= ',I6) ! 132: #else NOCC ! 133: 40 FORMAT(' SYNMCH- IO GWIM= ',I6) ! 134: #endif NOCC ! 135: #endif debug ! 136: IF(O2.GT.0) GO TO 6000 ! 137: IF(O1.EQ.0) O1=and(OFLAG,OSLOT) ! 138: CALL ORPHAN(-1,ACT,O1,and(DOBJ,VPMASK),0) ! 139: CALL RSPEAK(624) ! 140: RETURN ! 141: C ! 142: C TOTAL CHOMP ! 143: C ! 144: 10000 CALL RSPEAK(601) ! 145: C !CANT DO ANYTHING. ! 146: RETURN ! 147: C SYNMCH, PAGE 3 ! 148: C ! 149: C NOW TRY TO TAKE INDIVIDUAL OBJECTS AND ! 150: C IN GENERAL CLEAN UP THE PARSE VECTOR. ! 151: C ! 152: 6000 IF(and(VFLAG,SFLIP).EQ.0) GO TO 5000 ! 153: J=O1 ! 154: C !YES. ! 155: O1=O2 ! 156: O2=J ! 157: C ! 158: 5000 PRSA=and(VFLAG,SVMASK) ! 159: PRSO=O1 ! 160: C !GET DIR OBJ. ! 161: PRSI=O2 ! 162: C !GET IND OBJ. ! 163: IF(.NOT.TAKEIT(PRSO,DOBJ)) RETURN ! 164: C !TRY TAKE. ! 165: IF(.NOT.TAKEIT(PRSI,IOBJ)) RETURN ! 166: C !TRY TAKE. ! 167: SYNMCH=.TRUE. ! 168: #ifdef debug ! 169: IF(DFLAG) PRINT 50,SYNMCH,PRSA,PRSO,PRSI,ACT,O1,O2 ! 170: #ifdef NOCC ! 171: 50 FORMAT('SYNMCH- RESULTS ',L1,6I7) ! 172: #else NOCC ! 173: 50 FORMAT(' SYNMCH- RESULTS ',L1,6I7) ! 174: #endif NOCC ! 175: #endif ! 176: RETURN ! 177: C ! 178: END ! 179: C UNPACK- UNPACK SYNTAX SPECIFICATION, ADV POINTER ! 180: C ! 181: C DECLARATIONS ! 182: C ! 183: SUBROUTINE UNPACK(OLDJ,J) ! 184: IMPLICIT INTEGER(A-Z) ! 185: #include "vocab.h" ! 186: #include "parser.h" ! 187: C ! 188: DO 10 I=1,11 ! 189: C !CLEAR SYNTAX. ! 190: SYN(I)=0 ! 191: 10 CONTINUE ! 192: C ! 193: VFLAG=VVOC(OLDJ) ! 194: J=OLDJ+1 ! 195: IF(and(VFLAG,SDIR).EQ.0) RETURN ! 196: DFL1=-1 ! 197: C !ASSUME STD. ! 198: DFL2=-1 ! 199: IF(and(VFLAG,SSTD).EQ.0) GO TO 100 ! 200: DFW1=-1 ! 201: C !YES. ! 202: DFW2=-1 ! 203: DOBJ=VABIT+VRBIT+VFBIT ! 204: GO TO 200 ! 205: C ! 206: 100 DOBJ=VVOC(J) ! 207: C !NOT STD. ! 208: DFW1=VVOC(J+1) ! 209: DFW2=VVOC(J+2) ! 210: J=J+3 ! 211: IF(and(DOBJ,VEBIT).EQ.0) GO TO 200 ! 212: DFL1=DFW1 ! 213: C !YES. ! 214: DFL2=DFW2 ! 215: C ! 216: 200 IF(and(VFLAG,SIND).EQ.0) RETURN ! 217: IFL1=-1 ! 218: C !ASSUME STD. ! 219: IFL2=-1 ! 220: IOBJ=VVOC(J) ! 221: IFW1=VVOC(J+1) ! 222: IFW2=VVOC(J+2) ! 223: J=J+3 ! 224: IF(and(IOBJ,VEBIT).EQ.0) RETURN ! 225: IFL1=IFW1 ! 226: C !YES. ! 227: IFL2=IFW2 ! 228: RETURN ! 229: C ! 230: END ! 231: C SYNEQL- TEST FOR SYNTAX EQUALITY ! 232: C ! 233: C DECLARATIONS ! 234: C ! 235: LOGICAL FUNCTION SYNEQL(PREP,OBJ,SPREP,SFL1,SFL2) ! 236: IMPLICIT INTEGER(A-Z) ! 237: #include "objects.h" ! 238: #include "parser.h" ! 239: C ! 240: IF(OBJ.EQ.0) GO TO 100 ! 241: C !ANY OBJECT? ! 242: SYNEQL=(PREP.EQ.and(SPREP,VPMASK)).AND. ! 243: & (or(and(SFL1,OFLAG1(OBJ)), ! 244: & and(SFL2,OFLAG2(OBJ))).NE.0) ! 245: RETURN ! 246: C ! 247: 100 SYNEQL=(PREP.EQ.0).AND.(SFL1.EQ.0).AND.(SFL2.EQ.0) ! 248: RETURN ! 249: C ! 250: END ! 251: C TAKEIT- PARSER BASED TAKE OF OBJECT ! 252: C ! 253: C DECLARATIONS ! 254: C ! 255: LOGICAL FUNCTION TAKEIT(OBJ,SFLAG) ! 256: IMPLICIT INTEGER(A-Z) ! 257: #include "parser.h" ! 258: COMMON /STAR/ MBASE,STRBIT ! 259: #include "gamestate.h" ! 260: #include "state.h" ! 261: #include "objects.h" ! 262: #include "oflags.h" ! 263: #include "advers.h" ! 264: C TAKEIT, PAGE 2 ! 265: C ! 266: TAKEIT=.FALSE. ! 267: C !ASSUME LOSES. ! 268: IF((OBJ.EQ.0).OR.(OBJ.GT.STRBIT)) GO TO 4000 ! 269: C !NULL/STARS WIN. ! 270: ODO2=ODESC2(OBJ) ! 271: C !GET DESC. ! 272: X=OCAN(OBJ) ! 273: C !GET CONTAINER. ! 274: IF((X.EQ.0).OR.(and(SFLAG,VFBIT).EQ.0)) GO TO 500 ! 275: IF(and(OFLAG2(X),OPENBT).NE.0) GO TO 500 ! 276: CALL RSPSUB(566,ODO2) ! 277: C !CANT REACH. ! 278: RETURN ! 279: C ! 280: 500 IF(and(SFLAG,VRBIT).EQ.0) GO TO 1000 ! 281: IF(and(SFLAG,VTBIT).EQ.0) GO TO 2000 ! 282: C ! 283: C SHOULD BE IN ROOM (VRBIT NE 0) AND CAN BE TAKEN (VTBIT NE 0) ! 284: C ! 285: IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 ! 286: C !IF NOT, OK. ! 287: C ! 288: C ITS IN THE ROOM AND CAN BE TAKEN. ! 289: C ! 290: IF((and(OFLAG1(OBJ),TAKEBT).NE.0).AND. ! 291: & (and(OFLAG2(OBJ),TRYBT).EQ.0)) GO TO 3000 ! 292: C ! 293: C NOT TAKEABLE. IF WE CARE, FAIL. ! 294: C ! 295: IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000 ! 296: CALL RSPSUB(445,ODO2) ! 297: RETURN ! 298: C ! 299: C 1000-- IT SHOULD NOT BE IN THE ROOM. ! 300: C 2000-- IT CANT BE TAKEN. ! 301: C ! 302: 2000 IF(and(SFLAG,VCBIT).EQ.0) GO TO 4000 ! 303: 1000 IF(SCHLST(0,0,HERE,0,0,OBJ).LE.0) GO TO 4000 ! 304: CALL RSPSUB(665,ODO2) ! 305: RETURN ! 306: C TAKEIT, PAGE 3 ! 307: C ! 308: C OBJECT IS IN THE ROOM, CAN BE TAKEN BY THE PARSER, ! 309: C AND IS TAKEABLE IN GENERAL. IT IS NOT A STAR. ! 310: C TAKING IT SHOULD NOT HAVE SIDE AFFECTS. ! 311: C IF IT IS INSIDE SOMETHING, THE CONTAINER IS OPEN. ! 312: C THE FOLLOWING CODE IS LIFTED FROM SUBROUTINE TAKE. ! 313: C ! 314: 3000 IF(OBJ.NE.AVEHIC(WINNER)) GO TO 3500 ! 315: C !TAKE VEHICLE? ! 316: CALL RSPEAK(672) ! 317: RETURN ! 318: C ! 319: 3500 IF(((X.NE.0).AND.(OADV(X).EQ.WINNER)).OR. ! 320: & ((WEIGHT(0,OBJ,WINNER)+OSIZE(OBJ)).LE.MXLOAD)) ! 321: & GO TO 3700 ! 322: CALL RSPEAK(558) ! 323: C !TOO BIG. ! 324: RETURN ! 325: C ! 326: 3700 CALL NEWSTA(OBJ,559,0,0,WINNER) ! 327: C !DO TAKE. ! 328: OFLAG2(OBJ)=or(OFLAG2(OBJ),TCHBT) ! 329: CALL SCRUPD(OFVAL(OBJ)) ! 330: OFVAL(OBJ)=0 ! 331: C ! 332: 4000 TAKEIT=.TRUE. ! 333: C !SUCCESS. ! 334: RETURN ! 335: C ! 336: END ! 337: C ! 338: C GWIM- GET WHAT I MEAN IN AMBIGOUS SITUATIONS ! 339: C ! 340: C DECLARATIONS ! 341: C ! 342: INTEGER FUNCTION GWIM(SFLAG,SFW1,SFW2) ! 343: IMPLICIT INTEGER(A-Z) ! 344: LOGICAL TAKEIT,NOCARE ! 345: #include "parser.h" ! 346: COMMON /STAR/ MBASE,STRBIT ! 347: #include "gamestate.h" ! 348: #include "objects.h" ! 349: #include "oflags.h" ! 350: #include "advers.h" ! 351: C GWIM, PAGE 2 ! 352: C ! 353: GWIM=-1 ! 354: C !ASSUME LOSE. ! 355: AV=AVEHIC(WINNER) ! 356: NOBJ=0 ! 357: NOCARE=and(SFLAG,VCBIT).EQ.0 ! 358: C ! 359: C FIRST SEARCH ADVENTURER ! 360: C ! 361: IF(and(SFLAG,VABIT).NE.0) ! 362: & NOBJ=FWIM(SFW1,SFW2,0,0,WINNER,NOCARE) ! 363: IF(and(SFLAG,VRBIT).NE.0) GO TO 100 ! 364: 50 GWIM=NOBJ ! 365: RETURN ! 366: C ! 367: C ALSO SEARCH ROOM ! 368: C ! 369: 100 ROBJ=FWIM(SFW1,SFW2,HERE,0,0,NOCARE) ! 370: IF(ROBJ) 500,50,200 ! 371: C !TEST RESULT. ! 372: C ! 373: C ROBJ > 0 ! 374: C ! 375: 200 IF((AV.EQ.0).OR.(ROBJ.EQ.AV).OR. ! 376: & (and(OFLAG2(ROBJ),FINDBT).NE.0)) GO TO 300 ! 377: IF(OCAN(ROBJ).NE.AV) GO TO 50 ! 378: C !UNREACHABLE? TRY NOBJ ! 379: 300 IF(NOBJ.NE.0) RETURN ! 380: C !IF AMBIGUOUS, RETURN. ! 381: IF(.NOT.TAKEIT(ROBJ,SFLAG)) RETURN ! 382: C !IF UNTAKEABLE, RETURN ! 383: GWIM=ROBJ ! 384: 500 RETURN ! 385: C ! 386: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.