commit 32eb458
Devine Lu Linvega
·
2026-06-24 03:48:54 +0000 UTC
parent 5eab4de
Pulled latest M/PC
1 files changed,
+87,
-69
+87,
-69
1@@ -14,8 +14,7 @@
2
3 |0050 @Varvara/version
4 |0200 @dir/buflen
5-|0200 @dict/buflen
6-|0200 @dict/tmpbuflen
7+|c000 @dict/buflen
8 |0100 @path/buflen
9 |0200 @bios/buflen
10 |0028 @bios/anchor-y
11@@ -117,6 +116,7 @@
12 JMP2r
13
14 @input/<eval> ( -- )
15+ sel/is-active ?sel/<pick>
16 ;&buf LDAk ?{ POP2 /<reset> !bios/<draw-welcome> }
17 bios/<parse>
18 /<reset> !/<redraw>
19@@ -127,7 +127,7 @@
20 /<reset> !/<redraw>
21
22 @input/<blank> ( -- )
23- sel/<reset>
24+ sel/is-active ?sel/<reset-draw>
25 /<reset>
26 bios/<draw>
27 ( >> )
28@@ -138,7 +138,7 @@
29 [ LIT2 e0 -Screen/pixel ] DEO
30 #0008 .Screen/y DEO2
31 path/<draw>
32- ;&buf font/<draw-str>
33+ ;&buf #45 font/<draw-str-color>
34 .&buf LDZ ?{ ;&full !font/<draw-sprite> }
35 ;&hash !font/<draw-sprite>
36
37@@ -164,7 +164,7 @@
38 ;&anchor-y .Screen/y DEO2
39 [ LIT2 c0 -Screen/pixel ] DEO
40 ;&anchor-y .Screen/y DEO2
41- ;dict/info font/<draw-str>
42+ ;dict/info #45 font/<draw-str-color>
43 ( | logo )
44 [ LIT2 66 -Screen/auto ] DEO
45 ;&logo .Screen/addr DEO2
46@@ -177,6 +177,12 @@
47 @bios/get-depth ( -- depth )
48 ,&ptr LDR2 ;&buf SUB2 #01 SFT2 NIP JMP2r
49
50+@bios/req-depth1 ( -- fail )
51+ /get-depth #00 EQU JMP2r
52+
53+@bios/req-depth2 ( -- fail )
54+ /get-depth #02 LTH JMP2r
55+
56 @bios/<parse> ( str* -- )
57 /<reset>
58 dict/<reset>
59@@ -220,17 +226,17 @@
60 ,&ptr LDR2 #0002 SUB2 LDA2k SWP2 ,&ptr STR2
61 JMP2r
62
63-@bios/<push-err-un1> ( -- )
64- ;dict/err-un !/<push>
65+@bios/<push-err-underflow> ( -- )
66+ ;dict/err-underflow !/<push>
67
68-@bios/<push-err-un2> ( -- )
69- ;dict/err-un !/<push>
70+@bios/<push-err-oversized> ( -- )
71+ ;dict/err-oversized !/<push>
72
73-@bios/<push-err-404> ( -- )
74- ;dict/err-404 !/<push>
75+@bios/<push-err-missing> ( -- )
76+ ;dict/err-missing !/<push>
77
78-@bios/<push-err-bin> ( -- )
79- ;dict/err-bin !/<push>
80+@bios/<push-err-binary> ( -- )
81+ ;dict/err-binary !/<push>
82
83 @bios/<draw> ( -- )
84 #0008 .Screen/x DEO2
85@@ -240,16 +246,16 @@
86 ,&ptr LDR2 ;&buf [ LITr 00 ]
87 &>l
88 NEQ2k ?{ POP2 POP2 POPr JMP2r }
89- LDA2k
90- ( | wrap )
91- DUP2 font/get-width .Screen/x DEI2 ADD2 .Screen/width DEI2 LTH2 ?{
92- ( ) font/<draw-lb> }
93- STHkr /<draw-symbol>
94- #2045 font/<draw-glyph-color>
95+ LDA2k STHkr /<draw-symbol>
96 INCr INC2 INC2 !/>l
97
98 @bios/<draw-symbol> ( symbol* id -- )
99- sel/is-unselected #44 ADD !font/<draw-str-color>
100+ STHk #00 EQU ?{
101+ ( | wrap )
102+ DUP2 font/get-width .Screen/x DEI2 ADD2 .Screen/width DEI2 LTH2 ?{
103+ ( ) font/<draw-lb> } }
104+ .Screen/x DEI2k #0008 ADD2 ROT DEO2
105+ STHr sel/is-unselected #44 ADD !font/<draw-str-color>
106
107 (
108 @|Path )
109@@ -296,7 +302,7 @@
110 JMP2r
111
112 @path/<draw> ( -- )
113- ;&buf !font/<draw-str>
114+ ;&buf #45 !font/<draw-str-color>
115
116 @path/make ( str* -- path* )
117 ;&buf !dict/alloc-cat
118@@ -304,8 +310,12 @@
119 (
120 @|Selection )
121
122+@sel/is-active ( -- bool )
123+ #ff
124+ ( >> )
125+
126 @sel/is-unselected ( id -- bool )
127- [ LIT &id $1 ] NEQ JMP2r
128+ [ LIT &id ff ] NEQ JMP2r
129
130 @sel/<prev> ( -- )
131 ,&id LDR
132@@ -317,18 +327,24 @@
133 ( clamp ) DUP bios/get-depth LTH ?/<set>
134 POP JMP2r
135
136-@sel/<set> ( -- )
137+@sel/<set> ( id -- )
138 ,&id STR !bios/<draw>
139
140 @sel/<pick> ( -- )
141 ,&id LDR INCk ?{ POP JMP2r }
142- bios/get-symbol input/<push-str>
143+ #ff /<set>
144+ bios/get-symbol
145+ ( clamp ) DUP2 str/len #0040 LTH2 ?{ POP2 !input/<redraw> }
146+ input/<push-str>
147 #20 input/<push> !input/<redraw>
148
149 @sel/<reset> ( -- )
150 [ LIT2 ff _&id ] STR
151 JMP2r
152
153+@sel/<reset-draw> ( -- )
154+ /<reset> !bios/<draw>
155+
156 (
157 @|Commands )
158
159@@ -370,7 +386,7 @@
160 &api =dict/dir =&<eval> "<dir> 20 "( 20 09 20 "[f] 20 ") 00
161
162 @mov/<eval> ( -- )
163- bios/get-depth ?{ !bios/<push-err-un1> }
164+ bios/req-depth1 ?bios/<push-err-underflow>
165 bios/pop path/<move> !dir/<eval>
166 &api =dict/mov =&<eval> "<mov> 20 "( 20 "path 20 09 20 "[f] 20 ") 00
167
168@@ -380,16 +396,18 @@
169 &api =dict/now =&<eval> "<now> 20 "( 20 09 20 "date 20 "time 20 ") 00
170
171 @run/<eval> ( -- )
172- bios/get-depth ?{ !bios/<push-err-un1> }
173+ bios/req-depth1 ?bios/<push-err-underflow>
174 bios/pop path/make
175- ( ? ) DUP2 file/exists ?loader/<run>
176- POP2 !bios/<push-err-404>
177+ ( ? ) DUP2 file/is-oversized ?{
178+ ( ? ) DUP2 file/exists ?loader/<run>
179+ POP2 !bios/<push-err-missing> }
180+ POP2 !bios/<push-err-oversized>
181 &api =dict/run =&<eval> "<run> 20 "( 20 "f.rom 20 09 20 "ok 20 ") 00
182
183 @icn/<eval> ( -- )
184- bios/get-depth ?{ !bios/<push-err-un1> }
185+ bios/req-depth1 ?bios/<push-err-underflow>
186 bios/pop path/make
187- ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-404> }
188+ ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-missing> }
189 ;dict/ok bios/<push>
190 ( >> )
191
192@@ -431,7 +449,7 @@
193 &api =dict/icn =&<eval> "<icn> 20 "( 20 "f.icn 20 09 20 "ok 20 ") 00
194
195 @put/<eval> ( -- )
196- bios/get-depth #02 LTH ?bios/<push-err-un2>
197+ bios/req-depth2 ?bios/<push-err-underflow>
198 bios/pop path/make .File/name DEO2
199 bios/pop DUP2 str/len .File/length DEO2
200 .File/write DEO2
201@@ -439,36 +457,36 @@
202 &api =dict/put =&<eval> "<put> 20 "( 20 "body 20 "f 20 09 20 "ok 20 ") 00
203
204 @get/<eval> ( -- )
205- bios/get-depth ?{ !bios/<push-err-un1> }
206+ bios/req-depth1 ?bios/<push-err-underflow>
207 bios/pop path/make
208- ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-404> }
209- ( ? ) DUP2 file/is-text ?{ POP2 !bios/<push-err-bin> }
210+ ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-missing> }
211+ ( ? ) DUP2 file/is-text ?{ POP2 !bios/<push-err-binary> }
212 dict/alloc-file !bios/<push>
213 &api =dict/get =&<eval> "<get> 20 "( 20 "f 20 09 20 "body 20 ") 00
214
215 @cpy/<eval> ( -- )
216- bios/get-depth #02 LTH ?bios/<push-err-un2>
217+ bios/req-depth2 ?bios/<push-err-underflow>
218 ( dst ) bios/pop path/make
219 ( src ) bios/pop path/make
220- ( ? ) DUP2 file/exists ?{ POP2 POP2 !bios/<push-err-404> }
221+ ( ? ) DUP2 file/exists ?{ POP2 POP2 !bios/<push-err-missing> }
222 SWP2 file/<cpy>
223 ;dict/ok !bios/<push>
224 &api =dict/cpy =&<eval> "<cpy> 20 "( 20 "fsrc 20 "fdst 20 09 20 "ok 20 ") 00
225
226 @era/<eval> ( -- )
227- bios/get-depth ?{ !bios/<push-err-un1> }
228+ bios/req-depth1 ?bios/<push-err-underflow>
229 bios/pop path/make
230- ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-404> }
231+ ( ? ) DUP2 file/exists ?{ POP2 !bios/<push-err-missing> }
232 .File/name DEO2
233 [ LIT2 01 -File/delete ] DEO
234 ;dict/ok !bios/<push>
235 &api =dict/era =&<eval> "<era> 20 "( 20 "f 20 09 20 "ok 20 ") 00
236
237 @ren/<eval> ( -- )
238- bios/get-depth #02 LTH ?bios/<push-err-un2>
239+ bios/req-depth2 ?bios/<push-err-underflow>
240 ( dst ) bios/pop path/make
241 ( src ) bios/pop path/make
242- ( ? ) DUP2 file/exists ?{ POP2 POP2 !bios/<push-err-404> }
243+ ( ? ) DUP2 file/exists ?{ POP2 POP2 !bios/<push-err-missing> }
244 DUP2 ROT2 file/<cpy>
245 .File/name DEO2
246 [ LIT2 01 -File/delete ] DEO
247@@ -476,7 +494,7 @@
248 &api =dict/ren =&<eval> "<ren> 20 "( 20 "fsrc 20 "fdst 20 09 20 "ok 20 ") 00
249
250 @len/<eval> ( -- )
251- bios/get-depth ?{ !bios/<push-err-un1> }
252+ bios/req-depth1 ?bios/<push-err-underflow>
253 bios/pop path/make
254 ( ? ) DUP2 file/exists ?{ POP2 ;dict/zero !bios/<push> }
255 .File/name DEO2
256@@ -486,51 +504,51 @@
257 &buf $5 &api =dict/len =&<eval> "<len> 20 "( 20 "f 20 09 20 "hex 20 ") 00
258
259 @dup/<eval> ( -- )
260- bios/get-depth ?{ !bios/<push-err-un1> }
261+ bios/req-depth1 ?bios/<push-err-underflow>
262 bios/pop DUP2 bios/<push> !bios/<push>
263 &api =dict/dup =&<eval> "<dup> 20 "( 20 "a 20 09 20 "a 20 "a 20 ") 00
264
265 @ovr/<eval> ( -- )
266- bios/get-depth ?{ !bios/<push-err-un1> }
267+ bios/req-depth1 ?bios/<push-err-underflow>
268 ( b ) bios/pop
269 ( a ) bios/pop DUP2 bios/<push>
270 SWP2 bios/<push> !bios/<push>
271 &api =dict/ovr =&<eval> "<ovr> 20 "( 20 "a 20 "b 20 09 20 "a 20 "b 20 "a 20 ") 00
272
273 @pop/<eval> ( -- )
274- bios/get-depth ?{ !bios/<push-err-un1> }
275+ bios/req-depth1 ?bios/<push-err-underflow>
276 bios/pop POP2 JMP2r
277 &api =dict/pop =&<eval> "<pop> 20 "( 20 "a 20 09 20 ") 00
278
279 @swp/<eval> ( -- )
280- bios/get-depth #02 LTH ?bios/<push-err-un2>
281+ bios/req-depth2 ?bios/<push-err-underflow>
282 bios/pop bios/pop SWP2 bios/<push> !bios/<push>
283 &api =dict/swp =&<eval> "<swp> 20 "( 20 "a 20 "b 20 09 20 "b 20 "a 20 ") 00
284
285 @cat/<eval> ( -- )
286- bios/get-depth #02 LTH ?bios/<push-err-un2>
287+ bios/req-depth2 ?bios/<push-err-underflow>
288 bios/pop bios/pop dict/alloc-cat !bios/<push-raw>
289 &api =dict/cat =&<eval> "<cat> 20 "( 20 "a 20 "b 20 09 20 "ab 20 ") 00
290
291 @cmp/<eval> ( -- )
292- bios/get-depth #02 LTH ?bios/<push-err-un2>
293+ bios/req-depth2 ?bios/<push-err-underflow>
294 bios/pop bios/pop str/cmp !bios/<push-bool>
295 &api =dict/cmp =&<eval> "<cmp> 20 "( 20 "a 20 "b 20 09 20 "bool 20 ") 00
296
297 @and/<eval> ( -- )
298- bios/get-depth #02 LTH ?bios/<push-err-un2>
299+ bios/req-depth2 ?bios/<push-err-underflow>
300 ( a ) bios/pop ;dict/t str/cmp
301 ( b ) bios/pop ;dict/t str/cmp AND !bios/<push-bool>
302 &api =dict/and =&<eval> "<and> 20 "( 20 "a 20 "b 20 09 20 "bool 20 ") 00
303
304 @ora/<eval> ( -- )
305- bios/get-depth #02 LTH ?bios/<push-err-un2>
306+ bios/req-depth2 ?bios/<push-err-underflow>
307 ( a ) bios/pop ;dict/t str/cmp
308 ( b ) bios/pop ;dict/t str/cmp ORA !bios/<push-bool>
309 &api =dict/ora =&<eval> "<ora> 20 "( 20 "a 20 "b 20 09 20 "bool 20 ") 00
310
311 @dec/<eval> ( -- )
312- bios/get-depth ?{ !bios/<push-err-un1> }
313+ bios/req-depth1 ?bios/<push-err-underflow>
314 ;&buf ,&ptr STR2
315 bios/pop str/hex
316 ( | dec str )
317@@ -548,7 +566,7 @@
318 &buf $6 &api =dict/dec =&<eval> "<dec> 20 "( 20 "hex 20 09 20 "dec 20 ") 00
319
320 @hex/<eval> ( -- )
321- bios/get-depth ?{ !bios/<push-err-un1> }
322+ bios/req-depth1 ?bios/<push-err-underflow>
323 ;&buf ,&ptr STR2
324 bios/pop str/dec /<push-short>
325 ;&buf str/walk-zero !bios/<push>
326@@ -574,7 +592,7 @@
327 #0f AND DUP #09 GTH #27 MUL ADD LIT "0 ADD JMP2r
328
329 @out/<eval> ( -- )
330- bios/get-depth ?{ !bios/<push-err-un1> }
331+ bios/req-depth1 ?bios/<push-err-underflow>
332 bios/pop !str/<print>
333 &api =dict/out =&<eval> "<out> 20 "( 20 "a 20 09 20 ") 00
334
335@@ -633,14 +651,12 @@
336
337 @dict/alloc-file ( name* -- addr* )
338 .File/name DEO2
339- ;&tmpbuflen .File/length DEO2
340- ;&tmpbuf DUP2 .File/read DEO2
341+ #0001 .File/length DEO2
342 [ LITr _&ptr ] LDR2r
343- &>waf
344- LDAk DUP ?{
345- POP POP2 STH2r #00 !/<push> }
346- /<push>
347- INC2 !/>waf
348+ &>s
349+ ;&b .File/read DEO2
350+ .File/success-lb DEI ?{ STH2r #00 !/<push> }
351+ [ LIT &b $1 ] /<push> !/>s
352
353 (
354 @|Font )
355@@ -657,10 +673,6 @@
356 /<draw-glyph>
357 INC2 !/>w
358
359-@font/<draw-glyph-color> ( c color -- )
360- ,&color STR
361- ( >> )
362-
363 @font/<draw-glyph> ( c -- )
364 DUP #0a NEQ ?{ POP !/<draw-lb> }
365 DUP #09 NEQ ?{ POP !/<draw-tab> }
366@@ -759,6 +771,13 @@
367 ;&bf .File/stat DEO2
368 [ LIT2 "- &bf $1 ] EQU JMP2r
369
370+@file/is-oversized ( path* -- t )
371+ .File/name DEO2
372+ #0004 .File/length DEO2
373+ ;&bufstat .File/stat DEO2
374+ ;&bufstat LDA LIT "? EQU JMP2r
375+ &bufstat $5
376+
377 @file/is-text ( path* -- t )
378 .File/name DEO2
379 #0001 .File/length DEO2
380@@ -963,9 +982,10 @@
381 &t "<true> 00
382 &f "<false> 00
383 &ok "<ok> 00
384- &err-un "<underflow> 00
385- &err-404 "<missing> 00
386- &err-bin "<binary> 00
387+ &err-underflow "<underflow> 00
388+ &err-missing "<missing> 00
389+ &err-binary "<binary> 00
390+ &err-oversized "<oversized> 00
391 &months [
392 "Jan $1 "Feb $1 "Mar $1 "Apr $1
393 "May $1 "Jun $1 "Jul $1 "Aug $1
394@@ -1165,9 +1185,7 @@
395
396 @bios/buf $&buflen
397
398-@dict/tmpbuf $&tmpbuflen
399+@dir/buf $&buflen
400
401 @dict/buf $&buflen
402
403-@dir/buf $&buflen
404-