]> github.com/historicalsource and other repositories - zork1.git/blob - gmacros.zil
Update README.md
[zork1.git] / gmacros.zil
1 "GMACROS for
2                             The Zork Trilogy
3          (c) Copyright 1983 Infocom, Inc.  All Rights Reserved"
4
5 <SETG C-ENABLED? 0>
6 <SETG C-ENABLED 1>
7 <SETG C-DISABLED 0>
8
9 <DEFMAC TELL ("ARGS" A)
10         <FORM PROG ()
11               !<MAPF ,LIST
12                      <FUNCTION ("AUX" E P O)
13                           <COND (<EMPTY? .A> <MAPSTOP>)
14                                 (<SET E <NTH .A 1>>
15                                  <SET A <REST .A>>)>
16                           <COND (<TYPE? .E ATOM>
17                                  <COND (<OR <=? <SET P <SPNAME .E>>
18                                                 "CRLF">
19                                             <=? .P "CR">>
20                                         <MAPRET '<CRLF>>)
21                                        (<EMPTY? .A>
22                                         <ERROR INDICATOR-AT-END? .E>)
23                                        (ELSE
24                                         <SET O <NTH .A 1>>
25                                         <SET A <REST .A>>
26                                         <COND (<OR <=? <SET P <SPNAME .E>>
27                                                        "DESC">
28                                                    <=? .P "D">
29                                                    <=? .P "OBJ">
30                                                    <=? .P "O">>
31                                                <MAPRET <FORM PRINTD .O>>)
32                                               (<OR <=? .P "A">
33                                                    <=? .P "AN">>
34                                                <MAPRET <FORM PRINTA .O>>)
35                                               (<OR <=? .P "NUM">
36                                                    <=? .P "N">>
37                                                <MAPRET <FORM PRINTN .O>>)
38                                               (<OR <=? .P "CHAR">
39                                                    <=? .P "CHR">
40                                                    <=? .P "C">>
41                                                <MAPRET <FORM PRINTC .O>>)
42                                               (ELSE
43                                                <MAPRET
44                                                  <FORM PRINT
45                                                        <FORM GETP .O .E>>>)>)>)
46                                 (<TYPE? .E STRING ZSTRING>
47                                  <MAPRET <FORM PRINTI .E>>)
48                                 (<TYPE? .E FORM LVAL GVAL>
49                                  <MAPRET <FORM PRINT .E>>)
50                                 (ELSE <ERROR UNKNOWN-TYPE .E>)>>>>>
51
52 <DEFMAC VERB? ("ARGS" ATMS)
53         <MULTIFROB PRSA .ATMS>>
54
55 <DEFMAC PRSO? ("ARGS" ATMS)
56         <MULTIFROB PRSO .ATMS>>
57
58 <DEFMAC PRSI? ("ARGS" ATMS)
59         <MULTIFROB PRSI .ATMS>>
60
61 <DEFMAC ROOM? ("ARGS" ATMS)
62         <MULTIFROB HERE .ATMS>>
63
64 <DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ()) ATM) 
65         <REPEAT ()
66                 <COND (<EMPTY? .ATMS>
67                        <RETURN!- <COND (<LENGTH? .OO 1> <ERROR .X>)
68                                        (<LENGTH? .OO 2> <NTH .OO 2>)
69                                        (ELSE <CHTYPE .OO FORM>)>>)>
70                 <REPEAT ()
71                         <COND (<EMPTY? .ATMS> <RETURN!->)>
72                         <SET ATM <NTH .ATMS 1>>
73                         <SET L
74                              (<COND (<TYPE? .ATM ATOM>
75                                      <FORM GVAL
76                                            <COND (<==? .X PRSA>
77                                                   <PARSE
78                                                     <STRING "V?"
79                                                             <SPNAME .ATM>>>)
80                                                  (ELSE .ATM)>>)
81                                     (ELSE .ATM)>
82                               !.L)>
83                         <SET ATMS <REST .ATMS>>
84                         <COND (<==? <LENGTH .L> 3> <RETURN!->)>>
85                 <SET O <REST <PUTREST .O (<FORM EQUAL? <FORM GVAL .X> !.L>)>>>
86                 <SET L ()>>>
87
88 <DEFMAC BSET ('OBJ "ARGS" BITS)
89         <MULTIBITS FSET .OBJ .BITS>>
90
91 <DEFMAC BCLEAR ('OBJ "ARGS" BITS)
92         <MULTIBITS FCLEAR .OBJ .BITS>>
93
94 <DEFMAC BSET? ('OBJ "ARGS" BITS)
95         <MULTIBITS FSET? .OBJ .BITS>>
96
97 <DEFINE MULTIBITS (X OBJ ATMS "AUX" (O ()) ATM) 
98         <REPEAT ()
99                 <COND (<EMPTY? .ATMS>
100                        <RETURN!- <COND (<LENGTH? .O 1> <NTH .O 1>)
101                                        (<==? .X FSET?> <FORM OR !.O>)
102                                        (ELSE <FORM PROG () !.O>)>>)>
103                 <SET ATM <NTH .ATMS 1>>
104                 <SET ATMS <REST .ATMS>>
105                 <SET O
106                      (<FORM .X
107                             .OBJ
108                             <COND (<TYPE? .ATM FORM> .ATM)
109                                   (ELSE <FORM GVAL .ATM>)>>
110                       !.O)>>>
111
112 <DEFMAC RFATAL ()
113         '<PROG () <PUSH 2> <RSTACK>>>
114
115 <DEFMAC PROB ('BASE? "OPTIONAL" 'LOSER?)
116         <COND (<ASSIGNED? LOSER?> <FORM ZPROB .BASE?>)
117               (ELSE <FORM G? .BASE? '<RANDOM 100>>)>>
118
119 <ROUTINE ZPROB
120          (BASE)
121          <COND (,LUCKY <G? .BASE <RANDOM 100>>)
122                (ELSE <G? .BASE <RANDOM 300>>)>>
123
124 <ROUTINE RANDOM-ELEMENT (FROB)
125          <GET .FROB <RANDOM <GET .FROB 0>>>>
126
127 <ROUTINE PICK-ONE (FROB
128                    "AUX" (L <GET .FROB 0>) (CNT <GET .FROB 1>) RND MSG RFROB)
129          <SET L <- .L 1>>
130          <SET FROB <REST .FROB 2>>
131          <SET RFROB <REST .FROB <* .CNT 2>>>
132          <SET RND <RANDOM <- .L .CNT>>>
133          <SET MSG <GET .RFROB .RND>>
134          <PUT .RFROB .RND <GET .RFROB 1>>
135          <PUT .RFROB 1 .MSG>
136          <SET CNT <+ .CNT 1>>
137          <COND (<==? .CNT .L> <SET CNT 0>)>
138          <PUT .FROB 0 .CNT>
139          .MSG>
140
141 <DEFMAC ENABLE ('INT) <FORM PUT .INT ,C-ENABLED? 1>>
142
143 <DEFMAC DISABLE ('INT) <FORM PUT .INT ,C-ENABLED? 0>>
144
145 <DEFMAC FLAMING? ('OBJ)
146         <FORM AND <FORM FSET? .OBJ ',FLAMEBIT>
147                   <FORM FSET? .OBJ ',ONBIT>>>
148
149 <DEFMAC OPENABLE? ('OBJ)
150         <FORM OR <FORM FSET? .OBJ ',DOORBIT>
151                  <FORM FSET? .OBJ ',CONTBIT>>> 
152
153 <DEFMAC ABS ('NUM)
154         <FORM COND (<FORM L? .NUM 0> <FORM - 0 .NUM>)
155                    (T .NUM)>>