-
Notifications
You must be signed in to change notification settings - Fork 16
/
menu.zap
245 lines (230 loc) · 4.76 KB
/
menu.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
.SEGMENT "0"
.FUNCT GET-FROM-MENU:ANY:3:4,MSG,MENU,FCN,DEF,YFULL,Y,TMP,N,WHICH,L,WID,CNT,LL,?TMP1,?TMP2
ASSIGNED? 'DEF /?CND1
SET 'DEF,1
?CND1: GET MENU,0 >L
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS /?CCL4
EQUAL? MACHINE,AMIGA \?CND3
?CCL4: INC 'L
?CND3: WINGET S-TEXT,WCRCNT >Y
ZERO? Y /?CND7
ICALL2 N-CRLF,Y
ICALL1 RESET-MARGIN
?CND7: WINGET 0,WHIGH
DIV STACK,FONT-Y >TMP
WINGET 0,WLCNT
SUB TMP,STACK
GRTR? L,STACK \?CND9
WINPUT 0,WLCNT,TMP
?CND9: GET MENU,0 >LL
?PRG11: IGRTR? 'CNT,LL \?CCL15
INC 'WID
SET 'RESTORED?,TRUE-VALUE
?PRG18: ZERO? RESTORED? /?CND20
MUL L,FONT-Y
ICALL2 MAKE-ROOM-FOR,STACK
WINGET 0,WYPOS >Y
WINGET 0,WTOP
ADD STACK,Y
ADD STACK,-1 >YFULL
?CND20: CURSET Y,1
WINGET 0,WLEFT >?TMP2
MUL L,FONT-Y >?TMP1
WINGET 0,WWIDE
ICALL WINDEF,MENU-WINDOW,YFULL,?TMP2,?TMP1,STACK
SCREEN MENU-WINDOW
EQUAL? MACHINE,AMIGA /?CND22
WINGET S-TEXT,WCOLOR >LL
BAND LL,255 >?TMP1
SHIFT LL,-8
COLOR ?TMP1,STACK
?CND22: CLEAR MENU-WINDOW
SCREEN S-TEXT
PRINT MSG
EQUAL? MACHINE,APPLE-2E,APPLE-2C,APPLE-2GS /?CTR25
EQUAL? MACHINE,AMIGA \?CCL26
?CTR25: SET 'LL,FONT-Y
CRLF
JUMP ?CND24
?CCL15: DIROUT D-TABLE-ON,DIROUT-TABLE
GET MENU,CNT
ICALL2 PRINT-TABLE,STACK
DIROUT D-TABLE-OFF
GET 0,24 >TMP
GRTR? TMP,WID \?PRG11
SET 'WID,TMP
JUMP ?PRG11
?CCL26: SET 'LL,0
?CND24: ADD YFULL,LL
CALL MENU-SELECT,MENU,STACK,WID,DEF >WHICH
LESS? WHICH,0 \?CCL31
RETURN WHICH
?CCL31: GET 0,8
BTST STACK,1 \?CND29
DIROUT D-SCREEN-OFF
PRINTC 32
GET MENU,WHICH
ICALL2 PRINT-TABLE,STACK
CRLF
CRLF
DIROUT D-SCREEN-ON
?CND29: CRLF
SET 'RESTORED?,FALSE-VALUE
CALL FCN,WHICH,MENU >LL
ZERO? LL /?PRG18
RETURN LL
.FUNCT MENU-SELECT:ANY:3:4,M,Y,WID,S,X,CNT,CHR,?PR-Y,OS,OICNT,ITEM,TMP,?TMP1
ASSIGNED? 'S /?CND1
SET 'S,1
?CND1: GET M,0 >CNT
GET 0,17
SUB STACK,WID
DIV STACK,2 >X
MUL CNT,FONT-Y
ICALL WINDEF,MENU-WINDOW,Y,X,STACK,WID
SCREEN MENU-WINDOW
EQUAL? MACHINE,AMIGA /?CND3
WINGET S-TEXT,WCOLOR >CHR
BAND CHR,255 >?TMP1
SHIFT CHR,-8
COLOR ?TMP1,STACK
?CND3: CLEAR MENU-WINDOW
ICALL1 CURSOR-OFF
?PRG5: IGRTR? '?PR-Y,CNT /?REP6
ICALL CCURSET,?PR-Y,1
EQUAL? ?PR-Y,S \?CND10
HLIGHT H-INVERSE
?CND10: GET M,?PR-Y
ICALL2 PRINT-TABLE,STACK
EQUAL? ?PR-Y,S \?PRG5
HLIGHT H-NORMAL
JUMP ?PRG5
?REP6: ICALL CCURSET,S,1
SET '?PR-Y,0
GET M,S >ITEM
?PRG14: ZERO? DEMO-VERSION? /?CCL18
CALL2 INPUT-DEMO,1
JUMP ?CND16
?CCL18: INPUT 1
?CND16: CALL2 CONVERT-KEYS,STACK
CALL2 LC,STACK >CHR
SET 'OS,S
SET 'OICNT,?PR-Y
EQUAL? CHR,CLICK1,CLICK2 \?CCL21
CALL2 IN-WINDOW?,SOFT-WINDOW >TMP
ZERO? TMP /?CCL21
SET 'S,TMP
EQUAL? OS,S /?CND24
ICALL CCURSET,OS,1
GET M,OS
ICALL2 PRINT-TABLE,STACK
ICALL CCURSET,S,1
HLIGHT H-INVERSE
GET M,S >ITEM
ICALL2 PRINT-TABLE,ITEM
HLIGHT H-NORMAL
CALL2 L-PIXELS,S >?TMP1
CALL STRWIDTH,ITEM,?PR-Y
ADD STACK,1
CURSET ?TMP1,STACK
?CND24: EQUAL? CHR,CLICK2 \?CCL28
CLEAR MENU-WINDOW
ICALL1 CURSOR-ON
SCREEN S-TEXT
RETURN S
?CCL28: SET 'OS,S
JUMP ?CND19
?CCL21: EQUAL? CHR,8,127 \?CCL30
GRTR? ?PR-Y,0 \?CCL30
DEC '?PR-Y
JUMP ?CND19
?CCL30: EQUAL? CHR,UP-ARROW,LEFT-ARROW,DOWN-ARROW /?CTR33
EQUAL? CHR,RIGHT-ARROW,32 \?CCL34
?CTR33: SET 'ITEM,FALSE-VALUE
SET '?PR-Y,FALSE-VALUE
EQUAL? CHR,UP-ARROW,LEFT-ARROW \?CCL39
GRTR? S,1 \?CCL42
DEC 'S
JUMP ?CND19
?CCL42: SET 'S,CNT
JUMP ?CND19
?CCL39: LESS? S,CNT \?CCL45
INC 'S
JUMP ?CND19
?CCL45: SET 'S,1
JUMP ?CND19
?CCL34: EQUAL? CHR,13 \?CCL47
CLEAR MENU-WINDOW
ICALL1 CURSOR-ON
SCREEN S-TEXT
RETURN S
?CCL47: GETB ITEM,0
LESS? ?PR-Y,STACK \?CCL49
ADD ?PR-Y,1
GETB ITEM,STACK
CALL2 LC,STACK
EQUAL? CHR,STACK \?CCL49
INC '?PR-Y
JUMP ?CND19
?CCL49: CALL FIND-ITEM,ITEM,CHR,?PR-Y,M >TMP
ZERO? TMP /?CCL53
SET 'S,TMP
INC '?PR-Y
JUMP ?CND19
?CCL53: SOUND S-BEEP
?CND19: GET M,S >ITEM
EQUAL? S,OS \?CCL55
EQUAL? ?PR-Y,OICNT /?PRG14
?CCL55: EQUAL? S,OS /?CND58
ICALL CCURSET,OS,1
GET M,OS
ICALL2 PRINT-TABLE,STACK
ICALL CCURSET,S,1
HLIGHT H-INVERSE
ICALL2 PRINT-TABLE,ITEM
HLIGHT H-NORMAL
?CND58: CALL2 L-PIXELS,S >?TMP1
CALL STRWIDTH,ITEM,?PR-Y
ADD STACK,1
CURSET ?TMP1,STACK
JUMP ?PRG14
.FUNCT PRINT-TABLE:ANY:1:2,TBL,L
ASSIGNED? 'L /?CND1
GETB TBL,0 >L
?CND1: ADD 1,TBL
PRINTT STACK,L
RTRUE
.FUNCT STRWIDTH:ANY:2:2,ITEM,ICNT
GRTR? ICNT,1 \FALSE
DIROUT D-TABLE-ON,DIROUT-TABLE
ICALL PRINT-TABLE,ITEM,ICNT
DIROUT D-TABLE-OFF
GET 0,24
RSTACK
.FUNCT LC:ANY:1:1,CHR
LESS? CHR,65 /?CCL3
GRTR? CHR,90 /?CCL3
ADD CHR,32
RSTACK
?CCL3: RETURN CHR
.FUNCT FIND-ITEM:ANY:4:4,ITEM,CHR,ICNT,MENU,S,NITEM,CCNT,C1,C2
?PRG1: GET MENU,0
IGRTR? 'S,STACK /FALSE
GET MENU,S >NITEM
GETB NITEM,0
LESS? ICNT,STACK \?PRG1
ADD ICNT,1
GETB NITEM,STACK
CALL2 LC,STACK
EQUAL? CHR,STACK \?PRG1
SET 'CCNT,0
?PRG9: IGRTR? 'CCNT,ICNT \?CND11
RETURN S
?CND11: GETB NITEM,CCNT
CALL2 LC,STACK >C1
GETB ITEM,CCNT
CALL2 LC,STACK >C2
EQUAL? C1,C2 /?PRG9
JUMP ?PRG1
.ENDSEG
.ENDI