C FINDXT- FIND EXIT FROM ROOM
C
C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
C WRITTEN BY R. M. SUPNIK
C
C DECLARATIONS
C
       LOGICAL FUNCTION FINDXT(DIR,RM)
       IMPLICIT INTEGER (A-Z)
C
C ROOMS
C
       COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
       1       RACTIO(200),RVAL(200),RFLAG(200)
       INTEGER RRAND(200)
       EQUIVALENCE (RVAL,RRAND)
C
C EXITS
C
       COMMON /EXITS/ XLNT,TRAVEL(900)
C
       COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
       EQUIVALENCE (XFLAG,XOBJ)
C
       COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
       1       XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
C
       FINDXT=.TRUE.                           !ASSUME WINS.
       XI=REXIT(RM)                            !FIND FIRST ENTRY.
       IF(XI.EQ.0) GO TO 1000                  !NO EXITS?
C
100     I=TRAVEL(XI)                            !GET ENTRY.
       XROOM1=I.AND.XRMASK                     !ISOLATE ROOM.
       XTYPE=(((I.AND..NOT.XLFLAG)/XFSHFT).AND.XFMASK)+1
       GO TO (110,120,130,130),XTYPE           !BRANCH ON ENTRY.
       CALL BUG(10,XTYPE)
C
130     XOBJ=TRAVEL(XI+2).AND.XRMASK            !DOOR/CEXIT- GET OBJ/FLAG.
       XACTIO=TRAVEL(XI+2)/XASHFT
120     XSTRNG=TRAVEL(XI+1)                     !DOOR/CEXIT/NEXIT - STRING.
110     XI=XI+XELNT(XTYPE)                      !ADVANCE TO NEXT ENTRY.
       IF((I.AND.XDMASK).EQ.DIR) RETURN        !MATCH?
       IF((I.AND.XLFLAG).EQ.0) GO TO 100       !LAST ENTRY?
1000    FINDXT=.FALSE.                          !YES, LOSE.
       RETURN
       END
C FWIM- FIND WHAT I MEAN
C
C DECLARATIONS
C
       INTEGER FUNCTION FWIM(F1,F2,RM,CON,ADV,NOCARE)
       IMPLICIT INTEGER (A-Z)
       LOGICAL NOCARE
C
C OBJECTS
C
       COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
       1       OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
       2       OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
       3       OADV(220),OCAN(220),OREAD(220)
C
       COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
       1       NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
       2       TOOLBT,TURNBT,ONBT
       COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
       1       WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
       2       TCHBT,VEHBT,SCHBT
C
       FWIM=0                                  !ASSUME NOTHING.
       DO 1000 I=1,OLNT                        !LOOP
         IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
       1       ((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
       2       ((CON.EQ.0).OR.(OCAN(I).NE.CON)))
       3       GO TO 1000
C
C OBJECT IS ON LIST... IS IT A MATCH?
C
         IF((OFLAG1(I).AND.VISIBT).EQ.0) GO TO 1000
         IF((.NOT.NOCARE .AND.((OFLAG1(I).AND.TAKEBT).EQ.0)) .OR.
       1       (((OFLAG1(I).AND.F1).EQ.0).AND.
       2        ((OFLAG2(I).AND.F2).EQ.0))) GO TO 500
         IF(FWIM.EQ.0) GO TO 400                       !ALREADY GOT SOMETHING?
         FWIM=-FWIM                            !YES, AMBIGUOUS.
         RETURN
C
400       FWIM=I                                        !NOTE MATCH.
C
C DOES OBJECT CONTAIN A MATCH?
C
500       IF((OFLAG2(I).AND.OPENBT).EQ.0) GO TO 1000 !CLOSED?
         DO 700 J=1,OLNT                               !NO, SEARCH CONTENTS.
           IF((OCAN(J).NE.I).OR.((OFLAG1(J).AND.VISIBT).EQ.0) .OR.
       1       (((OFLAG1(J).AND.F1).EQ.0).AND.
       2        ((OFLAG2(J).AND.F2).EQ.0))) GO TO 700
           IF(FWIM.EQ.0) GO TO 600
           FWIM=-FWIM
           RETURN
C
600         FWIM=J
700       CONTINUE
1000    CONTINUE
       RETURN
       END
C YESNO- OBTAIN YES/NO ANSWER
C
C CALLED BY-
C
C       YES-IS-TRUE=YESNO(QUESTION,YES-STRING,NO-STRING)
C
       LOGICAL FUNCTION YESNO(Q,Y,N)
       IMPLICIT INTEGER(A-Z)
       COMMON /CHAN/ INPCH,OUTCH,DBCH
C
100     CALL RSPEAK(Q)                          !ASK
       READ(INPCH,110) ANS                     !GET ANSWER
110     FORMAT(A1)
       IF((ANS.EQ.'Y').OR.(ANS.EQ.'y')) GO TO 200
       IF((ANS.EQ.'N').OR.(ANS.EQ.'n')) GO TO 300
       CALL RSPEAK(6)                          !SCOLD.
       GO TO 100
C
200     YESNO=.TRUE.                            !YES,
       CALL RSPEAK(Y)                          !OUT WITH IT.
       RETURN
C
300     YESNO=.FALSE.                           !NO,
       CALL RSPEAK(N)                          !LIKEWISE.
       RETURN
C
       END

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.