-
Notifications
You must be signed in to change notification settings - Fork 27
/
input.zap
490 lines (449 loc) · 8.97 KB
/
input.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
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
.SEGMENT "0"
.FUNCT READ-INPUT,TRM,TMP,N,M,FDEF,DIR,?TMP1
PUTB P-INBUF,1,0
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL READ-DEMO,P-INBUF,FALSE-VALUE >TRM
JUMP ?CND3
?CCL5: READ P-INBUF,FALSE-VALUE >TRM
?CND3: ICALL1 MOUSE-INPUT?
EQUAL? TRM,PAD0 \?CCL8
SET 'TRM,F10
JUMP ?CND6
?CCL8: LESS? TRM,PAD1 /?CND6
GRTR? TRM,PAD9 /?CND6
SUB TRM,PAD1
ADD F1,STACK >TRM
?CND6: EQUAL? TRM,CLICK1,CLICK2 \?CCL14
CALL COMPASS-CLICK,COMPASS-PIC-LOC,N-HL >DIR
ZERO? DIR /?PRG1
DIROUT D-TABLE-ON,O-INBUF
CALL2 DIR-TO-STRING,DIR
PRINT STACK
DIROUT D-TABLE-OFF
PUTB O-INBUF,0,INBUF-LENGTH
ADD O-INBUF,1 >?TMP1
GETB O-INBUF,1
ICALL ADD-TO-INPUT,?TMP1,13,STACK
JUMP ?REP2
?CCL14: EQUAL? TRM,13,10 /?REP2
ADD FKEYS,2 >?TMP1
GET FKEYS,0
INTBL? TRM,?TMP1,STACK >TMP \?CCL20
GET TMP,1 >FDEF
ZERO? FDEF /?CCL20
ADD 1,FDEF >?TMP1
GETB FDEF,1
CALL ADD-TO-INPUT,?TMP1,TRM,STACK >TRM
EQUAL? TRM,13,10 /?REP2
JUMP ?PRG1
?CCL20: SOUND S-BEEP
JUMP ?PRG1
?REP2: ICALL1 SCRIPT-INBUF
LEX P-INBUF,P-LEXV
RTRUE
.FUNCT ADD-TO-INPUT,FDEF,TRM,M,N,TMP,?TMP1
GETB P-INBUF,1 >N
GETB FDEF,M
EQUAL? STACK,13,10 \?CND1
SET 'TRM,13
DEC 'M
?CND1: INC 'FDEF
ADD N,2
ADD P-INBUF,STACK >TMP
ADD M,N >?TMP1
GETB P-INBUF,0
LESS? ?TMP1,STACK /?CND3
SOUND 1
GETB P-INBUF,0
SUB STACK,N
SUB STACK,1 >M
?CND3: COPYT FDEF,TMP,M
PUTB TMP,M,0
WINATTR -3,A-SCRIPT,O-CLEAR
PRINTT FDEF,M
ADD N,M
PUTB P-INBUF,1,STACK
EQUAL? TRM,13,10 \?CND5
CRLF
?CND5: WINATTR -3,A-SCRIPT,O-SET
RETURN TRM
.FUNCT SCRIPT-INBUF,BUF,CNT,N,CHR
GETB P-INBUF,1 >N
DIROUT D-SCREEN-OFF
ADD 1,P-INBUF >BUF
?PRG1: IGRTR? 'CNT,N /?REP2
GETB BUF,CNT >CHR
LESS? CHR,97 /?CCL8
GRTR? CHR,122 /?CCL8
SUB CHR,32
PRINTC STACK
JUMP ?PRG1
?CCL8: PRINTC CHR
JUMP ?PRG1
?REP2: CRLF
DIROUT D-SCREEN-ON
RTRUE
.ENDSEG
.SEGMENT "SOFT"
.FUNCT PRINT-CENTER-TABLE,?TMP2,?TMP1
DIROUT D-TABLE-OFF
WINGET -3,WYPOS >?TMP1
WINGET -3,WWIDE >?TMP2
GET 0,24
SUB ?TMP2,STACK
DIV STACK,2
ADD STACK,1
CURSET ?TMP1,STACK
GET DIROUT-TABLE,0
PRINTT DIROUT-TABLE+2,STACK
RTRUE
.FUNCT V-DEFINE,LINE,LINMAX,CHR,TMP,NLINE,FKEY,FDEF,LEFT,FY,FX,?TMP1
ZERO? DONE-DEFINE? \?CND1
SET 'DONE-DEFINE?,TRUE-VALUE
PRINTI "Software Function Key definition. "
GETB 0,30
EQUAL? STACK,MACINTOSH \?CND3
PRINTI "(NOTE: if your Macintosh has no function keys, use Command-1 thru Command-0 instead.) "
?CND3: PRINTI "Use the arrow keys"
ZERO? ACTIVE-MOUSE /?CND5
PRINTI " or the mouse"
?CND5: PRINTI " to select the key to define or the operation to perform. Hit the RETURN/ENTER key"
ZERO? ACTIVE-MOUSE /?CND7
PRINTI " or double-click the mouse"
?CND7: PRINTI " to perform operations."
CRLF
ICALL1 HIT-ANY-KEY
?CND1: CLEAR -1
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
GETB 0,33 >?TMP1
GETB FDEF,0
SUB ?TMP1,STACK
DIV STACK,2 >LEFT
GET FKEYS,0
DIV STACK,2 >LINMAX
CLEAR -1
SCREEN SOFT-WINDOW
FONT 4
WINGET SOFT-WINDOW,WFSIZE >TMP
SHIFT TMP,-8 >FY
BAND TMP,255 >FX
GETB 0,32
SUB STACK,LINMAX
DIV STACK,2
MUL FY,STACK >?TMP1
MUL FX,LEFT
WINPOS SOFT-WINDOW,?TMP1,STACK
ADD LINMAX,1
MUL FY,STACK >?TMP1
ADD FLEN,4
MUL FX,STACK
ADD 1,STACK
WINSIZE SOFT-WINDOW,?TMP1,STACK
ICALL2 DISPLAY-SOFTS,LINE
ICALL DISPLAY-SOFT,FKEY,LINE,FALSE-VALUE
?PRG9: ZERO? DEMO-VERSION? /?CCL13
CALL2 INPUT-DEMO,1 >CHR
JUMP ?CND11
?CCL13: INPUT 1 >CHR
?CND11: SET 'NLINE,LINE
EQUAL? CHR,CLICK1,CLICK2 \?CND14
CALL2 IN-WINDOW?,SOFT-WINDOW >TMP
ZERO? TMP /?CND14
GRTR? TMP,1 \?CND14
SUB TMP,2 >NLINE
EQUAL? LINE,NLINE /?CND19
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
MUL 4,NLINE
ADD 2,STACK
ADD FKEYS,STACK
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
SET 'LINE,NLINE
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
?CND19: EQUAL? CHR,CLICK2 \?CND14
GET FKEY,0
LESS? STACK,0 \?CND14
SET 'CHR,13
?CND14: EQUAL? CHR,CLICK1,CLICK2 /?CND25
EQUAL? CHR,13 \?CCL28
GET FKEY,0
LESS? STACK,0 \?CCL28
SET 'NLINE,0
GET FDEF,1
CALL STACK
ZERO? STACK /?CCL33
SCREEN 0
CLEAR 0
ICALL1 V-$REFRESH
RTRUE
?CCL33: SUB LINMAX,1 >NLINE
ICALL2 DISPLAY-SOFTS,LINE
JUMP ?CND25
?CCL28: EQUAL? CHR,DOWN-ARROW,13 \?CCL35
INC 'NLINE
LESS? NLINE,LINMAX /?CND25
SET 'NLINE,0
JUMP ?CND25
?CCL35: EQUAL? CHR,UP-ARROW \?CCL39
DLESS? 'NLINE,0 \?CND25
SUB LINMAX,1 >NLINE
JUMP ?CND25
?CCL39: ADD FKEYS,2 >?TMP1
GET FKEYS,0
INTBL? CHR,?TMP1,STACK >TMP \?CCL43
SUB TMP,FKEYS
DIV STACK,4 >NLINE
JUMP ?CND25
?CCL43: EQUAL? CHR,8,127 \?CCL45
GETB FDEF,1 >TMP
ZERO? TMP /?CCL48
DEC 'TMP
PUTB FDEF,1,TMP
ADD TMP,2
PUTB FDEF,STACK,32
ADD LINE,2 >?TMP1
ADD TMP,5
ICALL CCURSET,?TMP1,STACK
ERASE 1
JUMP ?CND25
?CCL48: SOUND S-BEEP
JUMP ?CND25
?CCL45: LESS? CHR,32 /?CCL50
LESS? CHR,127 \?CCL50
GETB FDEF,1 >TMP
GETB FDEF,0
EQUAL? TMP,STACK \?CCL55
SOUND S-BEEP
JUMP ?CND25
?CCL55: ADD FDEF,2 >?TMP1
GETB FDEF,1
INTBL? 13,?TMP1,STACK,1 \?CCL57
SOUND S-BEEP
JUMP ?CND25
?CCL57: EQUAL? CHR,124,33 \?CND58
SET 'CHR,13
?CND58: ADD TMP,1
PUTB FDEF,1,STACK
LESS? CHR,65 /?CND60
GRTR? CHR,90 /?CND60
ADD CHR,32 >CHR
?CND60: ADD TMP,2
PUTB FDEF,STACK,CHR
EQUAL? CHR,13 \?CCL66
PRINTC 124
JUMP ?CND25
?CCL66: PRINTC CHR
JUMP ?CND25
?CCL50: SOUND S-BEEP
?CND25: EQUAL? LINE,NLINE /?PRG9
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
MUL 4,NLINE
ADD 2,STACK
ADD FKEYS,STACK
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
SET 'LINE,NLINE
MUL 4,LINE
ADD 2,STACK
ADD FKEYS,STACK >FKEY
GET FKEY,1 >FDEF
JUMP ?PRG9
.FUNCT IN-WINDOW?,W,X,Y,TOP,LEFT
GET 0,27
GET STACK,2 >Y
GET 0,27
GET STACK,1 >X
WINGET W,WTOP >TOP
LESS? Y,TOP /FALSE
WINGET W,WLEFT >LEFT
LESS? X,LEFT /FALSE
SUB Y,TOP >Y
SUB X,LEFT >X
WINGET W,WHIGH
GRTR? Y,STACK /FALSE
WINGET W,WWIDE
GRTR? X,STACK /FALSE
DIV Y,FONT-Y
ADD 1,STACK >Y
RETURN Y
.FUNCT DISPLAY-SOFTS,LINE,L,F,N,FKEY,CNT
GET FKEYS,0 >L
DIV L,2 >L
SCREEN SOFT-WINDOW
CURSET 1,1
DIROUT D-TABLE-ON,DIROUT-TABLE
FONT 1
PRINTI "Function Keys"
ICALL1 PRINT-CENTER-TABLE
FONT 4
ADD FKEYS,2 >FKEY
?PRG1: LESS? CNT,L \TRUE
EQUAL? CNT,LINE \?CCL8
PUSH FALSE-VALUE
JUMP ?CND6
?CCL8: PUSH TRUE-VALUE
?CND6: ICALL DISPLAY-SOFT,FKEY,CNT,STACK
ADD FKEY,4 >FKEY
INC 'CNT
JUMP ?PRG1
.FUNCT DISPLAY-SOFT,FKEY,CNT,INV?,FDEF,S,N,M,TMP,Y,X,?TMP1
GET FKEY,1 >FDEF
ADD CNT,2 >Y
GET FKEY,0
LESS? STACK,0 \?CCL3
ICALL CCURSET,Y,1
ZERO? INV? /?CND4
HLIGHT H-INVERSE
?CND4: FONT 1
DIROUT D-TABLE-ON,DIROUT-TABLE
GET FDEF,0
PRINT STACK
ICALL1 PRINT-CENTER-TABLE
FONT 4
JUMP ?CND1
?CCL3: GETB FDEF,0 >S
GETB FDEF,1 >N
ICALL CCURSET,Y,1
GET FKEY,0 >?TMP1
GET FNAMES,0
INTBL? ?TMP1,FNAMES+2,STACK >TMP \?CND6
ZERO? INV? /?CCL10
HLIGHT H-NORMAL
JUMP ?CND8
?CCL10: HLIGHT H-INVERSE
?CND8: GET TMP,1
PRINT STACK
HLIGHT H-NORMAL
PRINTC 32
ZERO? INV? /?CCL13
HLIGHT H-INVERSE
JUMP ?CND6
?CCL13: HLIGHT H-NORMAL
?CND6: ADD FDEF,2 >FDEF
ZERO? N /?CND14
SUB N,1 >M
GETB FDEF,M
EQUAL? STACK,13 \?CND14
PRINTT FDEF,M
PRINTC 124
ADD FDEF,N >FDEF
SUB S,N >S
?CND14: PRINTT FDEF,S
ZERO? INV? \?CND1
ADD N,5
ICALL CCURSET,Y,STACK
?CND1: HLIGHT H-NORMAL
RTRUE
.FUNCT SOFT-RESET-DEFAULTS,K,L,KEYS,DEF,KL,TMP,?TMP1
GET FKEYS,0 >KL
SET 'DEF,DEFAULT-FKEYS
?PRG1: GETB DEF,0 >K
ZERO? K /FALSE
INC 'DEF
GETB DEF,0
ADD 1,STACK >L
ADD FKEYS,2
INTBL? K,STACK,KL >KEYS \?CND5
GET KEYS,1 >KEYS
ADD 1,KEYS >TMP
PUTB TMP,0,32
ADD 1,TMP >?TMP1
GETB KEYS,0
SUB 0,STACK
COPYT TMP,?TMP1,STACK
ADD 1,KEYS
COPYT DEF,STACK,L
?CND5: ADD DEF,L >DEF
JUMP ?PRG1
.FUNCT SOFT-SAVE-DEFS
CLEAR 0
SCREEN 0
SAVE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
ZERO? STACK \?CND1
PRINTI "Failed."
?CND1: CLEAR 0
SCREEN SOFT-WINDOW
RFALSE
.FUNCT SOFT-RESTORE-DEFS
CLEAR 0
SCREEN 0
RESTORE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
ZERO? STACK \?CND1
PRINTI "Failed."
?CND1: CLEAR 0
SCREEN SOFT-WINDOW
RFALSE
.FUNCT SOFT-EXIT
RTRUE
.ENDSEG
.SEGMENT "0"
.FUNCT Y?,X
?PRG1: ZERO? DEMO-VERSION? /?CCL5
CALL2 INPUT-DEMO,1 >X
JUMP ?CND3
?CCL5: INPUT 1 >X
?CND3: EQUAL? X,89,121,CLICK1 /?CTR7
EQUAL? X,CLICK2 \?CCL8
?CTR7: SET 'X,TRUE-VALUE
JUMP ?REP2
?CCL8: EQUAL? X,78,110 \?CCL12
SET 'X,FALSE-VALUE
?REP2: CRLF
RETURN X
?CCL12: CRLF
PRINTI "[Please type Y or N] >"
JUMP ?PRG1
.FUNCT BLINK,PIC1,PIC2,Y,X,SCR,CHAR,LAST,CNT
SCREEN SCR
DISPLAY PIC2,Y,X
SCREEN S-TEXT
SET 'LAST,PIC2
?PRG1: SET 'TYPED-TIMED-OUT,FALSE-VALUE
INPUT 1,3,TYPED? >CHAR
ICALL1 MOUSE-INPUT?
ZERO? TYPED-TIMED-OUT /?CCL5
SCREEN SCR
EQUAL? LAST,PIC1 \?CCL8
SET 'LAST,PIC2
PUSH PIC2
JUMP ?CND6
?CCL8: SET 'LAST,PIC1
PUSH PIC1
?CND6: DISPLAY STACK,Y,X
INC 'CNT
EQUAL? CNT,4 \?CND9
ZERO? ROSE-NEEDS-UPDATING /?CND9
EQUAL? CURRENT-SPLIT,MAP-TOP-LEFT-LOC \?CND9
ICALL1 UPDATE-MAP-ROSE
?CND9: SCREEN S-TEXT
JUMP ?PRG1
?CCL5: EQUAL? LAST,PIC2 /?CCL15
RETURN CHAR
?CCL15: SCREEN SCR
DISPLAY PIC1,Y,X
SCREEN S-TEXT
RETURN CHAR
.FUNCT TYPED?
SET 'TYPED-TIMED-OUT,TRUE-VALUE
RTRUE
.FUNCT PICINF-PLUS-ONE,PIC
PICINF PIC,PICINF-TBL /?BOGUS1
?BOGUS1: GET PICINF-TBL,0
ADD STACK,1
PUT PICINF-TBL,0,STACK
GET PICINF-TBL,1
ADD STACK,1
PUT PICINF-TBL,1,STACK
RTRUE
.FUNCT MOUSE-INPUT?
GET 0,27
GET STACK,1 >MOUSE-LOC-X
GET 0,27
GET STACK,2 >MOUSE-LOC-Y
RETURN MOUSE-LOC-Y
.ENDSEG
.ENDI