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