![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to nrooms.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to nrooms.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 1: C RAPPL2- SPECIAL PURPOSE ROOM ROUTINES, PART 2
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 RAPPL2(RI)
10: IMPLICIT INTEGER (A-Z)
11: LOGICAL QOPEN,QHERE
12: #include "parser.h"
13: #include "gamestate.h"
14: #include "state.h"
15: #include "io.h"
16: #include "rooms.h"
17: #include "rflag.h"
18: #include "rindex.h"
19: #include "objects.h"
20: #include "oflags.h"
21: #include "oindex.h"
22: #include "xsrch.h"
23: #include "clock.h"
24: #include "advers.h"
25: #include "verbs.h"
26: #include "flags.h"
27: C
28: C FUNCTIONS AND DATA
29: C
30: QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
31: DATA NEWRMS/38/
32: C RAPPL2, PAGE 2
33: C
34: RAPPL2=.TRUE.
35: GO TO (38000,39000,40000,41000,42000,43000,44000,
36: & 45000,46000,47000,48000,49000,50000,
37: & 51000,52000,53000,54000,55000,56000,
38: & 57000,58000,59000,60000),
39: & (RI-NEWRMS+1)
40: CALL BUG(70,RI)
41: RETURN
42: C
43: C R38-- MIRROR D ROOM
44: C
45: 38000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(FDOOR,MRG,0,682,681)
46: RETURN
47: C
48: C R39-- MIRROR G ROOM
49: C
50: 39000 IF(PRSA.EQ.WALKIW) CALL JIGSUP(685)
51: RETURN
52: C
53: C R40-- MIRROR C ROOM
54: C
55: 40000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRG,MRB,683,0,681)
56: RETURN
57: C
58: C R41-- MIRROR B ROOM
59: C
60: 41000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRC,MRA,0,0,681)
61: RETURN
62: C
63: C R42-- MIRROR A ROOM
64: C
65: 42000 IF(PRSA.EQ.LOOKW) CALL LOOKTO(MRB,0,0,684,681)
66: RETURN
67: C RAPPL2, PAGE 3
68: C
69: C R43-- MIRROR C EAST/WEST
70: C
71: 43000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,683)
72: RETURN
73: C
74: C R44-- MIRROR B EAST/WEST
75: C
76: 44000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,686)
77: RETURN
78: C
79: C R45-- MIRROR A EAST/WEST
80: C
81: 45000 IF(PRSA.EQ.LOOKW) CALL EWTELL(HERE,687)
82: RETURN
83: C
84: C R46-- INSIDE MIRROR
85: C
86: 46000 IF(PRSA.NE.LOOKW) RETURN
87: C !LOOK?
88: CALL RSPEAK(688)
89: C !DESCRIBE
90: C
91: C NOW DESCRIBE POLE STATE.
92: C
93: C CASES 1,2-- MDIR=270 & MLOC=MRB, POLE IS UP OR IN HOLE
94: C CASES 3,4-- MDIR=0 V MDIR=180, POLE IS UP OR IN CHANNEL
95: C CASE 5-- POLE IS UP
96: C
97: I=689
98: C !ASSUME CASE 5.
99: IF((MDIR.EQ.270).AND.(MLOC.EQ.MRB))
100: & I=690+MIN0(POLEUF,1)
101: IF(MOD(MDIR,180).EQ.0)
102: & I=692+MIN0(POLEUF,1)
103: CALL RSPEAK(I)
104: C !DESCRIBE POLE.
105: CALL RSPSUB(694,695+(MDIR/45))
106: C !DESCRIBE ARROW.
107: RETURN
108: C RAPPL2, PAGE 4
109: C
110: C R47-- MIRROR EYE ROOM
111: C
112: 47000 IF(PRSA.NE.LOOKW) RETURN
113: C !LOOK?
114: I=704
115: C !ASSUME BEAM STOP.
116: DO 47100 J=1,OLNT
117: IF(QHERE(J,HERE).AND.(J.NE.RBEAM)) GO TO 47200
118: 47100 CONTINUE
119: I=703
120: 47200 CALL RSPSUB(I,ODESC2(J))
121: C !DESCRIBE BEAM.
122: CALL LOOKTO(MRA,0,0,0,0)
123: C !LOOK NORTH.
124: RETURN
125: C
126: C R48-- INSIDE CRYPT
127: C
128: 48000 IF(PRSA.NE.LOOKW) RETURN
129: C !LOOK?
130: I=46
131: C !CRYPT IS OPEN/CLOSED.
132: IF(QOPEN(TOMB)) I=12
133: CALL RSPSUB(705,I)
134: RETURN
135: C
136: C R49-- SOUTH CORRIDOR
137: C
138: 49000 IF(PRSA.NE.LOOKW) RETURN
139: C !LOOK?
140: CALL RSPEAK(706)
141: C !DESCRIBE.
142: I=46
143: C !ODOOR IS OPEN/CLOSED.
144: IF(QOPEN(ODOOR)) I=12
145: IF(LCELL.EQ.4) CALL RSPSUB(707,I)
146: C !DESCRIBE ODOOR IF THERE.
147: RETURN
148: C
149: C R50-- BEHIND DOOR
150: C
151: 50000 IF(PRSA.NE.WALKIW) GO TO 50100
152: C !WALK IN?
153: CFLAG(CEVFOL)=.TRUE.
154: C !MASTER FOLLOWS.
155: CTICK(CEVFOL)=-1
156: RETURN
157: C
158: 50100 IF(PRSA.NE.LOOKW) RETURN
159: C !LOOK?
160: I=46
161: C !QDOOR IS OPEN/CLOSED.
162: IF(QOPEN(QDOOR)) I=12
163: CALL RSPSUB(708,I)
164: RETURN
165: C RAPPL2, PAGE 5
166: C
167: C R51-- FRONT DOOR
168: C
169: 51000 IF(PRSA.EQ.WALKIW) CTICK(CEVFOL)=0
170: C !IF EXITS, KILL FOLLOW.
171: IF(PRSA.NE.LOOKW) RETURN
172: C !LOOK?
173: CALL LOOKTO(0,MRD,709,0,0)
174: C !DESCRIBE SOUTH.
175: I=46
176: C !PANEL IS OPEN/CLOSED.
177: IF(INQSTF) I=12
178: C !OPEN IF INQ STARTED.
179: J=46
180: C !QDOOR IS OPEN/CLOSED.
181: IF(QOPEN(QDOOR)) J=12
182: CALL RSPSB2(710,I,J)
183: RETURN
184: C
185: C R52-- NORTH CORRIDOR
186: C
187: 52000 IF(PRSA.NE.LOOKW) RETURN
188: C !LOOK?
189: I=46
190: IF(QOPEN(CDOOR)) I=12
191: C !CDOOR IS OPEN/CLOSED.
192: CALL RSPSUB(711,I)
193: RETURN
194: C
195: C R53-- PARAPET
196: C
197: 53000 IF(PRSA.EQ.LOOKW) CALL RSPSUB(712,712+PNUMB)
198: RETURN
199: C
200: C R54-- CELL
201: C
202: 54000 IF(PRSA.NE.LOOKW) RETURN
203: C !LOOK?
204: I=721
205: C !CDOOR IS OPEN/CLOSED.
206: IF(QOPEN(CDOOR)) I=722
207: CALL RSPEAK(I)
208: I=46
209: C !ODOOR IS OPEN/CLOSED.
210: IF(QOPEN(ODOOR)) I=12
211: IF(LCELL.EQ.4) CALL RSPSUB(723,I)
212: C !DESCRIBE.
213: RETURN
214: C
215: C R55-- PRISON CELL
216: C
217: 55000 IF(PRSA.EQ.LOOKW) CALL RSPEAK(724)
218: C !LOOK?
219: RETURN
220: C
221: C R56-- NIRVANA CELL
222: C
223: 56000 IF(PRSA.NE.LOOKW) RETURN
224: C !LOOK?
225: I=46
226: C !ODOOR IS OPEN/CLOSED.
227: IF(QOPEN(ODOOR)) I=12
228: CALL RSPSUB(725,I)
229: RETURN
230: C RAPPL2, PAGE 6
231: C
232: C R57-- NIRVANA AND END OF GAME
233: C
234: 57000 IF(PRSA.NE.WALKIW) RETURN
235: C !WALKIN?
236: CALL RSPEAK(726)
237: CALL SCORE(.FALSE.)
238: C moved to exit routine CLOSE(DBCH)
239: CALL EXIT
240: C
241: C R58-- TOMB ROOM
242: C
243: 58000 IF(PRSA.NE.LOOKW) RETURN
244: C !LOOK?
245: I=46
246: C !TOMB IS OPEN/CLOSED.
247: IF(QOPEN(TOMB)) I=12
248: CALL RSPSUB(792,I)
249: RETURN
250: C
251: C R59-- PUZZLE SIDE ROOM
252: C
253: 59000 IF(PRSA.NE.LOOKW) RETURN
254: C !LOOK?
255: I=861
256: C !ASSUME DOOR CLOSED.
257: IF(CPOUTF) I=862
258: C !OPEN?
259: CALL RSPEAK(I)
260: C !DESCRIBE.
261: RETURN
262: C
263: C R60-- PUZZLE ROOM
264: C
265: 60000 IF(PRSA.NE.LOOKW) RETURN
266: C !LOOK?
267: IF(CPUSHF) GO TO 60100
268: C !STARTED PUZZLE?
269: CALL RSPEAK(868)
270: C !NO, DESCRIBE.
271: IF(and(OFLAG2(WARNI),TCHBT).NE.0) CALL RSPEAK(869)
272: RETURN
273: C
274: 60100 CALL CPINFO(880,CPHERE)
275: C !DESCRIBE ROOM.
276: RETURN
277: C
278: END
279: C LOOKTO-- DESCRIBE VIEW IN MIRROR HALLWAY
280: C
281: C DECLARATIONS
282: C
283: SUBROUTINE LOOKTO(NRM,SRM,NT,ST,HT)
284: IMPLICIT INTEGER(A-Z)
285: #include "gamestate.h"
286: #include "flags.h"
287: C LOOKTO, PAGE 2
288: C
289: CALL RSPEAK(HT)
290: C !DESCRIBE HALL.
291: CALL RSPEAK(NT)
292: C !DESCRIBE NORTH VIEW.
293: CALL RSPEAK(ST)
294: C !DESCRIBE SOUTH VIEW.
295: DIR=0
296: C !ASSUME NO DIRECTION.
297: IF(IABS(MLOC-HERE).NE.1) GO TO 200
298: C !MIRROR TO N OR S?
299: IF(MLOC.EQ.NRM) DIR=695
300: IF(MLOC.EQ.SRM) DIR=699
301: C !DIR=N/S.
302: IF(MOD(MDIR,180).NE.0) GO TO 100
303: C !MIRROR N-S?
304: CALL RSPSUB(847,DIR)
305: C !YES, HE SEES PANEL
306: CALL RSPSB2(848,DIR,DIR)
307: C !AND NARROW ROOMS.
308: GO TO 200
309: C
310: 100 M1=MRHERE(HERE)
311: C !WHICH MIRROR?
312: MRBF=0
313: C !ASSUME INTACT.
314: IF(((M1.EQ.1).AND..NOT.MR1F).OR.
315: & ((M1.EQ.2).AND..NOT.MR2F)) MRBF=1
316: CALL RSPSUB(849+MRBF,DIR)
317: C !DESCRIBE.
318: IF((M1.EQ.1).AND.MROPNF) CALL RSPEAK(823+MRBF)
319: IF(MRBF.NE.0) CALL RSPEAK(851)
320: C
321: 200 I=0
322: C !ASSUME NO MORE TO DO.
323: IF((NT.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.699))) I=852
324: IF((ST.EQ.0).AND.((DIR.EQ.0).OR.(DIR.EQ.695))) I=853
325: IF((NT+ST+DIR).EQ.0) I=854
326: IF(HT.NE.0) CALL RSPEAK(I)
327: C !DESCRIBE HALLS.
328: RETURN
329: C
330: END
331: C EWTELL-- DESCRIBE E/W NARROW ROOMS
332: C
333: C DECLARATIONS
334: C
335: SUBROUTINE EWTELL(RM,ST)
336: IMPLICIT INTEGER(A-Z)
337: LOGICAL M1
338: C
339: C ROOMS
340: #include "rindex.h"
341: #include "flags.h"
342: C EWTELL, PAGE 2
343: C
344: C NOTE THAT WE ARE EAST OR WEST OF MIRROR, AND
345: C MIRROR MUST BE N-S.
346: C
347: M1=(MDIR+(MOD(RM-MRAE,2)*180)).EQ.180
348: I=819+MOD(RM-MRAE,2)
349: C !GET BASIC E/W STRING.
350: IF((M1.AND..NOT.MR1F).OR.(.NOT.M1.AND..NOT.MR2F))
351: & I=I+2
352: CALL RSPEAK(I)
353: IF(M1.AND.MROPNF) CALL RSPEAK(823+((I-819)/2))
354: CALL RSPEAK(825)
355: CALL RSPEAK(ST)
356: RETURN
357: C
358: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.