4.4BSD/usr/src/contrib/dungeon/dso3.F

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)
#include "rooms.h"
#include "exits.h"
#include "curxt.h"
#include "xpars.h"
C
	FINDXT=.TRUE.
C						!ASSUME WINS.
	XI=REXIT(RM)
C						!FIND FIRST ENTRY.
	IF(XI.EQ.0) GO TO 1000
C						!NO EXITS?
C
100	I=TRAVEL(XI)
C						!GET ENTRY.
	XROOM1=and(I,XRMASK)
c mask to 16-bits to get rid of sign extension problems with 32-bit ints
	XXXFLG = and(not(XLFLAG), 65535)
	XTYPE=and((and(I,XXXFLG)/XFSHFT),XFMASK)+1
	GO TO (110,120,130,130),XTYPE
C						!BRANCH ON ENTRY.
	CALL BUG(10,XTYPE)
C
130	XOBJ=and(TRAVEL(XI+2),XRMASK)
	XACTIO=TRAVEL(XI+2)/XASHFT
120	XSTRNG=TRAVEL(XI+1)
C						!DOOR/CEXIT/NEXIT - STRING.
110	XI=XI+XELNT(XTYPE)
C						!ADVANCE TO NEXT ENTRY.
	IF(and(I,XDMASK).EQ.DIR) RETURN
	IF(and(I,XLFLAG).EQ.0) GO TO 100
1000	FINDXT=.FALSE.
C						!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
#include "objects.h"
#include "oflags.h"
C
	FWIM=0
C						!ASSUME NOTHING.
	DO 1000 I=1,OLNT
C						!LOOP
	  IF(((RM.EQ.0).OR.(OROOM(I).NE.RM)) .AND.
&		((ADV.EQ.0).OR.(OADV(I).NE.ADV)) .AND.
&		((CON.EQ.0).OR.(OCAN(I).NE.CON)))
&		GO TO 1000
C
C OBJECT IS ON LIST... IS IT A MATCH?
C
	  IF(and(OFLAG1(I),VISIBT).EQ.0) GO TO 1000
	  IF(and(not(NOCARE),(and(OFLAG1(I),TAKEBT).EQ.0)) .OR.
&		((and(OFLAG1(I),F1).EQ.0).AND.
&		 (and(OFLAG2(I),F2).EQ.0))) GO TO 500
	  IF(FWIM.EQ.0) GO TO 400
C						!ALREADY GOT SOMETHING?
	  FWIM=-FWIM
C						!YES, AMBIGUOUS.
	  RETURN
C
400	  FWIM=I
C						!NOTE MATCH.
C
C DOES OBJECT CONTAIN A MATCH?
C
500	  IF(and(OFLAG2(I),OPENBT).EQ.0) GO TO 1000
	  DO 700 J=1,OLNT
C						!NO, SEARCH CONTENTS.
	    IF((OCAN(J).NE.I).OR.(and(OFLAG1(J),VISIBT).EQ.0) .OR.
&		((and(OFLAG1(J),F1).EQ.0).AND.
&		 (and(OFLAG2(J),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
	CHARACTER ANS
C
100	CALL RSPEAK(Q)
C						!ASK
#ifdef PDP
	call rdchr(ANS)
#else
	READ(INPCH,110) ANS
#endif PDP
C						!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)
C						!SCOLD.
	GO TO 100
C
200	YESNO=.TRUE.
C						!YES,
	CALL RSPEAK(Y)
C						!OUT WITH IT.
	RETURN
C
300	YESNO=.FALSE.
C						!NO,
	CALL RSPEAK(N)
C						!LIKEWISE.
	RETURN
C
	END