|
|
1.1 root 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.