-
Notifications
You must be signed in to change notification settings - Fork 16
/
misc.zabstr
184 lines (183 loc) · 9.42 KB
/
misc.zabstr
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
<BEGIN-SEGMENT 0>
<PROPDEF SCENE <> (SCENE "MANY" S:FIX = <> "MANY" <BYTE .S>)>
<PROPDEF SCORE <> (SCORE N:FIX = 2 <BYTE 0> <BYTE .N>)>
<DEFINE-ROUTINE PRINT-HIM/HER>
<DEFINE-ROUTINE CPRINT-HE/SHE>
<DEFINE-ROUTINE PRINT-HE/SHE>
<DEFINE-ROUTINE PRINT-HIS/HER>
<DEFINE-ROUTINE PRINT-PLURAL>
<DEFINE-ROUTINE PRINTUNDER>
<DEFINE-ROUTINE CTHE-PRINT-PRSO>
<DEFINE-ROUTINE CTHE-PRINT-PRSI>
<DEFINE-ROUTINE CTHE-PRINT>
<DEFINE-ROUTINE THE-PRINT-PRSO>
<DEFINE-ROUTINE THE-PRINT-PRSI>
<DEFINE-ROUTINE THE-PRINT>
<DEFINE-ROUTINE CPRINTA-PRSO>
<DEFINE-ROUTINE PRINTA-PRSO>
<DEFINE-ROUTINE PRINTA-PRSI>
<DEFINE-ROUTINE PRINTA>
<DEFINE-ROUTINE DPRINT-PRSO>
<DEFINE-ROUTINE DPRINT-PRSI>
<DEFINE-ROUTINE DPRINT>
<DEFINE-ROUTINE IPRINT>
<COND (<GASSIGNED? ZILCH> <DEFINE PE (F I) <COND (<TYPE? .I LIST> <FORM .F !.I>
) (ELSE <FORM .F .I>)>> <DEFMAC P? ('V "OPT" ('O '*) ('I '*) ('W '*) "AUX" (L (
))) <COND (<N==? .I '*> <SET L (<PE PRSI? .I> !.L)>)> <COND (<N==? .O '*> <COND
(<OR <==? .V 'WALK> <==? .V ',V?WALK>> <SET L (<PE DIR? .O> !.L)>) (ELSE <SET L
(<PE PRSO? .O> !.L)>)>)> <COND (<N==? .V '*> <SET L (<PE VERB? .V> !.L)>)> <
COND (<N==? .W '*> <SET L (<PE WINNER? .W> !.L)>)> <COND (<EMPTY? <REST .L>> <1
.L>) (ELSE <FORM AND !.L>)>> <DEFMAC NOT-SOLVED? ('OBJ) <FORM FSET? .OBJ ',
SCOREBIT>> <DEFMAC SOLVED? ('OBJ) <FORM NOT <FORM FSET? .OBJ ',SCOREBIT>>> <
DEFMAC VERB? ("ARGS" ATMS) <MULTIFROB ',PRSA .ATMS>> <DEFMAC SCENE? ("ARGS"
ATMS) <MULTIFROB ',SCENE .ATMS>> <DEFMAC CONTEXT? ("ARGS" ATMS) <MULTIFROB '.
RARG .ATMS>> <DEFMAC ADJ? ("ARGS" ATMS) <MULTIFROB '<PARSE-ADJ ,PARSE-RESULT> .
ATMS>> <SETG RARG? ,CONTEXT?> <DEFMAC WINNER? ("ARGS" ATMS) <MULTIFROB ',WINNER
.ATMS>> <DEFMAC PRSO? ("ARGS" ATMS) <MULTIFROB ',PRSO .ATMS>> <DEFMAC DIR? (
"ARGS" ATMS) <MULTIFROB ',P-WALK-DIR .ATMS>> <DEFMAC PRSI? ("ARGS" ATMS) <
MULTIFROB ',PRSI .ATMS>> <DEFMAC HERE? ("ARGS" ATMS) <MULTIFROB ',HERE .ATMS>>
<SETG ROOM? ,HERE?> <DEFINE MULTIFROB (X ATMS "AUX" (OO (OR)) (O .OO) (L ())
ATM SP) <REPEAT () <COND (<EMPTY? .ATMS> <RETURN <COND (<LENGTH? .OO 1> <ERROR
.X>) (<LENGTH? .OO 2> <NTH .OO 2>) (ELSE <CHTYPE .OO FORM>)>>)> <REST <PUTREST
.O <SET O (<REPEAT ((LL <FORM EQUAL? .X>) (L <REST .LL>)) <COND (<OR <EMPTY? .
ATMS> <==? <LENGTH <REST .LL 2>> 3>> <RETURN .LL>)> <SET ATM <NTH .ATMS 1>> <
PUTREST .L <SET L (<COND (<TYPE? .ATM ATOM> <SET SP <SPNAME .ATM>> <MAKE-GVAL <
COND (<==? .X ',PRSA> <PARSE <STRING "V?" .SP>>) (<==? .X ',P-WALK-DIR> <COND (
<AND <G? <LENGTH .SP> 2> <==? <1 .SP> !\P> <==? <2 .SP> !\?>> .ATM) (ELSE <
PARSE <STRING "P?" .SP>>)>) (<==? .X '.RARG> <COND (<AND <G? <LENGTH .SP> 2> <
==? <1 .SP> !\M> <==? <2 .SP> !\->> .ATM) (ELSE <PARSE <STRING "M-" .SP>>)>) (
ELSE .ATM)>>) (ELSE .ATM)>)>> <SET ATMS <REST .ATMS>>>)>>>>>) (ELSE <DEFINE P?
(V "OPT" (O '*) (I '*) (W '*) "AUX" (L <>)) <AND <OR <==? .W '*> <WINNER? .W>>
<OR <==? .V '*> <VERB? .V>> <OR <==? .O '*> <PRSO? .O>> <OR <==? .I '*> <PRSI?
.I>>>> <DEFINE VERB? ("TUPLE" ATMS) <MAPF <> <FUNCTION (A "AUX" ATM) <COND (<
TYPE? .A ATOM> <COND (<SET ATM <LOOKUP <STRING "V?" <SPNAME .A>> <MOBLIST
INITIAL>>> <COND (<EQUAL? ,PRSA ,.ATM> <MAPLEAVE T>)>) (ELSE <ERROR NOT-A-VERB?
.A>)>) (<EQUAL? ,PRSA .A> <MAPLEAVE T>)>> .ATMS>> <DEFINE CONTEXT? ("TUPLE"
ATMS) <MAPF <> <FUNCTION (A "AUX" ATM) <COND (<TYPE? .A ATOM> <COND (<AND <G? <
LENGTH <SET ATM <SPNAME .A>>> 2> <==? <1 .ATM> !\M> <==? <2 .ATM> !\->> <COND (
<EQUAL? .RARG ,.ATM> <MAPLEAVE T>)>) (<SET ATM <LOOKUP <STRING "M-" <SPNAME .A>
> <MOBLIST INITIAL>>> <COND (<EQUAL? .RARG ,.ATM> <MAPLEAVE T>)>) (ELSE <ERROR
NOT-A-CONTEXT? .A>)>) (<EQUAL? .RARG .A> <MAPLEAVE T>)>> .ATMS>> <SETG RARG? ,
CONTEXT?> <DEFINE WINNER? ("TUPLE" ATMS) <MULTIFROB ,WINNER .ATMS>> <DEFINE
PRSO? ("TUPLE" ATMS) <MULTIFROB ,PRSO .ATMS>> <DEFINE PRSI? ("TUPLE" ATMS) <
MULTIFROB ,PRSI .ATMS>> <DEFINE HERE? ("TUPLE" ATMS) <MULTIFROB HERE .ATMS>> <
SETG ROOM? ,HERE?> <DEFINE MULTIFROB (X ATMS) <MAPF <> <FUNCTION (A) <COND (<
TYPE? .A ATOM> <SET A ,.A>)> <COND (<EQUAL? .X .A> <MAPLEAVE T>)>> .ATMS>>)>
<COND (<GASSIGNED? ZILCH> <DEFMAC BSET ('OBJ "ARGS" BITS) <MULTIBITS FSET .OBJ
.BITS>> <DEFMAC BCLEAR ('OBJ "ARGS" BITS) <MULTIBITS FCLEAR .OBJ .BITS>> <
DEFMAC BSET? ('OBJ "ARGS" BITS) <MULTIBITS FSET? .OBJ .BITS>> <DEFINE MULTIBITS
(X OBJ ATMS "AUX" (OT <COND (<==? .X FSET?> <FORM OR>) (ELSE <FORM PROG ()>)>)
(OO <COND (<LENGTH? .OT 1> .OT) (ELSE <REST .OT>)>) (O .OO) ATM) <REPEAT () <
COND (<EMPTY? .ATMS> <RETURN .OT>)> <SET ATM <NTH .ATMS 1>> <SET ATMS <REST .
ATMS>> <PUTREST .O <SET O (<FORM .X .OBJ <COND (<TYPE? .ATM FORM> .ATM) (ELSE <
MAKE-GVAL .ATM>)>>)>>>>) (ELSE <DEFINE BSET (OBJ "TUPLE" BITS) <MULTIBITS ,FSET
.OBJ .BITS>> <DEFINE BCLEAR (OBJ "TUPLE" BITS) <MULTIBITS ,FCLEAR .OBJ .BITS>>
<DEFINE BSET? (OBJ "TUPLE" BITS) <MAPF <> <FUNCTION (A) <COND (<FSET? .OBJ ,.A>
<MAPLEAVE T>)>> .BITS>> <DEFINE MULTIBITS (X OBJ ATMS) <MAPF <> <FUNCTION (A) <
APPLY .X .OBJ ,.A>> .ATMS>>)>
<DEFMAC RFATAL () '<RETURN ,M-FATAL>>
<COND (<GASSIGNED? ZILCH> <DEFMAC PROB ('BASE?) <FORM NOT <FORM L? .BASE? '<
RANDOM 100>>>>) (ELSE <DEFINE PROB (BASE?) <NOT <L? .BASE? <RANDOM 100>>>>)>
<DEFINE-ROUTINE PICK-ONE>
<DEFMAC APPLE? () '<EQUAL? ,MACHINE ,APPLE-2E ,APPLE-2C ,APPLE-2GS>>
<GLOBAL P-WON <>>
<GLOBAL SCENE 0>
<DEFINE-ROUTINE SCENE-SELECT>
<DEFINE-ROUTINE SCENE-SELECT-F>
<CONSTANT PART-MENU <LTABLE <TABLE (PURE STRING LENGTH) "START the game "> <
TABLE (PURE STRING LENGTH) "RESTORE a saved game "> <TABLE (PURE STRING LENGTH)
"QUIT the game ">>>
<CONSTANT SCENE-NAMES <PLTABLE "Erasmus" "Anjiro" "Yabu" "Pit" "Rodrigues"
"Voyage to Osaka" "Toranaga" "Prison" "Mariko" "Escape" "Earthquake"
"Journey to Yedo" "Ochiba" "Departure" "Seppuku" "Ninja" "Yokohama" "Aftermath"
"Epilogue">>
<DEFMAC SCENE-CONSTANTS ("TUPLE" SS "AUX" (CNT 0)) <MAPF ,PLTABLE <FUNCTION (S)
<EVAL <FORM CONSTANT .S <SET CNT <+ .CNT 1>>>>> .SS>>
<CONSTANT SCENES <SCENE-CONSTANTS S-ERASMUS S-ANJIRO S-YABU S-PIT S-RODRIGUES
S-VOYAGE S-TORANAGA S-PRISON S-MARIKO S-ESCAPE S-QUAKE S-JOURNEY S-OCHIBA
S-DEPARTURE S-SEPPUKU S-NINJA S-YOKOHAMA S-AFTERMATH S-EPILOGUE>>
<CONSTANT SCENE-LOCS <PLTABLE BRIDGE-OF-ERASMUS MURA-HOUSE VILLAGE-SQUARE PIT
ANJIRO-WATERFRONT GALLEY OUTER-CORRIDOR PRISON MAPLE-GLADE COURTYARD PLATEAU
YOKOSE-BATH-HOUSE OCHIBA-ROOM FORECOURT FORMAL-GARDEN PRIVATE-QUARTERS YOKOHAMA
STABLE SEKIGAHARA>>
<CONSTANT SCENE-PICS <TABLE (PURE BYTE LENGTH) P-STORM P-GARDEN P-YABU-SEG
P-PIT P-RODRIGUES-SEG P-CONFUSION P-OSAKA P-PRISON-SEG P-MARIKO-SEG
P-PROCESSION P-QUAKE P-BATH P-OCHIBA-SEG P-DEPARTURE-SEG P-SEPPUKU P-NINJA
P-VINCK P-AFTERMATH-SEG P-CREST>>
<GLOBAL MACHINE <>>
<GLOBAL WIDTH 0>
<END-SEGMENT>
<BEGIN-SEGMENT STARTUP>
<DEFINE-ROUTINE GO>
<DEFINE-ROUTINE SLIDE-SHOW>
<DEFINE-ROUTINE END-DEMO>
<END-SEGMENT>
<BEGIN-SEGMENT 0>
<CONSTANT S-FULL 7>
<DEFINE-ROUTINE SETUP-FULL>
<DEFINE-ROUTINE SETUP-DISPLAY>
<DEFINE-ROUTINE REPAINT-DISPLAY>
<DEFINE-ROUTINE GOTO-SCENE>
<DEFINE-ROUTINE TOUCH-SEG>
<DEFINE-ROUTINE GAME-VERB?>
<GLOBAL P-MULT <>>
<GLOBAL P-NOT-HERE 0>
<DEFINE-ROUTINE END-QUOTE>
<GLOBAL CLOCK-WAIT <>>
<GLOBAL C-TABLE <ITABLE 13 <> <>>>
<CONSTANT C-INTLEN 4>
<CONSTANT C-RTN 0>
<CONSTANT C-TICK 1>
<CONSTANT C-TABLELEN 52>
<GLOBAL C-INTS 52>
<DEFINE-ROUTINE DEQUEUE>
<DEFINE-ROUTINE QUEUED?>
<DEFINE-ROUTINE QUEUE>
<GLOBAL STATIONARY? <>>
<GLOBAL STATIONARY-CNT <>>
<GLOBAL CLOCK-HAND <>>
<DEFINE-ROUTINE CLOCKER>
<DEFINE-ROUTINE DEQUEUE-ALL>
<DEFINE PSEUDO ("TUPLE" V) <MAPF ,PLTABLE <FUNCTION (OBJ) <COND (<N==? <LENGTH
.OBJ> 3> <ERROR BAD-THING .OBJ>)> <MAPRET <COND (<NTH .OBJ 1> <VOC <SPNAME <NTH
.OBJ 1>> ADJECTIVE>)> <COND (<NTH .OBJ 2> <VOC <SPNAME <NTH .OBJ 2>> NOUN>)>>>
.V>>
<DEFINE-ROUTINE PERFORM-PRSA>
<DEFINE-ROUTINE NEW-VERB>
<DEFINE-ROUTINE SWAP-VERB>
<DEFINE-ROUTINE NEW-PRSO>
<DEFINE-ROUTINE NEW-WINNER-PRSO>
<DEFINE-ROUTINE REDIRECT>
<GLOBAL DELAY-CNT 0>
<COND (<GASSIGNED? ZILCH> <DEFMAC ZLINES ('VAR:<PRIMTYPE ATOM> "ARGS" LINES:
LIST "AUX" (CNT:FIX 0) SETTER:ATOM (DELAYS:<OR FALSE LIST> <>)) <COND (<TYPE? .
VAR ATOM> <EVAL <FORM GLOBAL .VAR 0>> <SET SETTER <CHTYPE .VAR GVAL>>) (<TYPE?
.VAR GVAL> <EVAL <FORM GLOBAL <CHTYPE .VAR ATOM> 0>> <SET SETTER 'SETG>) (<
TYPE? .VAR LVAL> <EVAL <FORM GLOBAL <CHTYPE .VAR ATOM> 0>> <SET SETTER 'SET>)>
<SET DELAYS <MAPF ,LIST <FUNCTION (LINE:LIST) <COND (<EMPTY? .LINE> <MAPRET>) (
<==? <1 .LINE> DELAY> <MAPRET (<FORM EQUAL? .VAR .CNT> !<REST .LINE!>)>) (ELSE
<COND (<AND <NOT <EMPTY? .LINE>> <TYPE? <1 .LINE> FIX>> <SET CNT <+ .CNT <1 .
LINE>>> <SET LINE <REST .LINE>>) (ELSE <SET CNT <+ .CNT 1>>)> <MAPRET>)>> .
LINES>> <SET CNT 0> <COND (<NOT <EMPTY? .DELAYS>> <SET DELAYS ('<SETG DELAY-CNT
<+ ,DELAY-CNT 1>> <FORM COND !.DELAYS> '<SETG DELAY-CNT 0>)>)> <FORM PROG () !.
DELAYS <FORM .SETTER <CHTYPE .VAR ATOM> <FORM + .VAR 1>> <FORM COND !<MAPF ,
LIST <FUNCTION (LINE:LIST) <COND (<NOT <EMPTY? .LINE>> <COND (<==? <1 .LINE>
DELAY> <MAPRET>) (<TYPE? <1 .LINE> FIX> <SET CNT <+ .CNT <1 .LINE>>> <SET LINE
<REST .LINE>>) (ELSE <SET CNT <+ .CNT 1>>)> <LIST <FORM EQUAL? .VAR .CNT> !.
LINE>) (ELSE <ERROR BAD-ZLINES>)>> .LINES!>>>>) (ELSE <DEFINE ZLINES (VAR
"ARGS" LINES) <RFALSE>>)>
<COND (<GASSIGNED? ZILCH> <DEFMAC FOR ('X "ARGS" BODY) <FORM REPEAT (<1 .X>) <
FORM COND (<FORM NOT <2 .X>> '<RETURN>)> !.BODY <3 .X>>>)>
<DEFINE-ROUTINE CREWMAN?>
<DEFINE-ROUTINE WINDEF>
<GLOBAL FONT-X 7>
<GLOBAL FONT-Y 10>
<DEFINE-ROUTINE C-PIXELS>
<DEFINE-ROUTINE L-PIXELS>
<DEFINE-ROUTINE CCURSET>
<DEFINE-ROUTINE IN-SCENE?>
<DEFINE-ROUTINE REPLACE-SYNONYM>
<DEFINE-ROUTINE REPLACE-ADJECTIVE>
<DEFINE-ROUTINE CURSOR-OFF>
<DEFINE-ROUTINE CURSOR-ON>
<END-SEGMENT>