]> github.com/historicalsource and other repositories - zork2.git/blob - gmain.zil
Extensions on Z-Machine Fixed.
[zork2.git] / gmain.zil
1                         "Generic MAIN file for
2                             The ZORK Trilogy
3                        started on 7/28/83 by MARC"
4
5 <CONSTANT SERIAL 0>
6
7 <GLOBAL PLAYER <>>
8
9 <GLOBAL P-WON <>>
10
11 <CONSTANT M-FATAL 2>
12  
13 <CONSTANT M-HANDLED 1>   
14  
15 <CONSTANT M-NOT-HANDLED <>>   
16  
17 <CONSTANT M-OBJECT <>>
18
19 <CONSTANT M-BEG 1>  
20  
21 <CONSTANT M-END 6> 
22  
23 <CONSTANT M-ENTER 2>
24  
25 <CONSTANT M-LOOK 3> 
26  
27 <CONSTANT M-FLASH 4>
28
29 <CONSTANT M-OBJDESC 5>
30
31 ;"GO now lives in SPECIAL.ZIL"    
32
33 \f
34 <ROUTINE MAIN-LOOP ("AUX" TRASH)
35          <REPEAT ()
36                  <SET TRASH <MAIN-LOOP-1>>>>
37
38 <ROUTINE MAIN-LOOP-1 ("AUX" ICNT OCNT NUM CNT OBJ TBL V PTBL OBJ1 TMP O I) 
39      <SET CNT 0>
40      <SET OBJ <>>
41      <SET PTBL T>
42      <COND (<SETG P-WON <PARSER>>
43             <SET ICNT <GET ,P-PRSI ,P-MATCHLEN>>
44             <SET OCNT <GET ,P-PRSO ,P-MATCHLEN>>
45             <COND (<AND ,P-IT-OBJECT <ACCESSIBLE? ,P-IT-OBJECT>>
46                    <SET TMP <>>
47                    <REPEAT ()
48                            <COND (<G? <SET CNT <+ .CNT 1>> .ICNT>
49                                   <RETURN>)
50                                  (T
51                                   <COND (<EQUAL? <GET ,P-PRSI .CNT> ,IT>
52                                          <PUT ,P-PRSI .CNT ,P-IT-OBJECT>
53                                          <SET TMP T>
54                                          <RETURN>)>)>>
55                    <COND (<NOT .TMP>
56                           <SET CNT 0>
57                           <REPEAT ()
58                            <COND (<G? <SET CNT <+ .CNT 1>> .OCNT>
59                                   <RETURN>)
60                                  (T
61                                   <COND (<EQUAL? <GET ,P-PRSO .CNT> ,IT>
62                                          <PUT ,P-PRSO .CNT ,P-IT-OBJECT>
63                                          <RETURN>)>)>>)>
64                    <SET CNT 0>)>
65             <SET NUM
66                  <COND (<0? .OCNT> .OCNT)
67                        (<G? .OCNT 1>
68                         <SET TBL ,P-PRSO>
69                         <COND (<0? .ICNT> <SET OBJ <>>)
70                               (T <SET OBJ <GET ,P-PRSI 1>>)>
71                         .OCNT)
72                        (<G? .ICNT 1>
73                         <SET PTBL <>>
74                         <SET TBL ,P-PRSI>
75                         <SET OBJ <GET ,P-PRSO 1>>
76                         .ICNT)
77                        (T 1)>>
78             <COND (<AND <NOT .OBJ> <1? .ICNT>> <SET OBJ <GET ,P-PRSI 1>>)>
79             <COND (<AND <==? ,PRSA ,V?WALK>
80                         <NOT <ZERO? ,P-WALK-DIR>>>
81                    <SET V <PERFORM ,PRSA ,PRSO>>)
82                   (<0? .NUM>
83                    <COND (<0? <BAND <GETB ,P-SYNTAX ,P-SBITS> ,P-SONUMS>>
84                           <SET V <PERFORM ,PRSA>>
85                           <SETG PRSO <>>)
86                          (<NOT ,LIT>
87                           <TELL "It's too dark to see." CR>)
88                          (T
89                           <TELL "It's not clear what you're referring to." CR>
90                           <SET V <>>)>)
91                   (T
92                    <SETG P-NOT-HERE 0>
93                    <SETG P-MULT <>>
94                    <COND (<G? .NUM 1> <SETG P-MULT T>)>
95                    <SET TMP <>>
96                    <REPEAT ()
97                            <COND (<G? <SET CNT <+ .CNT 1>> .NUM>
98                                   <COND (<G? ,P-NOT-HERE 0>
99                                          <TELL "The ">
100                                          <COND (<NOT <EQUAL? ,P-NOT-HERE .NUM>>
101                                                 <TELL "other ">)>
102                                          <TELL "object">
103                                          <COND (<NOT <EQUAL? ,P-NOT-HERE 1>>
104                                                 <TELL "s">)>
105                                          <TELL " that you mentioned ">
106                                          <COND (<NOT <EQUAL? ,P-NOT-HERE 1>>
107                                                 <TELL "are">)
108                                                (T <TELL "is">)>
109                                          <TELL "n't here." CR>)
110                                         (<NOT .TMP>
111                                          <TELL
112 "There's nothing here you can take." CR>)>
113                                   <RETURN>)
114                                  (T
115                                   <COND (.PTBL <SET OBJ1 <GET ,P-PRSO .CNT>>)
116                                         (T <SET OBJ1 <GET ,P-PRSI .CNT>>)>
117                                   <SET O <COND (.PTBL .OBJ1) (T .OBJ)>>
118                                   <SET I <COND (.PTBL .OBJ) (T .OBJ1)>>
119
120 ;"multiple exceptions"
121 <COND (<OR <G? .NUM 1>
122            <EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0> ,W?ALL>>
123        <SET V <LOC ,WINNER>>
124        <COND (<EQUAL? .O ,NOT-HERE-OBJECT>
125               <SETG P-NOT-HERE <+ ,P-NOT-HERE 1>>
126               <AGAIN>)
127              (<AND <VERB? TAKE>
128                    .I
129                    <EQUAL? <GET <GET ,P-ITBL ,P-NC1> 0> ,W?ALL>
130                    <NOT <IN? .O .I>>>
131               <AGAIN>)
132              (<AND <EQUAL? ,P-GETFLAGS ,P-ALL>
133                    <VERB? TAKE>
134                    <OR <AND <NOT <EQUAL? <LOC .O> ,WINNER ,HERE .V>>
135                             <NOT <EQUAL? <LOC .O> .I>>
136                             <NOT <FSET? <LOC .O> ,SURFACEBIT>>>
137                        <NOT <OR <FSET? .O ,TAKEBIT>
138                                 <FSET? .O ,TRYTAKEBIT>>>>>
139               <AGAIN>)
140              (ELSE
141               <COND (<EQUAL? .OBJ1 ,IT>
142                      <PRINTD ,P-IT-OBJECT>)
143                     (T <PRINTD .OBJ1>)>
144               <TELL ": ">)>)>
145 ;"end multiple exceptions"
146                                   <SETG PRSO .O>
147                                   <SETG PRSI .I>
148                                   <SET TMP T>
149                                   <SET V <PERFORM ,PRSA ,PRSO ,PRSI>>
150                                   <COND (<==? .V ,M-FATAL> <RETURN>)>)>>)>
151             <COND (<NOT <==? .V ,M-FATAL>>
152                    ;<COND (<==? <LOC ,WINNER> ,PRSO>
153                           <SETG PRSO <>>)>
154                    <SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-END>>)>
155             ;<COND (<VERB? ;AGAIN ;"WALK -- why was this here?"
156                           SAVE RESTORE ;SCORE ;VERSION ;WAIT> T)
157                   (T
158                    <SETG L-PRSA ,PRSA>
159                    <SETG L-PRSO ,PRSO>
160                    <SETG L-PRSI ,PRSI>)>
161             <COND (<==? .V ,M-FATAL> <SETG P-CONT <>>)>)
162            (T
163             <SETG P-CONT <>>)>
164      %<COND (<==? ,ZORK-NUMBER 3>
165              '<COND (<NOT ,CLEFT-QUEUED?>
166                      <ENABLE <QUEUE I-CLEFT <+ 70 <RANDOM 70>>>>
167                      <SETG CLEFT-QUEUED? T>)>)
168             (ELSE '<NULL-F>)>
169      <COND (,P-WON
170             <COND (<VERB? TELL BRIEF SUPER-BRIEF VERBOSE SAVE VERSION
171                           QUIT RESTART SCORE SCRIPT UNSCRIPT RESTORE> T)
172                   (T <SET V <CLOCKER>>)>)>>
173  
174 <GLOBAL P-MULT <>>
175
176 <GLOBAL P-NOT-HERE 0>
177
178 \f
179
180 %<COND (<GASSIGNED? PREDGEN>
181
182 '<ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI) 
183         ;<COND (,DEBUG
184                <TELL "[Perform: ">
185                %<COND (<GASSIGNED? PREDGEN> '<TELL N .A>)
186                       (T '<PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>)>
187                <COND (<AND .O <NOT <==? .A ,V?WALK>>>
188                       <TELL "/" D .O>)>
189                <COND (.I <TELL "/" D .I>)>
190                <TELL "]" CR>)>
191         <SET OA ,PRSA>
192         <SET OO ,PRSO>
193         <SET OI ,PRSI>
194         <COND (<AND <EQUAL? ,IT .I .O>
195                     <NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
196                <TELL "I don't see what you are referring to." CR>
197                <RFATAL>)>
198         <COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)>
199         <COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)>
200         <SETG PRSA .A>
201         <SETG PRSO .O>
202         <COND (<AND ,PRSO <NOT <EQUAL? ,PRSI ,IT>> <NOT <VERB? WALK>>>
203                <SETG P-IT-OBJECT ,PRSO>)>
204         <SETG PRSI .I>
205         <COND (<AND <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
206                     <SET V <NOT-HERE-OBJECT-F>>> .V)
207               (T
208                <SET O ,PRSO>
209                <SET I ,PRSI>
210                <COND
211                 (<SET V <APPLY <GETP ,WINNER ,P?ACTION>>> .V)
212                 (<SET V <APPLY <GETP <LOC ,WINNER> ,P?ACTION> ,M-BEG>> .V)
213                 (<SET V <APPLY <GET ,PREACTIONS .A>>> .V)
214                 (<AND .I <SET V <APPLY <GETP .I ,P?ACTION>>>> .V)
215                 (<AND .O
216                       <NOT <==? .A ,V?WALK>>
217                       <LOC .O>
218                       <SET V <APPLY <GETP <LOC .O> ,P?CONTFCN>>>>
219                  .V)
220                 (<AND .O
221                       <NOT <==? .A ,V?WALK>>
222                       <SET V <APPLY <GETP .O ,P?ACTION>>>>
223                  .V)
224                 (<SET V <APPLY <GET ,ACTIONS .A>>> .V)>)>
225         <SETG PRSA .OA>
226         <SETG PRSO .OO>
227         <SETG PRSI .OI>
228         .V>)
229        (T
230         
231 '<PROG ()
232
233 <SETG DEBUG <>>
234
235 <ROUTINE PERFORM (A "OPTIONAL" (O <>) (I <>) "AUX" V OA OO OI) 
236         #DECL ((A) FIX (O) <OR FALSE OBJECT FIX> (I) <OR FALSE OBJECT> (V) ANY)
237         <COND (,DEBUG
238                <TELL "** PERFORM: PRSA = ">
239                <PRINC <NTH ,ACTIONS <+ <* .A 2> 1>>>
240                <COND (<AND .O <NOT <==? .A ,V?WALK>>>
241                       <TELL " | PRSO = " D .O>)>
242                <COND (.I <TELL " | PRSI = " D .I>)>)>
243         <SET OA ,PRSA>
244         <SET OO ,PRSO>
245         <SET OI ,PRSI>
246         <COND (<AND <EQUAL? ,IT .I .O>
247                     <NOT <ACCESSIBLE? ,P-IT-OBJECT>>>
248                <TELL "I don't see what you are referring to." CR>
249                <RFATAL>)>
250         <COND (<==? .O ,IT> <SET O ,P-IT-OBJECT>)>
251         <COND (<==? .I ,IT> <SET I ,P-IT-OBJECT>)>
252         <SETG PRSA .A>
253         <SETG PRSO .O>
254         <COND (<AND ,PRSO <NOT <VERB? WALK>>>
255                <SETG P-IT-OBJECT ,PRSO>)>
256         <SETG PRSI .I>
257         <COND (<AND <EQUAL? ,NOT-HERE-OBJECT ,PRSO ,PRSI>
258                     <SET V <D-APPLY "Not Here" ,NOT-HERE-OBJECT-F>>> .V)
259               (T
260                <SET O ,PRSO>
261                <SET I ,PRSI>
262                <COND (<SET V <DD-APPLY "Actor" ,WINNER
263                                       <GETP ,WINNER ,P?ACTION>>> .V)
264                      (<SET V <D-APPLY "Room (M-BEG)"
265                                       <GETP <LOC ,WINNER> ,P?ACTION>
266                                       ,M-BEG>> .V)
267                      (<SET V <D-APPLY "Preaction"
268                                       <GET ,PREACTIONS .A>>> .V)
269                      (<AND .I <SET V <D-APPLY "PRSI"
270                                               <GETP .I ,P?ACTION>>>> .V)
271                      (<AND .O
272                            <NOT <==? .A ,V?WALK>>
273                            <LOC .O>
274                            <GETP <LOC .O> ,P?CONTFCN>
275                            <SET V <DD-APPLY "Container" <LOC .O>
276                                            <GETP <LOC .O> ,P?CONTFCN>>>>
277                       .V)
278                      (<AND .O
279                            <NOT <==? .A ,V?WALK>>
280                            <SET V <D-APPLY "PRSO"
281                                            <GETP .O ,P?ACTION>>>>
282                       .V)
283                      (<SET V <D-APPLY <>
284                                       <GET ,ACTIONS .A>>> .V)>)>
285         <SETG PRSA .OA>
286         <SETG PRSO .OO>
287         <SETG PRSI .OI>
288         .V>
289
290 <DEFINE D-APPLY (STR FCN "OPTIONAL" FOO "AUX" RES)
291         <COND (<NOT .FCN> <>)
292               (T
293                <COND (,DEBUG
294                       <COND (<NOT .STR>
295                              <TELL CR "  Default ->" CR>)
296                             (T <TELL CR "  " .STR " -> ">)>)>
297                <SET RES
298                     <COND (<ASSIGNED? FOO>
299                            <APPLY .FCN .FOO>)
300                           (T <APPLY .FCN>)>>
301                <COND (<AND ,DEBUG .STR>
302                       <COND (<==? .RES 2>
303                              <TELL "Fatal" CR>)
304                             (<NOT .RES>
305                              <TELL "Not handled">)
306                             (T <TELL "Handled" CR>)>)>
307                .RES)>>
308
309 <ROUTINE DD-APPLY (STR OBJ FCN "OPTIONAL" (FOO <>))
310         <COND (,DEBUG <TELL "[" D .OBJ "=]">)>
311         <D-APPLY .STR .FCN .FOO>>
312 >)>
313