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