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

   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: #include "rooms.h"
  12: #include "exits.h"
  13: #include "curxt.h"
  14: #include "xpars.h"
  15: C
  16:         FINDXT=.TRUE.
  17: C						!ASSUME WINS.
  18:         XI=REXIT(RM)
  19: C						!FIND FIRST ENTRY.
  20:         IF(XI.EQ.0) GO TO 1000
  21: C						!NO EXITS?
  22: C
  23: 100     I=TRAVEL(XI)
  24: C						!GET ENTRY.
  25:         XROOM1=and(I,XRMASK)
  26: c mask to 16-bits to get rid of sign extension problems with 32-bit ints
  27:         XXXFLG = and(not(XLFLAG), 65535)
  28:         XTYPE=and((and(I,XXXFLG)/XFSHFT),XFMASK)+1
  29:         GO TO (110,120,130,130),XTYPE
  30: C						!BRANCH ON ENTRY.
  31:         CALL BUG(10,XTYPE)
  32: C
  33: 130     XOBJ=and(TRAVEL(XI+2),XRMASK)
  34:         XACTIO=TRAVEL(XI+2)/XASHFT
  35: 120     XSTRNG=TRAVEL(XI+1)
  36: C						!DOOR/CEXIT/NEXIT - STRING.
  37: 110     XI=XI+XELNT(XTYPE)
  38: C						!ADVANCE TO NEXT ENTRY.
  39:         IF(and(I,XDMASK).EQ.DIR) RETURN
  40:         IF(and(I,XLFLAG).EQ.0) GO TO 100
  41: 1000    FINDXT=.FALSE.
  42: C						!YES, LOSE.
  43:         RETURN
  44:         END
  45: C FWIM- FIND WHAT I MEAN
  46: C
  47: C DECLARATIONS
  48: C
  49:         INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
  50:         IMPLICIT INTEGER (A-Z)
  51:         LOGICAL NOCARE
  52: #include "objects.h"
  53: #include "oflags.h"
  54: C
  55:         FWIM=0
  56: C						!ASSUME NOTHING.
  57:         DO 1000 I=1,OLNT
  58: C						!LOOP
  59:           IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
  60: &               ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
  61: &               ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
  62: &               GO TO 1000
  63: C
  64: C OBJECT IS ON LIST... IS IT A MATCH?
  65: C
  66:           IF(and(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
  67:           IF(and(not(NOCARE),(and(OFLAG1(I),TAKEBT).EQ.0)) .OR.
  68: &               ((and(OFLAG1(I),F1).EQ.0).AND.
  69: &                (and(OFLAG2(I),F2).EQ.0))) GO TO 500
  70:           IF(FWIM.EQ.0) GO TO 400
  71: C						!ALREADY GOT SOMETHING?
  72:           FWIM=-FWIM
  73: C						!YES, AMBIGUOUS.
  74:           RETURN
  75: C
  76: 400       FWIM=I
  77: C						!NOTE MATCH.
  78: C
  79: C DOES OBJECT CONTAIN A MATCH?
  80: C
  81: 500       IF(and(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
  82:           DO 700 J=1,OLNT
  83: C						!NO, SEARCH CONTENTS.
  84:             IF((OCAN(J).NE.I).OR.(and(OFLAG1(J),VISIBT).EQ.0) .OR.
  85: &               ((and(OFLAG1(J),F1).EQ.0).AND.
  86: &                (and(OFLAG2(J),F2).EQ.0))) GO TO 700
  87:             IF(FWIM.EQ.0) GO TO 600
  88:             FWIM=-FWIM
  89:             RETURN
  90: C
  91: 600         FWIM=J
  92: 700       CONTINUE
  93: 1000    CONTINUE
  94:         RETURN
  95:         END
  96: C YESNO- OBTAIN YES/NO ANSWER
  97: C
  98: C CALLED BY-
  99: C
 100: C	YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
 101: C
 102:         LOGICAL FUNCTION YESNO(Q,Y,N)
 103:         IMPLICIT INTEGER(A-Z)
 104:         COMMON /CHAN/ INPCH,OUTCH,DBCH
 105:         CHARACTER ANS
 106: C
 107: 100     CALL RSPEAK(Q)
 108: C						!ASK
 109: #ifdef PDP
 110:         call rdchr(ANS)
 111: #else
 112:         READ(INPCH,110) ANS
 113: #endif PDP
 114: C						!GET ANSWER
 115: 110     FORMAT(A1)
 116:         IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
 117:         IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
 118:         CALL RSPEAK(6)
 119: C						!SCOLD.
 120:         GO TO 100
 121: C
 122: 200     YESNO=.TRUE.
 123: C						!YES,
 124:         CALL RSPEAK(Y)
 125: C						!OUT WITH IT.
 126:         RETURN
 127: C
 128: 300     YESNO=.FALSE.
 129: C						!NO,
 130:         CALL RSPEAK(N)
 131: C						!LIKEWISE.
 132:         RETURN
 133: C
 134:         END