-
Notifications
You must be signed in to change notification settings - Fork 16
/
desc.zap
316 lines (295 loc) · 6.42 KB
/
desc.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
.SEGMENT "0"
.FUNCT DESCRIBE-ROOM:ANY:0:1,LOOK?,V?,STR,AV
ZERO? LIT \?CND1
PRINTI "It is pitch black."
CRLF
RFALSE
?CND1: IN? HERE,ROOMS \?CND3
HLIGHT H-BOLD
PRINTD HERE
HLIGHT H-NORMAL
?CND3: LOC WINNER >AV
FSET? AV,VEHBIT \?CND5
FSET? AV,SURFACEBIT \?CCL9
PRINTI ", on "
JUMP ?CND7
?CCL9: PRINTI ", in "
?CND7: ICALL2 THE-PRINT,AV
?CND5: CRLF
ZERO? LOOK? /?PRD12
SET 'V?,LOOK?
JUMP ?PEN10
?PRD12: EQUAL? VERBOSITY,2 /?PRD13
PUSH 0
JUMP ?PRD14
?PRD13: PUSH 1
?PRD14: SET 'V?,STACK
?PEN10: FSET? HERE,TOUCHBIT /?CND15
FSET HERE,TOUCHBIT
ZERO? VERBOSITY /?CND15
SET 'V?,TRUE-VALUE
?CND15: SET 'DESCRIBED-ROOM?,V?
ZERO? V? /TRUE
EQUAL? HERE,AV /?CCL23
FSET? AV,VEHBIT \?CCL23
GETP AV,P?ACTION
CALL STACK,M-LOOK
ZERO? STACK \TRUE
?CCL23: GETP HERE,P?ACTION
CALL STACK,M-LOOK
ZERO? STACK \TRUE
GETP HERE,P?LDESC >STR
ZERO? STR /TRUE
PRINT STR
CRLF
RTRUE
.FUNCT DESCRIBE-OBJECTS:ANY:0:0,O,STR,AV,TMP
LOC WINNER >AV
FIRST? HERE >O /?BOGUS1
?BOGUS1: ZERO? O /FALSE
?PRG4: ZERO? O /?REP5
CALL2 DESCRIBABLE?,O
ZERO? STACK /?CND6
FSET? O,TOUCHBIT /?CND6
GETP O,P?FDESC >STR
ZERO? STR /?CND6
ICALL2 THIS-IS-IT,O
CRLF
PRINT STR
FSET? O,CONTBIT \?CND13
ADD D-ALL?,D-PARA?
ICALL DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND13: CRLF
?CND6: NEXT? O >O /?PRG4
JUMP ?PRG4
?REP5: FIRST? HERE >O /?PRG17
?PRG17: ZERO? O /?REP18
CALL2 DESCRIBABLE?,O
ZERO? STACK /?CND19
GETP O,P?FDESC
ZERO? STACK /?CCL23
FSET? O,TOUCHBIT \?CND19
?CCL23: GETP O,P?DESCFCN >STR
ZERO? STR /?CCL29
CALL STR,M-OBJDESC?,O >TMP
ZERO? TMP /?CCL29
EQUAL? TMP,M-FATAL /?CND19
ICALL2 THIS-IS-IT,O
CRLF
CALL STR,M-OBJDESC,O >STR
ZERO? STR /?CND34
FSET? O,CONTBIT \?CND34
EQUAL? STR,M-FATAL /?CND34
ADD D-ALL?,D-PARA?
ICALL DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND34: CRLF
JUMP ?CND19
?CCL29: GETP O,P?LDESC >STR
ZERO? STR /?CND19
ICALL2 THIS-IS-IT,O
CRLF
PRINT STR
FSET? O,CONTBIT \?CND41
ADD D-ALL?,D-PARA?
ICALL DESCRIBE-CONTENTS,O,TRUE-VALUE,STACK
?CND41: CRLF
?CND19: NEXT? O >O /?PRG17
JUMP ?PRG17
?REP18: SUB 0,PERSON >D-BIT
ICALL DESCRIBE-CONTENTS,HERE,FALSE-VALUE,FALSE-VALUE
SET 'D-BIT,PERSON
ICALL DESCRIBE-CONTENTS,HERE,FALSE-VALUE,FALSE-VALUE
SET 'D-BIT,FALSE-VALUE
ZERO? AV /FALSE
EQUAL? HERE,AV /FALSE
CALL DESCRIBE-CONTENTS,AV,FALSE-VALUE,FALSE-VALUE
RSTACK
.FUNCT DESCRIBE-CONTENTS:ANY:1:3,OBJ,LEVEL,ALL?,F,N,1ST?,IT?,TWO?,START?,PARA?,DB
ASSIGNED? 'LEVEL /?CND1
SET 'LEVEL,-1
?CND1: ASSIGNED? 'ALL? /?CND3
SET 'ALL?,D-ALL?
?CND3: SET '1ST?,TRUE-VALUE
EQUAL? LEVEL,2 \?CCL7
SET 'LEVEL,TRUE-VALUE
SET 'PARA?,TRUE-VALUE
SET 'START?,TRUE-VALUE
JUMP ?CND5
?CCL7: BTST ALL?,D-PARA? \?CND5
SET 'PARA?,TRUE-VALUE
?CND5: FIRST? OBJ >N /?BOGUS9
?BOGUS9: ZERO? START? \?PRG25
IN? OBJ,ROOMS /?PRG25
FSET? OBJ,PERSON /?PRG25
ZERO? N /FALSE
FSET? OBJ,CONTBIT \FALSE
FSET? OBJ,OPENBIT /?PRD20
FSET? OBJ,TRANSBIT \FALSE
?PRD20: EQUAL? LEVEL,-1 /?PRG25
FSET? OBJ,SEARCHBIT \FALSE
?PRG25: ZERO? N /?CCL28
CALL2 DESCRIBABLE?,N
ZERO? STACK /?CND27
BTST ALL?,D-ALL? /?CCL28
CALL2 SIMPLE-DESC?,N
ZERO? STACK /?CND27
?CCL28: ZERO? F /?CND35
ZERO? 1ST? /?CCL39
SET '1ST?,FALSE-VALUE
EQUAL? LEVEL,FALSE-VALUE,TRUE-VALUE \?CCL42
ZERO? START? \?CND37
ZERO? PARA? \?CCL47
SET 'PARA?,TRUE-VALUE
CRLF
JUMP ?CND45
?CCL47: EQUAL? LEVEL,TRUE-VALUE \?CND45
PRINTC 11
?CND45: FSET? F,PLURAL \?CCL51
PUSH TRUE-VALUE
JUMP ?CND49
?CCL51: PUSH N
?CND49: ICALL DESCRIBE-START,OBJ,STACK
JUMP ?CND37
?CCL42: EQUAL? LEVEL,-1 /?CND37
PRINT LEVEL
JUMP ?CND37
?CCL39: ZERO? N /?CCL54
PRINTI ", "
JUMP ?CND37
?CCL54: PRINTI " and "
?CND37: ICALL2 PRINTA,F
ICALL2 DESCRIBE-SPECIAL,F
ZERO? IT? \?CCL57
ZERO? TWO? \?CCL57
SET 'IT?,F
JUMP ?CND35
?CCL57: SET 'TWO?,TRUE-VALUE
SET 'IT?,FALSE-VALUE
?CND35: SET 'F,N
?CND27: ZERO? N /?CND60
NEXT? N >N /?CND60
?CND60: ZERO? F \?PRG25
ZERO? N \?PRG25
ZERO? IT? /?CND67
ZERO? TWO? \?CND67
ICALL2 THIS-IS-IT,IT?
?CND67: ZERO? 1ST? /?CCL73
ZERO? START? /?CCL73
PRINTI " nothing"
RFALSE
?CCL73: ZERO? 1ST? \?REP26
EQUAL? LEVEL,FALSE-VALUE,TRUE-VALUE \?REP26
EQUAL? OBJ,HERE \?CND79
PRINTI " here"
?CND79: PRINTC 46
?REP26: EQUAL? LEVEL,FALSE-VALUE,TRUE-VALUE \?CND81
FIRST? OBJ >F /?PRG84
?PRG84: ZERO? F /?CND81
FSET? F,CONTBIT /?PRD91
EQUAL? F,HERE \?CND86
?PRD91: CALL DESCRIBABLE?,F,TRUE-VALUE
ZERO? STACK /?CND86
BTST ALL?,D-ALL? /?CCL89
CALL2 SIMPLE-DESC?,F
ZERO? STACK /?CND86
?CCL89: SET 'DB,D-BIT
SET 'D-BIT,FALSE-VALUE
ZERO? PARA? /?CCL101
PUSH 3
JUMP ?CND99
?CCL101: PUSH D-ALL?
?CND99: CALL DESCRIBE-CONTENTS,F,TRUE-VALUE,STACK
ZERO? STACK /?CND97
SET '1ST?,FALSE-VALUE
SET 'PARA?,TRUE-VALUE
?CND97: SET 'D-BIT,DB
?CND86: NEXT? F >F /?PRG84
JUMP ?PRG84
?CND81: ZERO? 1ST? \?CND103
EQUAL? LEVEL,FALSE-VALUE,TRUE-VALUE \?CND103
LOC WINNER
EQUAL? OBJ,HERE,STACK \?CND103
CRLF
?CND103: ZERO? 1ST? /TRUE
RFALSE
.FUNCT DESCRIBE-START:ANY:2:2,OBJ,N
EQUAL? OBJ,HERE \?CCL3
EQUAL? D-BIT,PERSON \?CCL6
PRINTI "You see "
RTRUE
?CCL6: PRINTI "There "
ZERO? N /?CCL9
PRINTI "are "
RTRUE
?CCL9: PRINTI "is "
RTRUE
?CCL3: EQUAL? OBJ,PLAYER \?CCL11
EQUAL? D-BIT,WEARBIT \?CCL14
PRINTI " You are wearing "
RTRUE
?CCL14: PRINTI "You are carrying "
RTRUE
?CCL11: FSET? OBJ,PERSON \?CCL16
ICALL2 CTHE-PRINT,OBJ
PRINTI " has "
RTRUE
?CCL16: FSET? OBJ,SURFACEBIT \?CCL18
EQUAL? OBJ,LADDER \?CCL21
PRINTI "Stand"
JUMP ?CND19
?CCL21: PRINTI "Sitt"
?CND19: PRINTI "ing on "
ICALL2 THE-PRINT,OBJ
ZERO? N /?CCL24
PRINTI " are "
RTRUE
?CCL24: PRINTI " is "
RTRUE
?CCL18: ICALL2 CTHE-PRINT,OBJ
PRINTI " contains "
RTRUE
.FUNCT DESCRIBE-SPECIAL:ANY:1:1,OBJ
FSET? OBJ,ONBIT \FALSE
PRINTI " (providing light)"
RTRUE
.FUNCT DESCRIBABLE?:ANY:1:2,OBJ,CONT?
FSET? OBJ,INVISIBLE /FALSE
EQUAL? OBJ,WINNER /FALSE
LOC WINNER
EQUAL? OBJ,STACK \?CCL7
LOC WINNER
EQUAL? HERE,STACK \FALSE
?CCL7: ZERO? CONT? \?CCL11
FSET? OBJ,NDESCBIT /FALSE
?CCL11: ZERO? D-BIT /TRUE
GRTR? D-BIT,0 \?CCL18
FSET? OBJ,D-BIT /TRUE
RFALSE
?CCL18: SUB 0,D-BIT
FSET? OBJ,STACK /FALSE
RTRUE
.FUNCT SIMPLE-DESC?:ANY:1:1,OBJ,STR
GETP OBJ,P?FDESC
ZERO? STACK /?CCL3
FSET? OBJ,TOUCHBIT \FALSE
?CCL3: GETP OBJ,P?DESCFCN >STR
ZERO? STR /?CCL7
CALL STR,M-OBJDESC?,OBJ
ZERO? STACK \FALSE
?CCL7: GETP OBJ,P?LDESC
ZERO? STACK /TRUE
RFALSE
.FUNCT DESCRIBE-REST:ANY:1:1,OBJ
CALL2 DESCRIBE-CONTENTS,OBJ
ZERO? STACK \TRUE
PRINTI "nothing"
RTRUE
.FUNCT DESCRIBE-SENT:ANY:1:1,OBJ
CALL DESCRIBE-CONTENTS,OBJ,FALSE-VALUE,3
ZERO? STACK \TRUE
PRINTI "The "
ICALL2 DPRINT,OBJ
PRINTI " is empty."
RTRUE
.ENDSEG
.ENDI