home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / dso3.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  3.4 KB  |  132 lines
  1. C FINDXT- FIND EXIT FROM ROOM
  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.     LOGICAL FUNCTION FINDXT(DIR,RM)
  10.     IMPLICIT INTEGER (A-Z)
  11. C
  12. C ROOMS
  13. C
  14.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  15.     1    RACTIO(200),RVAL(200),RFLAG(200)
  16.     INTEGER RRAND(200)
  17.     EQUIVALENCE (RVAL,RRAND)
  18. C
  19. C EXITS
  20. C
  21.     COMMON /EXITS/ XLNT,TRAVEL(900)
  22. C
  23.     COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
  24.     EQUIVALENCE (XFLAG,XOBJ)
  25. C
  26.     COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
  27.     1    XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
  28. C
  29.     FINDXT=.TRUE.                !ASSUME WINS.
  30.     XI=REXIT(RM)                !FIND FIRST ENTRY.
  31.     IF(XI.EQ.0) GO TO 1000            !NO EXITS?
  32. C
  33. 100    I=TRAVEL(XI)                !GET ENTRY.
  34.     XROOM1=I.AND.XRMASK            !ISOLATE ROOM.
  35.     XTYPE=(((I.AND..NOT.XLFLAG)/XFSHFT).AND.XFMASK)+1
  36.     GO TO (110,120,130,130),XTYPE        !BRANCH ON ENTRY.
  37.     CALL BUG(10,XTYPE)
  38. C
  39. 130    XOBJ=TRAVEL(XI+2).AND.XRMASK        !DOOR/CEXIT- GET OBJ/FLAG.
  40.     XACTIO=TRAVEL(XI+2)/XASHFT
  41. 120    XSTRNG=TRAVEL(XI+1)            !DOOR/CEXIT/NEXIT - STRING.
  42. 110    XI=XI+XELNT(XTYPE)            !ADVANCE TO NEXT ENTRY.
  43.     IF((I.AND.XDMASK).EQ.DIR) RETURN    !MATCH?
  44.     IF((I.AND.XLFLAG).EQ.0) GO TO 100    !LAST ENTRY?
  45. 1000    FINDXT=.FALSE.                !YES, LOSE.
  46.     RETURN
  47.     END
  48. C FWIM- FIND WHAT I MEAN
  49. C
  50. C DECLARATIONS
  51. C
  52.     INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
  53.     IMPLICIT INTEGER (A-Z)
  54.     LOGICAL NOCARE
  55. C
  56. C OBJECTS
  57. C
  58.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  59.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  60.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  61.     3    OADV(220),OCAN(220),OREAD(220)
  62. C
  63.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  64.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  65.     2    TOOLBT,TURNBT,ONBT
  66.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  67.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  68.     2    TCHBT,VEHBT,SCHBT
  69. C
  70.     FWIM=0                    !ASSUME NOTHING.
  71.     DO 1000 I=1,OLNT            !LOOP
  72.       IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
  73.     1    ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
  74.     2    ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
  75.     3    GO TO 1000
  76. C
  77. C OBJECT IS ON LIST... IS IT A MATCH?
  78. C
  79.       IF((OFLAG1(I).AND.VISIBT).EQ.0) GO TO 1000
  80.       IF((.NOT.NOCARE .AND.((OFLAG1(I).AND.TAKEBT).EQ.0)) .OR.
  81.     1    (((OFLAG1(I).AND.F1).EQ.0).AND.
  82.     2     ((OFLAG2(I).AND.F2).EQ.0))) GO TO 500
  83.       IF(FWIM.EQ.0) GO TO 400            !ALREADY GOT SOMETHING?
  84.       FWIM=-FWIM                !YES, AMBIGUOUS.
  85.       RETURN
  86. C
  87. 400      FWIM=I                    !NOTE MATCH.
  88. C
  89. C DOES OBJECT CONTAIN A MATCH?
  90. C
  91. 500      IF((OFLAG2(I).AND.OPENBT).EQ.0) GO TO 1000 !CLOSED?
  92.       DO 700 J=1,OLNT                !NO, SEARCH CONTENTS.
  93.         IF((OCAN(J).NE.I).OR.((OFLAG1(J).AND.VISIBT).EQ.0) .OR.
  94.     1    (((OFLAG1(J).AND.F1).EQ.0).AND.
  95.     2     ((OFLAG2(J).AND.F2).EQ.0))) GO TO 700
  96.         IF(FWIM.EQ.0) GO TO 600
  97.         FWIM=-FWIM
  98.         RETURN
  99. C
  100. 600        FWIM=J
  101. 700      CONTINUE
  102. 1000    CONTINUE
  103.     RETURN
  104.     END
  105. C YESNO- OBTAIN YES/NO ANSWER
  106. C
  107. C CALLED BY-
  108. C
  109. C    YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
  110. C
  111.     LOGICAL FUNCTION YESNO(Q,Y,N)
  112.     IMPLICIT INTEGER(A-Z)
  113.     COMMON /CHAN/ INPCH,OUTCH,DBCH
  114. C
  115. 100    CALL RSPEAK(Q)                !ASK
  116.     READ(INPCH,110) ANS            !GET ANSWER
  117. 110    FORMAT(A1)
  118.     IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
  119.     IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
  120.     CALL RSPEAK(6)                !SCOLD.
  121.     GO TO 100
  122. C
  123. 200    YESNO=.TRUE.                !YES,
  124.     CALL RSPEAK(Y)                !OUT WITH IT.
  125.     RETURN
  126. C
  127. 300    YESNO=.FALSE.                !NO,
  128.     CALL RSPEAK(N)                !LIKEWISE.
  129.     RETURN
  130. C
  131.     END
  132.