https://github.com/akkartik/mu/blob/main/shell/environment.mu
1
2
3
4
5
6
7
8 type environment {
9 globals: global-table
10 sandbox: sandbox
11
12 partial-global-name: (handle gap-buffer)
13 go-modal-error: (handle array byte)
14
15 cursor-in-globals?: boolean
16 cursor-in-go-modal?: boolean
17 }
18
19
20 fn test-environment {
21 var env-storage: environment
22 var env/esi: (addr environment) <- address env-storage
23 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
24
25 var screen-on-stack: screen
26 var screen/edi: (addr screen) <- address screen-on-stack
27 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
28
29 type-in env, screen, "(+ 3 4)"
30
31 edit-environment env, 0x13/ctrl-s, 0/no-disk
32 render-environment screen, env
33
34
35 check-screen-row screen, 0/y, " ", "F - test-environment/0"
36 check-screen-row screen, 1/y, " screen: ", "F - test-environment/1"
37 check-background-color-in-screen-row screen, 0/bg, 2/y, " ........ ", "F - test-environment/2"
38 check-background-color-in-screen-row screen, 0/bg, 3/y, " ........ ", "F - test-environment/3"
39 check-background-color-in-screen-row screen, 0/bg, 4/y, " ........ ", "F - test-environment/4"
40 check-screen-row screen, 5/y, " ", "F - test-environment/5"
41 check-screen-row screen, 6/y, " keyboard: ", "F - test-environment/6"
42 check-background-color-in-screen-row screen, 0/bg, 6/y, " ................ ", "F - test-environment/6-2"
43 check-screen-row screen, 7/y, " ", "F - test-environment/7"
44 check-screen-row screen, 8/y, " (+ 3 4) ", "F - test-environment/8"
45 check-screen-row screen, 9/y, " ... trace depth: 4 ", "F - test-environment/9"
46 check-screen-row screen, 0xa/y, " => 7 ", "F - test-environment/10"
47 check-screen-row screen, 0xb/y, " ", "F - test-environment/11"
48 check-screen-row screen, 0xc/y, " ", "F - test-environment/12"
49 check-screen-row screen, 0xd/y, " ", "F - test-environment/13"
50 check-screen-row screen, 0xe/y, " ", "F - test-environment/14"
51
52 check-screen-row screen, 0xf/y, " ^r run main ^s run sandbox ^g go to ^m to trace ^a << ^b <word ^f word> ^e >> ", "F - test-environment/15"
53 }
54
55 fn test-definition-in-environment {
56 var env-storage: environment
57 var env/esi: (addr environment) <- address env-storage
58 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
59
60 var screen-on-stack: screen
61 var screen/edi: (addr screen) <- address screen-on-stack
62 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
63
64 type-in env, screen, "(define f 42)"
65 edit-environment env, 0x13/ctrl-s, 0/no-disk
66 render-environment screen, env
67
68 check-screen-row screen, 0/y, " ", "F - test-definition-in-environment/0"
69
70 check-screen-row screen, 1/y, " (define f 42) screen: ", "F - test-definition-in-environment/1"
71 check-background-color-in-screen-row screen, 0/bg, 2/y, " ........ ", "F - test-environment/2"
72 check-background-color-in-screen-row screen, 0/bg, 3/y, " ........ ", "F - test-environment/3"
73 check-background-color-in-screen-row screen, 0/bg, 4/y, " ........ ", "F - test-environment/4"
74 check-screen-row screen, 5/y, " ", "F - test-definition-in-environment/4"
75 check-screen-row screen, 6/y, " keyboard: ", "F - test-definition-in-environment/5"
76 check-background-color-in-screen-row screen, 0/bg, 6/y, " ................ ", "F - test-definition-in-environment/5-2"
77 check-screen-row screen, 7/y, " ", "F - test-definition-in-environment/6"
78 check-screen-row screen, 8/y, " ", "F - test-definition-in-environment/7"
79
80 check-screen-row screen, 9/y, " ... trace depth: 4 ", "F - test-definition-in-environment/8"
81 }
82
83
84 fn type-in self: (addr environment), screen: (addr screen), keys: (addr array byte) {
85
86 edit-environment self, 0x15/ctrl-u, 0/no-disk
87 render-environment screen, self
88
89 var input-stream-storage: (stream byte 0x40/capacity)
90 var input-stream/ecx: (addr stream byte) <- address input-stream-storage
91 write input-stream, keys
92 {
93 var done?/eax: boolean <- stream-empty? input-stream
94 compare done?, 0/false
95 break-if-!=
96 var key/eax: grapheme <- read-grapheme input-stream
97 edit-environment self, key, 0/no-disk
98 render-environment screen, self
99 loop
100 }
101 }
102
103 fn initialize-environment _self: (addr environment), fake-screen-width: int, fake-screen-height: int {
104 var self/esi: (addr environment) <- copy _self
105 var globals/eax: (addr global-table) <- get self, globals
106 initialize-globals globals
107 var sandbox/eax: (addr sandbox) <- get self, sandbox
108 initialize-sandbox sandbox, fake-screen-width, fake-screen-height
109 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
110 allocate partial-global-name-ah
111 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
112 initialize-gap-buffer partial-global-name, 0x40/global-name-capacity
113 }
114
115 fn render-environment screen: (addr screen), _self: (addr environment) {
116
117
118
119 var self/esi: (addr environment) <- copy _self
120 var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
121 var cursor-in-globals?/eax: boolean <- copy *cursor-in-globals-a
122 var globals/ecx: (addr global-table) <- get self, globals
123 render-globals screen, globals, cursor-in-globals?
124 var sandbox/edx: (addr sandbox) <- get self, sandbox
125 var cursor-in-sandbox?/ebx: boolean <- copy 1/true
126 cursor-in-sandbox? <- subtract cursor-in-globals?
127 render-sandbox screen, sandbox, 0x55/sandbox-left-margin, 0/sandbox-top-margin, 0x80/screen-width, 0x2f/screen-height-without-menu, cursor-in-sandbox?
128
129 {
130 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
131 compare *cursor-in-go-modal-a, 0/false
132 break-if-=
133 render-go-modal screen, self
134 render-go-modal-menu screen, self
135 return
136 }
137
138 {
139 var cursor-in-globals?/eax: (addr boolean) <- get self, cursor-in-globals?
140 compare *cursor-in-globals?, 0/false
141 break-if-=
142 render-globals-menu screen, globals
143 return
144 }
145 render-sandbox-menu screen, sandbox
146 }
147
148 fn edit-environment _self: (addr environment), key: grapheme, data-disk: (addr disk) {
149 var self/esi: (addr environment) <- copy _self
150 var globals/edi: (addr global-table) <- get self, globals
151 var sandbox/ecx: (addr sandbox) <- get self, sandbox
152
153
154 {
155 compare key, 0x12/ctrl-r
156 break-if-!=
157 var tmp/eax: (addr handle cell) <- copy 0
158 var nil: (handle cell)
159 tmp <- address nil
160 allocate-pair tmp
161
162 var real-keyboard: (handle cell)
163 tmp <- address real-keyboard
164 allocate-keyboard tmp
165
166 var args: (handle cell)
167 tmp <- address args
168 new-pair tmp, real-keyboard, nil
169
170 var real-screen: (handle cell)
171 tmp <- address real-screen
172 allocate-screen tmp
173
174 tmp <- address args
175 new-pair tmp, real-screen, *tmp
176
177 var main: (handle cell)
178 tmp <- address main
179 new-symbol tmp, "main"
180
181 tmp <- address args
182 new-pair tmp, main, *tmp
183
184 clear-screen 0/screen
185 set-cursor-position 0/screen, 0, 0
186
187 var out: (handle cell)
188 var out-ah/ecx: (addr handle cell) <- address out
189 var trace-storage: trace
190 var trace/ebx: (addr trace) <- address trace-storage
191 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
192 evaluate tmp, out-ah, nil, globals, trace, 0/no-fake-screen, 0/no-fake-keyboard, 0/definitions-created, 0/call-number
193
194 {
195 var tmp/eax: byte <- read-key 0/keyboard
196 compare tmp, 0
197 loop-if-=
198 }
199
200 return
201 }
202
203 {
204 compare key, 0x13/ctrl-s
205 break-if-!=
206 {
207
208 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
209 compare *cursor-in-go-modal-a, 0/false
210 break-if-!=
211 {
212
213 var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
214 compare *cursor-in-globals-a, 0/false
215 break-if-=
216 edit-globals globals, key
217 }
218
219 edit-sandbox sandbox, key, globals, data-disk
220 }
221 return
222 }
223
224 {
225 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
226 compare *cursor-in-go-modal-a, 0/false
227 break-if-=
228
229
230 {
231 compare key, 0x20/space
232 break-if-!=
233 return
234 }
235
236 {
237 compare key, 0x1b/escape
238 break-if-!=
239 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
240 copy-to *cursor-in-go-modal-a, 0/false
241 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
242 clear-object go-modal-error-ah
243 return
244 }
245
246 {
247 compare key, 0xa/newline
248 break-if-!=
249
250 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
251 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
252 {
253 var empty?/eax: boolean <- gap-buffer-empty? partial-global-name
254 compare empty?, 0/false
255 break-if-=
256 var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
257 copy-to *cursor-in-globals-a, 0/false
258
259 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
260 clear-object go-modal-error-ah
261
262 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
263 copy-to *cursor-in-go-modal-a, 0/false
264 return
265 }
266
267 var name-storage: (stream byte 0x40)
268 var name/ecx: (addr stream byte) <- address name-storage
269 emit-gap-buffer partial-global-name, name
270
271 var index/ecx: int <- find-symbol-in-globals globals, name
272
273 {
274 compare index, 0
275 break-if->=
276 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
277 copy-array-object "no such global", go-modal-error-ah
278 return
279 }
280
281 clear-gap-buffer partial-global-name
282 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
283 clear-object go-modal-error-ah
284 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
285 copy-to *cursor-in-go-modal-a, 0/false
286
287 var globals-cursor-index/eax: (addr int) <- get globals, cursor-index
288 copy-to *globals-cursor-index, index
289 var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
290 copy-to *cursor-in-globals-a, 1/true
291 return
292 }
293
294 {
295 compare key, 0xd/ctrl-m
296 break-if-!=
297
298 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
299 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
300 {
301 var empty?/eax: boolean <- gap-buffer-empty? partial-global-name
302 compare empty?, 0/false
303 break-if-=
304 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
305 copy-array-object "create what?", go-modal-error-ah
306 return
307 }
308
309 var name-storage: (stream byte 0x40)
310 var name/edx: (addr stream byte) <- address name-storage
311 emit-gap-buffer partial-global-name, name
312
313 var index/ecx: int <- find-symbol-in-globals globals, name
314
315 {
316 compare index, 0
317 break-if-<
318 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
319 copy-array-object "already exists", go-modal-error-ah
320 return
321 }
322
323 clear-gap-buffer partial-global-name
324 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
325 clear-object go-modal-error-ah
326 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
327 copy-to *cursor-in-go-modal-a, 0/false
328
329 create-empty-global globals, name, 0x2000/default-gap-buffer-size=8KB
330 var globals-final-index/eax: (addr int) <- get globals, final-index
331 var new-index/ecx: int <- copy *globals-final-index
332 var globals-cursor-index/eax: (addr int) <- get globals, cursor-index
333 copy-to *globals-cursor-index, new-index
334 var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
335 copy-to *cursor-in-globals-a, 1/true
336 return
337 }
338
339 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
340 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
341 edit-gap-buffer partial-global-name, key
342 return
343 }
344
345 {
346 compare key, 7/ctrl-g
347 break-if-!=
348
349 var current-word-storage: (stream byte 0x40)
350 var current-word/edi: (addr stream byte) <- address current-word-storage
351 word-at-cursor self, current-word
352 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
353 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
354 clear-gap-buffer partial-global-name
355 load-gap-buffer-from-stream partial-global-name, current-word
356
357 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
358 copy-to *cursor-in-go-modal-a, 1/true
359 return
360 }
361
362 {
363 var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
364 compare *cursor-in-globals-a, 0/false
365 break-if-=
366 edit-globals globals, key
367 return
368 }
369 edit-sandbox sandbox, key, globals, data-disk
370 }
371
372 fn read-and-evaluate-and-save-gap-buffer-to-globals _in-ah: (addr handle gap-buffer), result-ah: (addr handle cell), globals: (addr global-table), definitions-created: (addr stream int), trace: (addr trace), inner-screen-var: (addr handle cell), inner-keyboard-var: (addr handle cell) {
373 var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
374 var in/eax: (addr gap-buffer) <- lookup *in-ah
375 var read-result-h: (handle cell)
376 var read-result-ah/esi: (addr handle cell) <- address read-result-h
377 read-cell in, read-result-ah, trace
378 var error?/eax: boolean <- has-errors? trace
379 {
380 compare error?, 0/false
381 break-if-=
382 return
383 }
384 macroexpand read-result-ah, globals, trace
385 var error?/eax: boolean <- has-errors? trace
386 {
387 compare error?, 0/false
388 break-if-=
389 return
390 }
391 var nil-h: (handle cell)
392 var nil-ah/eax: (addr handle cell) <- address nil-h
393 allocate-pair nil-ah
394
395
396 var call-number-storage: int
397 var call-number/edi: (addr int) <- address call-number-storage
398 debug-print "^", 4/fg, 0/bg
399 evaluate read-result-ah, result-ah, *nil-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
400 debug-print "$", 4/fg, 0/bg
401 var error?/eax: boolean <- has-errors? trace
402 {
403 compare error?, 0/false
404 break-if-=
405 return
406 }
407
408 mark-lines-dirty trace
409
410
411
412 stash-gap-buffer-to-globals globals, definitions-created, _in-ah
413 }
414
415 fn test-go-modal {
416 var env-storage: environment
417 var env/esi: (addr environment) <- address env-storage
418 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
419
420 var screen-on-stack: screen
421 var screen/edi: (addr screen) <- address screen-on-stack
422 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
423
424 edit-environment env, 7/ctrl-g, 0/no-disk
425 render-environment screen, env
426
427 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal/0"
428 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal/1"
429 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal/2"
430 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal/3"
431 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal/4"
432 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal/5"
433 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-go-modal/6-text"
434 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal/6"
435 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal/7"
436
437 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal/8-cursor"
438 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ............................................................... ", "F - test-go-modal/8"
439 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal/9"
440 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal/10"
441 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal/11"
442 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal/12"
443 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal/13"
444 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal/14"
445
446 check-screen-row screen, 0xf/y, " ^r run main enter go ^m create esc cancel ^a << ^b <word ^f word> ^e >> ", "F - test-go-modal/15-text"
447 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal/15"
448 }
449
450 fn test-leave-go-modal {
451 var env-storage: environment
452 var env/esi: (addr environment) <- address env-storage
453 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
454
455 var screen-on-stack: screen
456 var screen/edi: (addr screen) <- address screen-on-stack
457 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
458
459 edit-environment env, 7/ctrl-g, 0/no-disk
460 render-environment screen, env
461
462 edit-environment env, 0x1b/escape, 0/no-disk
463 render-environment screen, env
464
465 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-leave-go-modal/0"
466 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-leave-go-modal/1"
467 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-leave-go-modal/2"
468 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-leave-go-modal/3"
469 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-leave-go-modal/4"
470 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-leave-go-modal/5"
471 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-leave-go-modal/6"
472 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-leave-go-modal/7"
473 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-leave-go-modal/8"
474 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-leave-go-modal/9"
475 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-leave-go-modal/10"
476 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-leave-go-modal/11"
477 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-leave-go-modal/12"
478 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-leave-go-modal/13"
479 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-leave-go-modal/14"
480 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-leave-go-modal/15"
481 }
482
483 fn test-jump-to-global {
484 var env-storage: environment
485 var env/esi: (addr environment) <- address env-storage
486 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
487
488 var screen-on-stack: screen
489 var screen/edi: (addr screen) <- address screen-on-stack
490 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
491
492 type-in env, screen, "(define f 42)"
493 edit-environment env, 0x13/ctrl-s, 0/no-disk
494 render-environment screen, env
495
496 edit-environment env, 7/ctrl-g, 0/no-disk
497 render-environment screen, env
498
499 type-in env, screen, "f"
500
501 edit-environment env, 0xa/newline, 0/no-disk
502 render-environment screen, env
503
504
505 check-screen-row screen, 1/y, " (define f 42) screen: ", "F - test-jump-to-global/1"
506 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-jump-to-global/1-cursor"
507
508 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-global/bg0"
509 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-global/bg1"
510 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-global/bg2"
511 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-global/bg3"
512 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-global/bg4"
513 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-global/bg5"
514 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-jump-to-global/bg6"
515 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-jump-to-global/bg7"
516 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-jump-to-global/bg8"
517 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-global/bg9"
518 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-global/bg10"
519 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-global/bg11"
520 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-global/bg12"
521 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-global/bg13"
522 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-global/bg14"
523 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-global/bg15"
524 }
525
526 fn test-go-modal-prepopulates-word-at-cursor {
527 var env-storage: environment
528 var env/esi: (addr environment) <- address env-storage
529 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
530
531 var screen-on-stack: screen
532 var screen/edi: (addr screen) <- address screen-on-stack
533 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
534
535 type-in env, screen, "fn1"
536
537 edit-environment env, 7/ctrl-g, 0/no-disk
538 render-environment screen, env
539
540 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/0"
541 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/1"
542 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/2"
543 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/3"
544 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/4"
545 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/5"
546 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-go-modal-prepopulates-word-at-cursor/6-text"
547 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/6"
548 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/7"
549
550 check-screen-row screen, 8/y, " fn1 ", "F - test-go-modal-prepopulates-word-at-cursor/8-text"
551
552 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/8-cursor"
553 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ... ............................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/8"
554 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/9"
555 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/10"
556 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/11"
557 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/12"
558 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/13"
559 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/14"
560 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/15"
561
562 edit-environment env, 0x1b/escape, 0/no-disk
563 render-environment screen, env
564
565 edit-environment env, 0x20/space, 0/no-disk
566 render-environment screen, env
567
568 edit-environment env, 7/ctrl-g, 0/no-disk
569 render-environment screen, env
570
571 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-0"
572 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-1"
573 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-2"
574 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-3"
575 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-4"
576 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-5"
577 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-go-modal-prepopulates-word-at-cursor/test2-6-text"
578 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test2-6"
579 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test2-7"
580
581 check-screen-row screen, 8/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-text"
582
583 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-cursor"
584 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ............................................................... ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8"
585 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-9"
586 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-10"
587 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-11"
588 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-12"
589 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-13"
590 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-14"
591 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-15"
592
593 edit-environment env, 0x1b/escape, 0/no-disk
594 render-environment screen, env
595
596 edit-environment env, 0x80/left-arrow, 0/no-disk
597 render-environment screen, env
598 edit-environment env, 0x80/left-arrow, 0/no-disk
599 render-environment screen, env
600
601 edit-environment env, 7/ctrl-g, 0/no-disk
602 render-environment screen, env
603
604 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-0"
605 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-1"
606 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-2"
607 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-3"
608 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-4"
609 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-5"
610 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-go-modal-prepopulates-word-at-cursor/test3-6-text"
611 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-6"
612 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-7"
613
614 check-screen-row screen, 8/y, " fn1 ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-text"
615
616 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-cursor"
617 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ... ............................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8"
618 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-9"
619 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-10"
620 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-11"
621 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-12"
622 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-13"
623 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-14"
624 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-15"
625 }
626
627 fn test-jump-to-nonexistent-global {
628 var env-storage: environment
629 var env/esi: (addr environment) <- address env-storage
630 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
631
632 var screen-on-stack: screen
633 var screen/edi: (addr screen) <- address screen-on-stack
634 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
635
636 type-in env, screen, "f"
637
638 edit-environment env, 7/ctrl-g, 0/no-disk
639 render-environment screen, env
640
641 edit-environment env, 0xa/newline, 0/no-disk
642 render-environment screen, env
643
644
645 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-nonexistent-global/0"
646 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-nonexistent-global/1"
647 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-nonexistent-global/2"
648 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-nonexistent-global/3"
649 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-nonexistent-global/4"
650 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-nonexistent-global/5"
651 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-jump-to-nonexistent-global/6-text"
652 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/6"
653 check-screen-row-in-color screen, 4/fg=error, 7/y, " no such global ", "F - test-jump-to-nonexistent-global/7-text"
654 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/7"
655 check-screen-row screen, 8/y, " f ", "F - test-jump-to-nonexistent-global/8-text"
656 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-jump-to-nonexistent-global/8-cursor"
657 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-jump-to-nonexistent-global/8"
658 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-nonexistent-global/9"
659 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-nonexistent-global/10"
660 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-nonexistent-global/11"
661 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-nonexistent-global/12"
662 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-nonexistent-global/13"
663 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-nonexistent-global/14"
664
665 check-screen-row screen, 0xf/y, " ^r run main enter go ^m create esc cancel ^a << ^b <word ^f word> ^e >> ", "F - test-jump-to-nonexistent-global/15-text"
666 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-nonexistent-global/15"
667
668 edit-environment env, 0x1b/escape, 0/no-disk
669 render-environment screen, env
670
671 edit-environment env, 7/ctrl-g, 0/no-disk
672 render-environment screen, env
673
674 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-nonexistent-global/test2-0"
675 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-nonexistent-global/test2-1"
676 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-nonexistent-global/test2-2"
677 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-nonexistent-global/test2-3"
678 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-nonexistent-global/test2-4"
679 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-nonexistent-global/test2-5"
680 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-jump-to-nonexistent-global/test2-6-text"
681 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/test2-6"
682 check-screen-row-in-color screen, 4/fg=error, 7/y, " ", "F - test-jump-to-nonexistent-global/test2-7-text"
683 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/test2-7"
684
685 check-screen-row screen, 8/y, " f ", "F - test-jump-to-nonexistent-global/test2-8-text"
686
687 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-jump-to-nonexistent-global/test2-8-cursor"
688 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-jump-to-nonexistent-global/test2-8"
689 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-nonexistent-global/test2-9"
690 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-nonexistent-global/test2-10"
691 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-nonexistent-global/test2-11"
692 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-nonexistent-global/test2-12"
693 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-nonexistent-global/test2-13"
694 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-nonexistent-global/test2-14"
695 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-nonexistent-global/test2-15"
696 }
697
698 fn test-create-global {
699 var env-storage: environment
700 var env/esi: (addr environment) <- address env-storage
701 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
702
703 var screen-on-stack: screen
704 var screen/edi: (addr screen) <- address screen-on-stack
705 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
706
707 edit-environment env, 7/ctrl-g, 0/no-disk
708 render-environment screen, env
709
710 type-in env, screen, "fn1"
711
712 edit-environment env, 0xd/ctrl-m, 0/no-disk
713 render-environment screen, env
714
715
716 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-create-global/1-cursor"
717
718 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-global/bg0"
719 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-global/bg1"
720 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-global/bg2"
721 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-global/bg3"
722 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-global/bg4"
723 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-global/bg5"
724 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-create-global/bg6"
725 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-create-global/bg7"
726 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-create-global/bg8"
727 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-global/bg9"
728 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-global/bg10"
729 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-global/bg11"
730 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-global/bg12"
731 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-global/bg13"
732 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-global/bg14"
733 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-global/bg15"
734 }
735
736 fn test-create-nonexistent-global {
737 var env-storage: environment
738 var env/esi: (addr environment) <- address env-storage
739 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
740
741 var screen-on-stack: screen
742 var screen/edi: (addr screen) <- address screen-on-stack
743 initialize-screen screen, 0x80/width=72, 0x10/height, 0/no-pixel-graphics
744
745 type-in env, screen, "(define f 42)"
746 edit-environment env, 0x13/ctrl-s, 0/no-disk
747 render-environment screen, env
748
749 type-in env, screen, "f"
750
751 edit-environment env, 7/ctrl-g, 0/no-disk
752 render-environment screen, env
753
754 edit-environment env, 0xd/ctrl-m, 0/no-disk
755 render-environment screen, env
756
757
758 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-nonexistent-global/0"
759 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-nonexistent-global/1"
760 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-nonexistent-global/2"
761 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-nonexistent-global/3"
762 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-nonexistent-global/4"
763 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-nonexistent-global/5"
764 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-create-nonexistent-global/6-text"
765 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-create-nonexistent-global/6"
766 check-screen-row-in-color screen, 4/fg=error, 7/y, " already exists ", "F - test-create-nonexistent-global/7-text"
767 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-create-nonexistent-global/7"
768 check-screen-row-in-color screen, 0/fg, 8/y, " f ", "F - test-create-nonexistent-global/8-text"
769 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-create-nonexistent-global/8-cursor"
770 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-create-nonexistent-global/8"
771 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-nonexistent-global/9"
772 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-nonexistent-global/10"
773 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-nonexistent-global/11"
774 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-nonexistent-global/12"
775 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-nonexistent-global/13"
776 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-nonexistent-global/14"
777
778 check-screen-row screen, 0xf/y, " ^r run main enter go ^m create esc cancel ^a << ^b <word ^f word> ^e >> ", "F - test-create-nonexistent-global/15-text"
779 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-nonexistent-global/15"
780
781 edit-environment env, 0x1b/escape, 0/no-disk
782 render-environment screen, env
783
784 edit-environment env, 7/ctrl-g, 0/no-disk
785 render-environment screen, env
786
787 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-nonexistent-global/test2-0"
788 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-nonexistent-global/test2-1"
789 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-nonexistent-global/test2-2"
790 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-nonexistent-global/test2-3"
791 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-nonexistent-global/test2-4"
792 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-nonexistent-global/test2-5"
793 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-create-nonexistent-global/test2-6-text"
794 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-create-nonexistent-global/test2-6"
795 check-screen-row-in-color screen, 4/fg=error, 7/y, " ", "F - test-create-nonexistent-global/test2-7-text"
796 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-create-nonexistent-global/test2-7"
797
798 check-screen-row-in-color screen, 0/fg, 8/y, " f ", "F - test-create-nonexistent-global/test2-8-text"
799
800 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-create-nonexistent-global/test2-8-cursor"
801 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-create-nonexistent-global/test2-8"
802 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-nonexistent-global/test2-9"
803 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-nonexistent-global/test2-10"
804 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-nonexistent-global/test2-11"
805 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-nonexistent-global/test2-12"
806 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-nonexistent-global/test2-13"
807 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-nonexistent-global/test2-14"
808 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-nonexistent-global/test2-15"
809 }
810
811 fn render-go-modal screen: (addr screen), _self: (addr environment) {
812 var self/esi: (addr environment) <- copy _self
813 var width/eax: int <- copy 0
814 var height/ecx: int <- copy 0
815 width, height <- screen-size screen
816
817 var xmin: int
818 var tmp/edx: int <- copy width
819 tmp <- shift-right 1
820 tmp <- subtract 0x20/half-global-name-capacity
821 {
822 compare tmp, 0
823 break-if->=
824 tmp <- copy 0
825 }
826 copy-to xmin, tmp
827
828 var xmax: int
829 tmp <- copy width
830 tmp <- shift-right 1
831 tmp <- add 0x20/half-global-name-capacity
832 {
833 compare tmp, width
834 break-if-<=
835 tmp <- copy width
836 }
837 copy-to xmax, tmp
838
839 var ymin: int
840 tmp <- copy height
841 tmp <- shift-right 1
842 tmp <- subtract 2
843 copy-to ymin, tmp
844
845 var ymax: int
846 tmp <- add 3
847 copy-to ymax, tmp
848
849 clear-rect screen, xmin, ymin, xmax, ymax, 0xf/bg=modal
850 add-to xmin, 4
851 set-cursor-position screen, xmin, ymin
852 draw-text-rightward-from-cursor screen, "go to global (or leave blank to go to REPL)", xmax, 8/fg=dark-grey, 0xf/bg=modal
853 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
854 var _partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
855 var partial-global-name/edx: (addr gap-buffer) <- copy _partial-global-name
856 subtract-from xmin, 4
857 increment ymin
858 {
859 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
860 var go-modal-error/eax: (addr array byte) <- lookup *go-modal-error-ah
861 compare go-modal-error, 0
862 break-if-=
863 var dummy/eax: int <- draw-text-rightward screen, go-modal-error, xmin, xmax, ymin, 4/fg=error, 0xf/bg=modal
864 }
865 increment ymin
866 var dummy/eax: int <- copy 0
867 var dummy2/ecx: int <- copy 0
868 dummy, dummy2 <- render-gap-buffer-wrapping-right-then-down screen, partial-global-name, xmin, ymin, xmax, ymax, 1/always-render-cursor, 0/fg=black, 0xf/bg=modal
869 }
870
871 fn render-go-modal-menu screen: (addr screen), _self: (addr environment) {
872 var self/esi: (addr environment) <- copy _self
873 var _width/eax: int <- copy 0
874 var height/ecx: int <- copy 0
875 _width, height <- screen-size screen
876 var width/edx: int <- copy _width
877 var y/ecx: int <- copy height
878 y <- decrement
879 var height/ebx: int <- copy y
880 height <- increment
881 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
882 set-cursor-position screen, 0/x, y
883 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight
884 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg
885 draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0xc/bg=menu-really-highlight
886 draw-text-rightward-from-cursor screen, " go ", width, 7/fg, 0xc5/bg=blue-bg
887 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 0xc/bg=menu-really-highlight
888 draw-text-rightward-from-cursor screen, " create ", width, 7/fg, 0xc5/bg=blue-bg
889 draw-text-rightward-from-cursor screen, " esc ", width, 0/fg, 0x5c/bg=menu-highlight
890 draw-text-rightward-from-cursor screen, " cancel ", width, 7/fg, 0xc5/bg=blue-bg
891 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight
892 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg
893 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight
894 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg
895 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight
896 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg
897 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight
898 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg
899 }
900
901 fn word-at-cursor _self: (addr environment), out: (addr stream byte) {
902 var self/esi: (addr environment) <- copy _self
903 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
904 compare *cursor-in-go-modal-a, 0/false
905 {
906 break-if-=
907
908 return
909 }
910 var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
911 compare *cursor-in-globals-a, 0/false
912 {
913 break-if-=
914
915 var globals/eax: (addr global-table) <- get self, globals
916 var cursor-index-addr/ecx: (addr int) <- get globals, cursor-index
917 var cursor-index/ecx: int <- copy *cursor-index-addr
918 var globals-data-ah/eax: (addr handle array global) <- get globals, data
919 var globals-data/eax: (addr array global) <- lookup *globals-data-ah
920 var cursor-offset/ecx: (offset global) <- compute-offset globals-data, cursor-index
921 var curr-global/eax: (addr global) <- index globals-data, cursor-offset
922 var curr-global-data-ah/eax: (addr handle gap-buffer) <- get curr-global, input
923 var curr-global-data/eax: (addr gap-buffer) <- lookup *curr-global-data-ah
924 word-at-gap curr-global-data, out
925 return
926 }
927
928 var sandbox/ecx: (addr sandbox) <- get self, sandbox
929 var sandbox-data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
930 var sandbox-data/eax: (addr gap-buffer) <- lookup *sandbox-data-ah
931 word-at-gap sandbox-data, out
932 }
933
934
935 fn load-state _self: (addr environment), data-disk: (addr disk) {
936 var self/esi: (addr environment) <- copy _self
937
938 var s-storage: (stream byte 0x2000)
939 var s/ebx: (addr stream byte) <- address s-storage
940 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
941 move-cursor-to-left-margin-of-next-line 0/screen
942 load-sectors data-disk, 0/lba, 0x10/sectors, s
943
944
945 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
946 move-cursor-to-left-margin-of-next-line 0/screen
947 var sandbox/eax: (addr sandbox) <- get self, sandbox
948 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
949 var data/eax: (addr gap-buffer) <- lookup *data-ah
950 load-gap-buffer-from-stream data, s
951 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into gap buffer", 3/fg, 0/bg
952 move-cursor-to-left-margin-of-next-line 0/screen
953 clear-stream s
954
955 var initial-root-storage: (handle cell)
956 var initial-root/ecx: (addr handle cell) <- address initial-root-storage
957 var trace-storage: trace
958 var trace/edi: (addr trace) <- address trace-storage
959 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
960 read-cell data, initial-root, trace
961 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into s-expressions", 3/fg, 0/bg
962 move-cursor-to-left-margin-of-next-line 0/screen
963 clear-gap-buffer data
964
965 {
966 var initial-root-addr/eax: (addr cell) <- lookup *initial-root
967 compare initial-root-addr, 0
968 break-if-!=
969 return
970 }
971
972 var globals-literal-storage: (handle cell)
973 var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
974 new-symbol globals-literal-ah, "globals"
975 var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
976 var globals-cell-storage: (handle cell)
977 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
978 clear-trace trace
979 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
980 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
981 {
982 compare globals-cell, 0
983 break-if-=
984 var globals/eax: (addr global-table) <- get self, globals
985 load-globals globals-cell-ah, globals
986 }
987
988 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
989 var sandbox-literal-storage: (handle cell)
990 var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
991 new-symbol sandbox-literal-ah, "sandbox"
992 var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
993 var sandbox-cell-storage: (handle cell)
994 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
995 clear-trace trace
996 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
997 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
998 {
999 compare sandbox-cell, 0
1000 break-if-=
1001
1002 clear-trace trace
1003 print-cell sandbox-cell-ah, s, trace
1004
1005 var sandbox/eax: (addr sandbox) <- get self, sandbox
1006 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
1007 var data/eax: (addr gap-buffer) <- lookup *data-ah
1008 load-gap-buffer-from-stream data, s
1009 }
1010 }
1011
1012
1013
1014
1015
1016 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
1017 compare data-disk, 0/no-disk
1018 {
1019 break-if-!=
1020 return
1021 }
1022 var stream-storage: (stream byte 0x2000)
1023 var stream/edi: (addr stream byte) <- address stream-storage
1024 write stream, "(\n"
1025 write-globals stream, globals
1026 write-sandbox stream, sandbox
1027 write stream, ")\n"
1028 store-sectors data-disk, 0/lba, 0x10/sectors, stream
1029 }