home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / np2.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  5.6 KB  |  207 lines
  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,DFLAG
  14. C
  15.     COMMON /OBJFLG/ VABIT,VRBIT,VTBIT,VCBIT,VEBIT,VFBIT,VPMASK
  16. C
  17. C GAME STATE
  18. C
  19.     LOGICAL TELFLG
  20.     COMMON /PLAY/ WINNER,HERE,TELFLG
  21. C
  22. C MISCELLANEOUS VARIABLES
  23. C
  24.     COMMON /STAR/ MBASE,STRBIT
  25.     COMMON /DEBUG/ DBGFLG,PRSFLG
  26. C
  27. C OBJECTS
  28. C
  29.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  30.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  31.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  32.     3    OADV(220),OCAN(220),OREAD(220)
  33. C
  34.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  35.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  36.     2    TOOLBT,TURNBT,ONBT
  37.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  38.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  39.     2    TCHBT,VEHBT,SCHBT
  40. C
  41. C ADVENTURERS
  42. C
  43.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  44.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  45. C
  46. C VOCABULARIES
  47. C
  48.     COMMON /OBJVOC/ OVOC(1050)
  49. C GETOBJ, PAGE 2
  50. C
  51. D    DFLAG=(PRSFLG.AND."10).NE.0
  52.     CHOMP=.FALSE.
  53.     AV=AVEHIC(WINNER)
  54.     OBJ=0                    !ASSUME DARK.
  55.     IF(.NOT.LIT(HERE)) GO TO 200        !LIT?
  56. C
  57.     OBJ=SCHLST(OIDX,AIDX,HERE,0,0,SPCOBJ)    !SEARCH ROOM.
  58. D    IF(DFLAG) TYPE 10,OBJ
  59. D10    FORMAT(' SCHLST- ROOM SCH ',I6)
  60.     IF(OBJ) 1000,200,100            !TEST RESULT.
  61. 100    IF((AV.EQ.0).OR.(AV.EQ.OBJ).OR.
  62.     1    ((OFLAG2(OBJ).AND.FINDBT).NE.0)) GO TO 200
  63.     IF(OCAN(OBJ).EQ.AV) GO TO 200        !TEST IF REACHABLE.
  64.     CHOMP=.TRUE.                !PROBABLY NOT.
  65. C
  66. 200    IF(AV.EQ.0) GO TO 400            !IN VEHICLE?
  67.     NOBJ=SCHLST(OIDX,AIDX,0,AV,0,SPCOBJ)    !SEARCH VEHICLE.
  68. D    IF(DFLAG) TYPE 20,NOBJ
  69. D20    FORMAT(' SCHLST- VEH SCH  ',I6)
  70.     IF(NOBJ) 1100,400,300            !TEST RESULT.
  71. 300    CHOMP=.FALSE.                !REACHABLE.
  72.     IF(OBJ.EQ.NOBJ) GO TO 400        !SAME AS BEFORE?
  73.     IF(OBJ.NE.0) NOBJ=-NOBJ            !AMB RESULT?
  74.     OBJ=NOBJ
  75. C
  76. 400    NOBJ=SCHLST(OIDX,AIDX,0,0,WINNER,SPCOBJ)    !SEARCH ADVENTURER.
  77. D    IF(DFLAG) TYPE 30,NOBJ
  78. D30    FORMAT(' SCHLST- ADV SCH  ',I6)
  79.     IF(NOBJ) 1100,600,500            !TEST RESULT
  80. 500    IF(OBJ.NE.0) NOBJ=-NOBJ            !AMB RESULT?
  81. 1100    OBJ=NOBJ                !RETURN NEW OBJECT.
  82. 600    IF(CHOMP) OBJ=-10000            !UNREACHABLE.
  83. 1000    GETOBJ=OBJ
  84. C
  85.     IF(GETOBJ.NE.0) GO TO 1500        !GOT SOMETHING?
  86.     DO 1200 I=STRBIT+1,OLNT            !NO, SEARCH GLOBALS.
  87.       IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 1200
  88.       IF(.NOT.GHERE(I,HERE)) GO TO 1200    !CAN IT BE HERE?
  89.       IF(GETOBJ.NE.0) GETOBJ=-I        !AMB MATCH?
  90.       IF(GETOBJ.EQ.0) GETOBJ=I
  91. 1200    CONTINUE
  92. C
  93. 1500    CONTINUE                !END OF SEARCH.
  94. D    IF(DFLAG) TYPE 40,GETOBJ
  95. D40    FORMAT(' SCHLST- RESULT   ',I6)
  96.     RETURN
  97.     END
  98. C SCHLST--    SEARCH FOR OBJECT
  99. C
  100. C DECLARATIONS
  101. C
  102.     INTEGER FUNCTION SCHLST(OIDX,AIDX,RM,CN,AD,SPCOBJ)
  103.     IMPLICIT INTEGER(A-Z)
  104.     LOGICAL THISIT,QHERE,NOTRAN,NOVIS
  105. C
  106.     COMMON /STAR/ MBASE,STRBIT
  107. C
  108. C OBJECTS
  109. C
  110.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  111.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  112.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  113.     3    OADV(220),OCAN(220),OREAD(220)
  114. C
  115.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  116.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  117.     2    TOOLBT,TURNBT,ONBT
  118.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  119.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  120.     2    TCHBT,VEHBT,SCHBT
  121. C
  122. C FUNCTIONS AND DATA
  123. C
  124.     NOTRAN(O)=((OFLAG1(O).AND.TRANBT).EQ.0).AND.
  125.     1    ((OFLAG2(O).AND.OPENBT).EQ.0)
  126.     NOVIS(O)=((OFLAG1(O).AND.VISIBT).EQ.0)
  127. C
  128.     SCHLST=0                    !NO RESULT.
  129.     DO 1000 I=1,OLNT            !SEARCH OBJECTS.
  130.       IF(NOVIS(I).OR.
  131.     1    (((RM.EQ.0).OR.(.NOT.QHERE(I,RM))).AND.
  132.     2     ((CN.EQ.0).OR.(OCAN(I).NE.CN)).AND.
  133.     3     ((AD.EQ.0).OR.(OADV(I).NE.AD)))) GO TO 1000
  134.       IF(.NOT.THISIT(OIDX,AIDX,I,SPCOBJ)) GO TO 200
  135.       IF(SCHLST.NE.0) GO TO 2000        !GOT ONE ALREADY?
  136.       SCHLST=I                    !NO.
  137. C
  138. C IF OPEN OR TRANSPARENT, SEARCH THE OBJECT ITSELF.
  139. C
  140. 200      IF(NOTRAN(I)) GO TO 1000
  141. C
  142. C SEARCH IS CONDUCTED IN REVERSE.  ALL OBJECTS ARE CHECKED TO
  143. C SEE IF THEY ARE AT SOME LEVEL OF CONTAINMENT INSIDE OBJECT 'I'.
  144. C IF THEY ARE AT LEVEL 1, OR IF ALL LINKS IN THE CONTAINMENT
  145. C CHAIN ARE OPEN, VISIBLE, AND HAVE SEARCHME SET, THEY CAN QUALIFY
  146. C AS A POTENTIAL MATCH.
  147. C
  148.       DO 500 J=1,OLNT            !SEARCH OBJECTS.
  149.         IF(NOVIS(J).OR. (.NOT.THISIT(OIDX,AIDX,J,SPCOBJ)))
  150.     1    GO TO 500            !VISIBLE & MATCH?
  151.         X=OCAN(J)                !GET CONTAINER.
  152. 300        IF(X.EQ.I) GO TO 400        !INSIDE TARGET?
  153.         IF(X.EQ.0) GO TO 500        !INSIDE ANYTHING?
  154.         IF(NOVIS(X).OR.NOTRAN(X).OR.
  155.     1    ((OFLAG2(X).AND.SCHBT).EQ.0)) GO TO 500
  156.         X=OCAN(X)                !GO ANOTHER LEVEL.
  157.         GO TO 300
  158. C
  159. 400        IF(SCHLST.NE.0) GO TO 2000        !ALREADY GOT ONE?
  160.         SCHLST=J                !NO.
  161. 500      CONTINUE
  162. C
  163. 1000    CONTINUE
  164.     RETURN
  165. C
  166. 2000    SCHLST=-SCHLST                !AMB RETURN.
  167.     RETURN
  168. C
  169.     END
  170. C THISIT--    VALIDATE OBJECT VS DESCRIPTION
  171. C
  172. C DECLARATIONS
  173. C
  174.     LOGICAL FUNCTION THISIT(OIDX,AIDX,OBJ,SPCOBJ)
  175.     IMPLICIT INTEGER(A-Z)
  176.     LOGICAL NOTEST
  177. C
  178. C VOCABULARIES
  179. C
  180.     COMMON /OBJVOC/ OVOC(1050)
  181.     COMMON /ADJVOC/ AVOC(450)
  182. C
  183. C FUNCTIONS AND DATA
  184. C
  185.     NOTEST(O)=(O.LE.0).OR.(O.GE.R50MIN)
  186.     DATA R50MIN/1RA/
  187. C
  188.     THISIT=.FALSE.                !ASSUME NO MATCH.
  189.     IF((SPCOBJ.NE.0).AND.(OBJ.EQ.SPCOBJ)) GO TO 500
  190. C
  191. C CHECK FOR OBJECT NAMES
  192. C
  193.     I=OIDX+1
  194. 100    I=I+1
  195.     IF(NOTEST(OVOC(I))) RETURN        !IF DONE, LOSE.
  196.     IF(OVOC(I).NE.OBJ) GO TO 100        !IF FAIL, CONT.
  197. C
  198.     IF(AIDX.EQ.0) GO TO 500            !ANY ADJ?
  199.     I=AIDX+1
  200. 200    I=I+1
  201.     IF(NOTEST(AVOC(I))) RETURN        !IF DONE, LOSE.
  202.     IF(AVOC(I).NE.OBJ) GO TO 200        !IF FAIL, CONT.
  203. C
  204. 500    THISIT=.TRUE.
  205.     RETURN
  206.     END
  207.