-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathglobals.zap
309 lines (264 loc) · 6.14 KB
/
globals.zap
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
.FUNCT NOT-HERE-OBJECT-F,TBL,PRSO?=1,OBJ
EQUAL? PRSO,NOT-HERE-OBJECT \?CCL3
EQUAL? PRSI,NOT-HERE-OBJECT \?CCL3
PRINTR "Those things aren't here!"
?CCL3: EQUAL? PRSO,NOT-HERE-OBJECT \?CCL9
SET 'TBL,P-PRSO
JUMP ?CND1
?CCL9: SET 'TBL,P-PRSI
SET 'PRSO?,FALSE-VALUE
?CND1: SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
EQUAL? WINNER,ADVENTURER \?PRG17
PRINTI "You can't see any "
CALL NOT-HERE-PRINT,PRSO?
PRINTR " here!"
?PRG17: PRINTI "The "
PRINTD WINNER
PRINTI " seems confused. ""I don't see any "
CALL NOT-HERE-PRINT,PRSO?
PRINTR " here!"""
.FUNCT NOT-HERE-PRINT,PRSO?,?TMP1
ZERO? P-OFLAG /?CCL3
ZERO? P-XADJ /?CND4
PRINTB P-XADJN
?CND4: ZERO? P-XNAM /FALSE
PRINTB P-XNAM
RTRUE
?CCL3: ZERO? PRSO? /?CCL10
GET P-ITBL,P-NC1 >?TMP1
GET P-ITBL,P-NC1L
CALL BUFFER-PRINT,?TMP1,STACK,FALSE-VALUE
RSTACK
?CCL10: GET P-ITBL,P-NC2 >?TMP1
GET P-ITBL,P-NC2L
CALL BUFFER-PRINT,?TMP1,STACK,FALSE-VALUE
RSTACK
.FUNCT GROUND-F
EQUAL? PRSA,V?PUT-ON,V?PUT \FALSE
EQUAL? PRSI,GROUND \FALSE
CALL PERFORM,V?DROP,PRSO
RTRUE
.FUNCT WATER-F,AV,W,PI?
EQUAL? PRSA,V?SGIVE /FALSE
EQUAL? PRSA,V?ENTER \?CCL5
CALL PERFORM,V?SWIM,PRSO
RTRUE
?CCL5: EQUAL? PRSA,V?FILL \?CCL7
SET 'W,PRSI
SET 'PRSA,V?PUT
SET 'PRSI,PRSO
SET 'PRSO,W
SET 'PI?,FALSE-VALUE
JUMP ?CND1
?CCL7: EQUAL? PRSO,GLOBAL-WATER,WATER \?CCL9
SET 'W,PRSO
SET 'PI?,FALSE-VALUE
JUMP ?CND1
?CCL9: ZERO? PRSI /?CND1
SET 'W,PRSI
SET 'PI?,TRUE-VALUE
?CND1: EQUAL? W,GLOBAL-WATER \?CND11
SET 'W,WATER
EQUAL? PRSA,V?PUT,V?TAKE \?CND11
REMOVE W
?CND11: ZERO? PI? /?CCL17
SET 'PRSI,W
JUMP ?CND15
?CCL17: SET 'PRSO,W
?CND15: LOC WINNER >AV
FSET? AV,VEHBIT /?CND18
SET 'AV,FALSE-VALUE
?CND18: EQUAL? PRSA,V?PUT,V?TAKE \?CCL22
ZERO? PI? \?CCL22
ZERO? AV /?CCL27
EQUAL? AV,PRSI \?CCL27
CALL PUDDLE,AV
RSTACK
?CCL27: ZERO? AV /?CCL31
ZERO? PRSI \?CCL31
IN? W,AV /?CCL31
CALL PUDDLE,AV
RSTACK
?CCL31: ZERO? PRSI /?CCL36
EQUAL? PRSI,TEAPOT /?CCL36
PRINTI "The water leaks out of the "
PRINTD PRSI
PRINTI " and evaporates immediately."
CRLF
REMOVE W
RTRUE
?CCL36: IN? TEAPOT,WINNER \?CCL42
FIRST? TEAPOT /?PRG48
MOVE WATER,TEAPOT
PRINTR "The teapot is now full of water."
?PRG48: PRINTR "The teapot isn't currently empty."
?CCL42: IN? PRSO,TEAPOT \?PRG55
EQUAL? PRSA,V?TAKE \?PRG55
ZERO? PRSI \?PRG55
SET 'PRSO,TEAPOT
CALL ITAKE
SET 'PRSO,W
RETURN PRSO
?PRG55: PRINTR "The water slips through your fingers."
?CCL22: ZERO? PI? /?CCL58
PRINTR "Nice try."
?CCL58: EQUAL? PRSA,V?GIVE,V?DROP \?CCL62
EQUAL? PRSO,WATER \?CND63
CALL HELD?,WATER
ZERO? STACK \?CND63
PRINTR "You don't have any water."
?CND63: REMOVE WATER
ZERO? AV /?PRG72
CALL PUDDLE,AV
RSTACK
?PRG72: PRINTI "The water spills to the floor and evaporates."
CRLF
REMOVE WATER
RTRUE
?CCL62: EQUAL? PRSA,V?THROW \FALSE
PRINTI "The water splashes on the walls and evaporates."
CRLF
REMOVE WATER
RTRUE
.FUNCT PUDDLE,AV
PRINTI "There is now a puddle in the bottom of the "
PRINTD AV
PRINT PERIOD-CR
MOVE PRSO,AV
RTRUE
.FUNCT GRUE-F
EQUAL? PRSA,V?EXAMINE \?CCL3
PRINTR "The grue is a sinister, lurking presence in the dark places of the earth. Its favorite diet is adventurers, but its insatiable appetite is tempered by its fear of light."
?CCL3: EQUAL? PRSA,V?FIND \FALSE
PRINTR "There's probably one lurking in the darkness nearby. Don't let your light go out!"
.FUNCT ME-F
EQUAL? PRSA,V?TELL \?CCL3
SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
PRINTR "Talking to yourself is a sign of impending mental collapse."
?CCL3: EQUAL? PRSA,V?GIVE \?CCL7
EQUAL? PRSI,ME \?CCL7
CALL PERFORM,V?TAKE,PRSO
RTRUE
?CCL7: EQUAL? PRSA,V?EAT \?CCL11
PRINTR "Auto-cannibalism is not the answer."
?CCL11: EQUAL? PRSA,V?MUNG,V?ATTACK \?CCL15
CALL JIGS-UP,STR?22
RSTACK
?CCL15: EQUAL? PRSA,V?TAKE \?CCL17
PRINTR "How romantic!"
?CCL17: EQUAL? PRSA,V?EXAMINE \FALSE
PRINTR "Difficult, unless your eyes are prehensile."
.FUNCT PATH-OBJECT-F
EQUAL? PRSA,V?FOLLOW,V?TAKE \FALSE
CALL V-WALK-AROUND
RSTACK
.FUNCT ZORKMID-F
EQUAL? PRSA,V?EXAMINE \FALSE
PRINTI "The zorkmid is the unit of currency of"
PRINT GUE-NAME
PRINT PERIOD-CR
RTRUE
.FUNCT STREAM-F
EQUAL? PRSA,V?ENTER \FALSE
CALL V-SWIM
RSTACK
.FUNCT CHASM-F
EQUAL? PRSA,V?LEAP /?CTR2
EQUAL? PRSA,V?PUT \?CCL3
EQUAL? PRSO,ME \?CCL3
?CTR2: CALL JIGS-UP,STR?7
RSTACK
?CCL3: EQUAL? PRSA,V?PUT \FALSE
EQUAL? PRSI,PSEUDO-OBJECT \FALSE
REMOVE PRSO
PRINTI "The "
PRINTD PRSO
PRINTR " disappears into the chasm."
.FUNCT BRIDGE-F
EQUAL? PRSA,V?LEAP \FALSE
CALL JIGS-UP,STR?7
RSTACK
.FUNCT OPEN-CLOSE
EQUAL? PRSA,V?OPEN \?CCL3
FSET? PRSO,OPENBIT \?CCL6
PRINT LOOK-AROUND
RTRUE
?CCL6: FSET PRSO,OPENBIT
PRINTI "The "
PRINTD PRSO
PRINTR " is now open."
?CCL3: FSET? PRSO,OPENBIT \?PRG15
FCLEAR PRSO,OPENBIT
PRINTI "The "
PRINTD PRSO
PRINTR " is now closed."
?PRG15: PRINT LOOK-AROUND
RTRUE
.FUNCT HELLO?,WHO
EQUAL? WINNER,WHO /?CCL3
EQUAL? PRSA,V?HELLO,V?SAY,V?TELL /?CCL3
EQUAL? PRSA,V?INCANT \FALSE
?CCL3: EQUAL? PRSA,V?INCANT,V?SAY,V?TELL \TRUE
SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
RTRUE
.FUNCT FIND-TARGET,TARGET,P,TX,L,ROOM
IN? TARGET,HERE \?CCL3
RETURN HERE
?CCL3: SET 'P,0
?PRG4: NEXTP HERE,P >P
ZERO? P /FALSE
LESS? P,LOW-DIRECTION /?PRG4
GETPT HERE,P >TX
PTSIZE TX >L
EQUAL? L,UEXIT,CEXIT,DEXIT \?PRG4
GETB TX,0 >ROOM
IN? TARGET,ROOM \?PRG4
RETURN ROOM
.FUNCT NOW-DARK?
CALL LIT?,HERE >LIT
ZERO? LIT \TRUE
PRINTR "It is now pitch black."
.FUNCT DO-WALK,DIR
SET 'P-WALK-DIR,DIR
CALL PERFORM,V?WALK,DIR
RSTACK
.FUNCT GLOBAL-IN?,OBJ1,OBJ2,TX
GETPT OBJ2,P?GLOBAL >TX
ZERO? TX /FALSE
PTSIZE TX
SUB STACK,1
CALL ZMEMQB,OBJ1,TX,STACK
RSTACK
.FUNCT FIND-IN,WHERE,WHAT,W
FIRST? WHERE >W /?BOGUS1
?BOGUS1: ZERO? W /FALSE
?PRG4: FSET? W,WHAT \?CCL8
EQUAL? W,ADVENTURER /?CCL8
RETURN W
?CCL8: NEXT? W >W /?PRG4
RFALSE
.FUNCT HELD?,CAN
?PRG1: LOC CAN >CAN
ZERO? CAN /FALSE
EQUAL? CAN,WINNER \?PRG1
RTRUE
.FUNCT OTHER-SIDE,DOBJ,P=0,TX
?PRG1: NEXTP HERE,P >P
LESS? P,LOW-DIRECTION /FALSE
GETPT HERE,P >TX
PTSIZE TX
EQUAL? STACK,DEXIT \?PRG1
GETB TX,DEXITOBJ
EQUAL? STACK,DOBJ \?PRG1
RETURN P
.FUNCT HACK-HACK,STR
PRINT STR
PRINTD PRSO
CALL PICK-ONE,HO-HUM
PRINT STACK
CRLF
RTRUE
.ENDI