-
Notifications
You must be signed in to change notification settings - Fork 10
/
Copy pathmisc.zap
318 lines (298 loc) · 6.16 KB
/
misc.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
310
311
312
313
314
315
316
317
318
.FUNCT RANDOM-ELEMENT,FROB
GET FROB,0
RANDOM STACK
GET FROB,STACK
RSTACK
.FUNCT PICK-ONE,FROB,L,CNT,RND,MSG,RFROB
GET FROB,0 >L
GET FROB,1 >CNT
DEC 'L
ADD FROB,2 >FROB
MUL CNT,2
ADD FROB,STACK >RFROB
SUB L,CNT
RANDOM STACK >RND
GET RFROB,RND >MSG
GET RFROB,1
PUT RFROB,RND,STACK
PUT RFROB,1,MSG
INC 'CNT
EQUAL? CNT,L \?CND1
SET 'CNT,0
?CND1: PUT FROB,0,CNT
RETURN MSG
.FUNCT GO
START::
?FCN: PUTB P-LEXV,0,59
CALL QUEUE,I-WIZARD,4
PUT STACK,0,1
CALL QUEUE,I-LANTERN,200
PUTP BALLOON,P?VTYPE,NONLANDBIT
PUTP BUCKET,P?VTYPE,NONLANDBIT
SET 'LIT,TRUE-VALUE
SET 'WINNER,ADVENTURER
SET 'HERE,INSIDE-THE-BARROW
SET 'P-IT-OBJECT,FALSE-VALUE
FSET? HERE,TOUCHBIT /?CND1
CALL V-VERSION
CRLF
?CND1: CALL V-LOOK
CALL MAIN-LOOP
JUMP ?FCN
.FUNCT MAIN-LOOP,TRASH
?PRG1: CALL MAIN-LOOP-1 >TRASH
JUMP ?PRG1
.FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,O,I
SET 'CNT,0
SET 'OBJ,FALSE-VALUE
SET 'PTBL,TRUE-VALUE
CALL PARSER >P-WON
ZERO? P-WON /?CCL3
GET P-PRSI,P-MATCHLEN >ICNT
GET P-PRSO,P-MATCHLEN >OCNT
ZERO? P-IT-OBJECT /?CND4
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK /?CND4
SET 'TMP,FALSE-VALUE
?PRG8: IGRTR? 'CNT,ICNT /?REP9
GET P-PRSI,CNT
EQUAL? STACK,IT \?PRG8
PUT P-PRSI,CNT,P-IT-OBJECT
SET 'TMP,TRUE-VALUE
?REP9: ZERO? TMP \?CND15
SET 'CNT,0
?PRG17: IGRTR? 'CNT,OCNT /?CND15
GET P-PRSO,CNT
EQUAL? STACK,IT \?PRG17
PUT P-PRSO,CNT,P-IT-OBJECT
?CND15: SET 'CNT,0
?CND4: ZERO? OCNT \?CCL26
SET 'NUM,OCNT
JUMP ?CND24
?CCL26: GRTR? OCNT,1 \?CCL28
SET 'TBL,P-PRSO
ZERO? ICNT \?CCL31
SET 'OBJ,FALSE-VALUE
JUMP ?CND29
?CCL31: GET P-PRSI,1 >OBJ
?CND29: SET 'NUM,OCNT
JUMP ?CND24
?CCL28: GRTR? ICNT,1 \?CCL33
SET 'PTBL,FALSE-VALUE
SET 'TBL,P-PRSI
GET P-PRSO,1 >OBJ
SET 'NUM,ICNT
JUMP ?CND24
?CCL33: SET 'NUM,1
?CND24: ZERO? OBJ \?CND34
EQUAL? ICNT,1 \?CND34
GET P-PRSI,1 >OBJ
?CND34: EQUAL? PRSA,V?WALK \?CCL40
ZERO? P-WALK-DIR /?CCL40
CALL PERFORM,PRSA,PRSO >V
JUMP ?CND38
?CCL40: ZERO? NUM \?CCL44
GETB P-SYNTAX,P-SPREP1
DIV STACK,64
ZERO? STACK \?CCL47
CALL PERFORM,PRSA >V
SET 'PRSO,FALSE-VALUE
JUMP ?CND38
?CCL47: ZERO? LIT \?PRG52
PRINT TOO-DARK
CRLF
JUMP ?CND38
?PRG52: PRINT REFERRING
SET 'V,FALSE-VALUE
JUMP ?CND38
?CCL44: SET 'P-NOT-HERE,0
SET 'P-MULT,FALSE-VALUE
GRTR? NUM,1 \?CND54
SET 'P-MULT,TRUE-VALUE
?CND54: SET 'TMP,FALSE-VALUE
?PRG56: IGRTR? 'CNT,NUM \?CCL60
GRTR? P-NOT-HERE,0 \?CCL63
PRINTI "The "
EQUAL? P-NOT-HERE,NUM /?PRG70
PRINTI "other "
?PRG70: PRINTI "object"
EQUAL? P-NOT-HERE,1 /?PRG76
PRINTC 115
?PRG76: PRINTI " that you mentioned "
EQUAL? P-NOT-HERE,1 /?PRG83
PRINTI "are"
JUMP ?PRG85
?PRG83: PRINTI "is"
?PRG85: PRINTI "n't here."
CRLF
JUMP ?CND38
?CCL63: ZERO? TMP \?CND38
PRINTI "There's nothing here you can take."
CRLF
JUMP ?CND38
?CCL60: ZERO? PTBL /?CCL92
GET P-PRSO,CNT >OBJ1
JUMP ?CND90
?CCL92: GET P-PRSI,CNT >OBJ1
?CND90: ZERO? PTBL /?CCL95
SET 'O,OBJ1
JUMP ?CND93
?CCL95: SET 'O,OBJ
?CND93: ZERO? PTBL /?CCL98
SET 'I,OBJ
JUMP ?CND96
?CCL98: SET 'I,OBJ1
?CND96: GRTR? NUM,1 /?CCL100
GET P-ITBL,P-NC1
GET STACK,0
EQUAL? STACK,W?ALL \?CND99
?CCL100: LOC WINNER >V
EQUAL? O,NOT-HERE-OBJECT \?CCL105
INC 'P-NOT-HERE
JUMP ?PRG56
?CCL105: EQUAL? PRSA,V?TAKE \?CCL107
ZERO? I /?CCL107
GET P-ITBL,P-NC1
GET STACK,0
EQUAL? STACK,W?ALL \?CCL107
IN? O,I \?PRG56
?CCL107: EQUAL? P-GETFLAGS,P-ALL \?CCL113
EQUAL? PRSA,V?TAKE \?CCL113
LOC O
EQUAL? STACK,WINNER,HERE,V /?PRD118
LOC O
EQUAL? STACK,I /?PRD118
LOC O
FSET? STACK,SURFACEBIT \?PRG56
?PRD118: FSET? O,TAKEBIT /?CCL113
FSET? O,TRYTAKEBIT \?PRG56
?CCL113: EQUAL? OBJ1,IT \?CCL126
PRINTD P-IT-OBJECT
JUMP ?PRG127
?CCL126: PRINTD OBJ1
?PRG127: PRINTI ": "
?CND99: SET 'PRSO,O
SET 'PRSI,I
SET 'TMP,TRUE-VALUE
CALL PERFORM,PRSA,PRSO,PRSI >V
EQUAL? V,M-FATAL \?PRG56
?CND38: EQUAL? V,M-FATAL /?CND131
LOC WINNER
GETP STACK,P?ACTION
CALL STACK,M-END >V
?CND131: EQUAL? V,M-FATAL \?CND1
SET 'P-CONT,FALSE-VALUE
JUMP ?CND1
?CCL3: SET 'P-CONT,FALSE-VALUE
?CND1: ZERO? P-WON /FALSE
EQUAL? PRSA,V?SUPER-BRIEF,V?BRIEF,V?TELL /TRUE
EQUAL? PRSA,V?VERSION,V?SAVE,V?VERBOSE /TRUE
EQUAL? PRSA,V?SCORE,V?RESTART,V?QUIT /TRUE
EQUAL? PRSA,V?RESTORE,V?UNSCRIPT,V?SCRIPT /TRUE
CALL CLOCKER >V
RETURN V
.FUNCT PERFORM,A,O=0,I=0,V,OA,OO,OI
SET 'OA,PRSA
SET 'OO,PRSO
SET 'OI,PRSI
EQUAL? IT,I,O \?CND1
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK \?CND1
PRINT REFERRING
RETURN 2
?CND1: EQUAL? O,IT \?CND9
SET 'O,P-IT-OBJECT
?CND9: EQUAL? I,IT \?CND11
SET 'I,P-IT-OBJECT
?CND11: SET 'PRSA,A
SET 'PRSO,O
ZERO? PRSO /?CND13
EQUAL? PRSI,IT /?CND13
EQUAL? PRSA,V?WALK /?CND13
SET 'P-IT-OBJECT,PRSO
?CND13: SET 'PRSI,I
EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CCL20
CALL NOT-HERE-OBJECT-F >V
ZERO? V \?CND18
?CCL20: SET 'O,PRSO
SET 'I,PRSI
GETP WINNER,P?ACTION
CALL STACK >V
ZERO? V \?CND18
LOC WINNER
GETP STACK,P?ACTION
CALL STACK,M-BEG >V
ZERO? V \?CND18
GET PREACTIONS,A
CALL STACK >V
ZERO? V \?CND18
ZERO? I /?CCL31
GETP I,P?ACTION
CALL STACK >V
ZERO? V \?CND18
?CCL31: ZERO? O /?CCL35
EQUAL? A,V?WALK /?CCL35
LOC O
ZERO? STACK /?CCL35
LOC O
GETP STACK,P?CONTFCN
CALL STACK >V
ZERO? V \?CND18
?CCL35: ZERO? O /?CCL41
EQUAL? A,V?WALK /?CCL41
GETP O,P?ACTION
CALL STACK >V
ZERO? V \?CND18
?CCL41: GET ACTIONS,A
CALL STACK >V
ZERO? V /?CND18
?CND18: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
RETURN V
.FUNCT QUEUE,RTN,TICK,CINT
CALL INT,RTN >CINT
PUT CINT,C-TICK,TICK
RETURN CINT
.FUNCT INT,RTN,DEMON=0,E,C,INT
ADD C-TABLE,C-TABLELEN >E
ADD C-TABLE,C-INTS >C
?PRG1: EQUAL? C,E \?CCL5
SUB C-INTS,C-INTLEN >C-INTS
ZERO? DEMON /?PEN6
SUB C-DEMONS,C-INTLEN >C-DEMONS
?PEN6: ADD C-TABLE,C-INTS >INT
PUT INT,C-RTN,RTN
RETURN INT
?CCL5: GET C,C-RTN
EQUAL? STACK,RTN \?CND3
RETURN C
?CND3: ADD C,C-INTLEN >C
JUMP ?PRG1
.FUNCT CLOCKER,C,E,TICK,FLG=0
ZERO? CLOCK-WAIT /?CND1
SET 'CLOCK-WAIT,FALSE-VALUE
RFALSE
?CND1: ZERO? P-WON /?CCL5
PUSH C-INTS
JUMP ?CND3
?CCL5: PUSH C-DEMONS
?CND3: ADD C-TABLE,STACK >C
ADD C-TABLE,C-TABLELEN >E
?PRG6: EQUAL? C,E \?CCL10
INC 'MOVES
RETURN FLG
?CCL10: GET C,C-ENABLED?
ZERO? STACK /?CND8
GET C,C-TICK >TICK
ZERO? TICK /?CND8
SUB TICK,1
PUT C,C-TICK,STACK
GRTR? TICK,1 /?CND8
GET C,C-RTN
CALL STACK
ZERO? STACK /?CND8
SET 'FLG,TRUE-VALUE
?CND8: ADD C,C-INTLEN >C
JUMP ?PRG6
.ENDI