| blob | 439d5423cb237eb6e36008a92838cc41112f4686 |
1 # The top-level data structure for the Mu shell.
2 #
3 # vim:textwidth&
4 # It would be nice for tests to use a narrower screen than the standard 0x80 of
5 # 1024 pixels with 8px-wide code-point-utf8s. But it complicates rendering logic to
6 # make width configurable, so we just use longer lines than usual.
8 type environment {
9 globals: global-table
10 sandbox: sandbox
11 # some state for a modal dialog for navigating between globals
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 }
19 # Here's a sample usage session and what it will look like on the screen.
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 # setup: screen
25 var screen-on-stack: screen
26 var screen/edi: (addr screen) <- address screen-on-stack
27 initialize-screen screen, 0x80/width, 0x30/height, 0/no-pixel-graphics
28 # type some code into sandbox
29 type-in env, screen, "(+ 3 4)" # we don't have any global definitions here, so no macros
30 # run code in sandbox
31 edit-environment env, 0x13/ctrl-s, 0/no-disk
32 render-environment screen, env
33 # | global definitions | sandbox
34 # top row blank for now
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 # bottom row is for a wordstar-style menu
52 check-screen-row screen, 0x2f/y, " ^r run main ^s run sandbox ^g go to ^m to trace ^a << ^b <word ^f word> ^e >> ", "F - test-environment/15"
53 }
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 # setup: screen
60 var screen-on-stack: screen
61 var screen/edi: (addr screen) <- address screen-on-stack
62 initialize-screen screen, 0x80/width, 0x30/height, 0/no-pixel-graphics
63 # define a global on the right (sandbox) side
64 type-in env, screen, "(define f 42)"
65 edit-environment env, 0x13/ctrl-s, 0/no-disk
66 render-environment screen, env
67 # | global definitions | sandbox
68 check-screen-row screen, 0/y, " ", "F - test-definition-in-environment/0"
69 # global definition is now on the left side
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-definition-in-environment/2"
72 check-background-color-in-screen-row screen, 0/bg, 3/y, " ........ ", "F - test-definition-in-environment/3"
73 check-background-color-in-screen-row screen, 0/bg, 4/y, " ........ ", "F - test-definition-in-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 # you can still see the trace on the right for what you just added to the left
80 check-screen-row screen, 9/y, " ... trace depth: 4 ", "F - test-definition-in-environment/8"
81 }
83 # helper for testing
84 fn type-in self: (addr environment), screen: (addr screen), keys: (addr array byte) {
85 # clear the buffer
86 edit-environment self, 0x15/ctrl-u, 0/no-disk
87 render-environment screen, self
88 # type in all the keys
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: code-point-utf8 <- read-code-point-utf8 input-stream
97 edit-environment self, key, 0/no-disk
98 render-environment screen, self
99 loop
100 }
101 }
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 }
115 fn render-environment screen: (addr screen), _self: (addr environment) {
116 # globals layout: 1 char padding, 41 code, 1 padding, 41 code, 1 padding = 85
117 # sandbox layout: 1 padding, 41 code, 1 padding = 43
118 # total = 128 chars
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 # modal if necessary
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 # render menu
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 }
148 fn edit-environment _self: (addr environment), key: code-point-utf8, 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 # ctrl-r
153 # Assumption: 'real-screen' and 'real-keyboard' are 0
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 # (main real-screen real-keyboard)
162 var real-keyboard: (handle cell)
163 tmp <- address real-keyboard
164 allocate-keyboard tmp
165 # args = cons(real-keyboard, nil)
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 # args = cons(real-screen, args)
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 # args = cons(main, args)
181 tmp <- address args
182 new-pair tmp, main, *tmp
183 # clear real screen
184 clear-screen 0/screen
185 set-cursor-position 0/screen, 0, 0
186 # run
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 # wait for a keypress
194 {
195 var tmp/eax: byte <- read-key 0/keyboard
196 compare tmp, 0
197 loop-if-=
198 }
199 #
200 return
201 }
202 # ctrl-s: send multiple places
203 {
204 compare key, 0x13/ctrl-s
205 break-if-!=
206 {
207 # cursor in go modal? do nothing
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 # cursor in globals? update current definition
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 # update sandbox whether the cursor is in globals or sandbox
219 edit-sandbox sandbox, key, globals, data-disk
220 }
221 return
222 }
223 # dispatch to go modal if necessary
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 # nested events for modal dialog
229 # ignore spaces
230 {
231 compare key, 0x20/space
232 break-if-!=
233 return
234 }
235 # esc = exit modal dialog
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 # enter = switch to global name and exit modal dialog
246 {
247 compare key, 0xa/newline
248 break-if-!=
249 # if no global name typed in, switch to sandbox
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 # reset error state
259 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
260 clear-object go-modal-error-ah
261 # done with go modal
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 # turn global name into a stream
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 # compute global index
271 var curr-index/ecx: int <- find-symbol-in-globals globals, name
272 # if global not found, set error and return
273 {
274 compare curr-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 # if global is a primitive, set error and return
281 {
282 var global-data-ah/eax: (addr handle array global) <- get globals, data
283 var global-data/eax: (addr array global) <- lookup *global-data-ah
284 var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
285 var curr/ebx: (addr global) <- index global-data, curr-offset
286 var primitive?/eax: boolean <- primitive-global? curr
287 compare primitive?, 0/false
288 break-if-=
289 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
290 copy-array-object "sorry, primitives can't be edited yet", go-modal-error-ah
291 return
292 }
293 # otherwise clear modal state
294 clear-gap-buffer partial-global-name
295 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
296 clear-object go-modal-error-ah
297 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
298 copy-to *cursor-in-go-modal-a, 0/false
299 # switch focus to global at index
300 #? set-cursor-position 0/screen, 0x20/x 0x20/y
301 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, curr-index, 7/fg 0/bg
302 bump-global globals, curr-index
303 #? var curr-index2/ecx: int <- cursor-global globals
304 #? draw-int32-decimal-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, curr-index2, 4/fg 0/bg
305 #? abort "a"
306 var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
307 copy-to *cursor-in-globals-a, 1/true
308 return
309 }
310 # ctrl-m = create given global name and exit modal dialog
311 {
312 compare key, 0xd/ctrl-m
313 break-if-!=
314 # if no global name typed in, set error and return
315 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
316 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
317 {
318 var empty?/eax: boolean <- gap-buffer-empty? partial-global-name
319 compare empty?, 0/false
320 break-if-=
321 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
322 copy-array-object "create what?", go-modal-error-ah
323 return
324 }
325 # turn global name into a stream
326 var name-storage: (stream byte 0x40)
327 var name/edx: (addr stream byte) <- address name-storage
328 emit-gap-buffer partial-global-name, name
329 # compute global curr-index
330 var curr-index/ecx: int <- find-symbol-in-globals globals, name
331 # if global found, set error and return
332 {
333 compare curr-index, 0
334 break-if-<
335 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
336 copy-array-object "already exists", go-modal-error-ah
337 return
338 }
339 # otherwise clear modal state
340 clear-gap-buffer partial-global-name
341 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
342 clear-object go-modal-error-ah
343 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
344 copy-to *cursor-in-go-modal-a, 0/false
345 # create new global
346 create-empty-global globals, name, 0x2000/default-gap-buffer-size=8KB
347 var globals-final-index/eax: (addr int) <- get globals, final-index
348 var new-index/ecx: int <- copy *globals-final-index
349 bump-global globals, new-index
350 var cursor-in-globals-a/ecx: (addr boolean) <- get self, cursor-in-globals?
351 copy-to *cursor-in-globals-a, 1/true
352 return
353 }
354 # otherwise process like a regular gap-buffer
355 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
356 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
357 edit-gap-buffer partial-global-name, key
358 return
359 }
360 # ctrl-g: go to a global (or the repl)
361 {
362 compare key, 7/ctrl-g
363 break-if-!=
364 # look for a word to prepopulate the modal
365 var current-word-storage: (stream byte 0x40)
366 var current-word/edi: (addr stream byte) <- address current-word-storage
367 word-at-cursor self, current-word
368 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
369 var partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
370 clear-gap-buffer partial-global-name
371 load-gap-buffer-from-stream partial-global-name, current-word
372 # enable the modal
373 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
374 copy-to *cursor-in-go-modal-a, 1/true
375 return
376 }
377 # dispatch the key to either sandbox or globals
378 {
379 var cursor-in-globals-a/eax: (addr boolean) <- get self, cursor-in-globals?
380 compare *cursor-in-globals-a, 0/false
381 break-if-=
382 edit-globals globals, key
383 return
384 }
385 edit-sandbox sandbox, key, globals, data-disk
386 }
388 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) {
389 var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
390 var in/eax: (addr gap-buffer) <- lookup *in-ah
391 var read-result-h: (handle cell)
392 var read-result-ah/esi: (addr handle cell) <- address read-result-h
393 read-cell in, read-result-ah, trace
394 var error?/eax: boolean <- has-errors? trace
395 {
396 compare error?, 0/false
397 break-if-=
398 return
399 }
400 macroexpand read-result-ah, globals, trace
401 var error?/eax: boolean <- has-errors? trace
402 {
403 compare error?, 0/false
404 break-if-=
405 return
406 }
407 var nil-h: (handle cell)
408 var nil-ah/eax: (addr handle cell) <- address nil-h
409 allocate-pair nil-ah
410 #? set-cursor-position 0/screen, 0 0
411 #? turn-on-debug-print
412 var call-number-storage: int
413 var call-number/edi: (addr int) <- address call-number-storage
414 debug-print "^", 4/fg, 0/bg
415 evaluate read-result-ah, result-ah, *nil-ah, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
416 debug-print "$", 4/fg, 0/bg
417 var error?/eax: boolean <- has-errors? trace
418 {
419 compare error?, 0/false
420 break-if-=
421 return
422 }
423 # refresh various rendering caches
424 mark-lines-dirty trace
425 # If any definitions were created or modified in the process, link this gap
426 # buffer to them.
427 # TODO: detect and create UI for conflicts.
428 stash-gap-buffer-to-globals globals, definitions-created, _in-ah
429 }
431 fn test-go-modal {
432 var env-storage: environment
433 var env/esi: (addr environment) <- address env-storage
434 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
435 # setup: screen
436 var screen-on-stack: screen
437 var screen/edi: (addr screen) <- address screen-on-stack
438 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
439 # hit ctrl-g
440 edit-environment env, 7/ctrl-g, 0/no-disk
441 render-environment screen, env
442 #
443 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal/0"
444 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal/1"
445 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal/2"
446 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal/3"
447 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal/4"
448 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal/5"
449 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-go-modal/6-text"
450 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal/6"
451 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal/7"
452 # cursor is in the modal
453 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal/8-cursor"
454 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ............................................................... ", "F - test-go-modal/8"
455 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal/9"
456 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal/10"
457 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal/11"
458 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal/12"
459 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal/13"
460 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal/14"
461 # menu at bottom is correct in context
462 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"
463 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal/15"
464 }
466 fn test-leave-go-modal {
467 var env-storage: environment
468 var env/esi: (addr environment) <- address env-storage
469 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
470 # setup: screen
471 var screen-on-stack: screen
472 var screen/edi: (addr screen) <- address screen-on-stack
473 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
474 # hit ctrl-g
475 edit-environment env, 7/ctrl-g, 0/no-disk
476 render-environment screen, env
477 # cancel
478 edit-environment env, 0x1b/escape, 0/no-disk
479 render-environment screen, env
480 # no modal
481 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-leave-go-modal/0"
482 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-leave-go-modal/1"
483 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-leave-go-modal/2"
484 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-leave-go-modal/3"
485 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-leave-go-modal/4"
486 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-leave-go-modal/5"
487 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-leave-go-modal/6"
488 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-leave-go-modal/7"
489 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-leave-go-modal/8"
490 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-leave-go-modal/9"
491 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-leave-go-modal/10"
492 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-leave-go-modal/11"
493 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-leave-go-modal/12"
494 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-leave-go-modal/13"
495 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-leave-go-modal/14"
496 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-leave-go-modal/15"
497 }
499 fn test-jump-to-global {
500 var env-storage: environment
501 var env/esi: (addr environment) <- address env-storage
502 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
503 # setup: screen
504 var screen-on-stack: screen
505 var screen/edi: (addr screen) <- address screen-on-stack
506 initialize-screen screen, 0x80/width, 0x30/height, 0/no-pixel-graphics
507 # define a global
508 type-in env, screen, "(define f 42)"
509 edit-environment env, 0x13/ctrl-s, 0/no-disk
510 render-environment screen, env
511 # hit ctrl-g
512 edit-environment env, 7/ctrl-g, 0/no-disk
513 render-environment screen, env
514 # type global name
515 type-in env, screen, "f"
516 # submit
517 edit-environment env, 0xa/newline, 0/no-disk
518 render-environment screen, env
519 # | global definitions | sandbox
520 # cursor now in global definition
521 check-screen-row screen, 1/y, " (define f 42) screen: ", "F - test-jump-to-global/1"
522 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-jump-to-global/1-cursor"
523 # no modal
524 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-global/bg0"
525 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-global/bg1"
526 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-global/bg2"
527 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-global/bg3"
528 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-global/bg4"
529 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-global/bg5"
530 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-jump-to-global/bg6"
531 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-jump-to-global/bg7"
532 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-jump-to-global/bg8"
533 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-global/bg9"
534 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-global/bg10"
535 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-global/bg11"
536 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-global/bg12"
537 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-global/bg13"
538 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-global/bg14"
539 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-global/bg15"
540 }
542 fn test-go-modal-prepopulates-word-at-cursor {
543 var env-storage: environment
544 var env/esi: (addr environment) <- address env-storage
545 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
546 # setup: screen
547 var screen-on-stack: screen
548 var screen/edi: (addr screen) <- address screen-on-stack
549 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
550 # type a word at the cursor
551 type-in env, screen, "fn1"
552 # hit ctrl-g
553 edit-environment env, 7/ctrl-g, 0/no-disk
554 render-environment screen, env
555 # modal prepopulates word at cursor
556 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/0"
557 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/1"
558 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/2"
559 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/3"
560 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/4"
561 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/5"
562 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"
563 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/6"
564 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/7"
565 # word at cursor
566 check-screen-row screen, 8/y, " fn1 ", "F - test-go-modal-prepopulates-word-at-cursor/8-text"
567 # new cursor position
568 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/8-cursor"
569 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ... ............................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/8"
570 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/9"
571 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/10"
572 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/11"
573 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/12"
574 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/13"
575 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/14"
576 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/15"
577 # cancel
578 edit-environment env, 0x1b/escape, 0/no-disk
579 render-environment screen, env
580 # type one more space
581 edit-environment env, 0x20/space, 0/no-disk
582 render-environment screen, env
583 # hit ctrl-g again
584 edit-environment env, 7/ctrl-g, 0/no-disk
585 render-environment screen, env
586 # no word prepopulated since cursor is not on the word
587 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-0"
588 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-1"
589 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-2"
590 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-3"
591 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-4"
592 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-5"
593 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"
594 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test2-6"
595 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test2-7"
596 # no word at cursor
597 check-screen-row screen, 8/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-text"
598 # new cursor position
599 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8-cursor"
600 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ............................................................... ", "F - test-go-modal-prepopulates-word-at-cursor/test2-8"
601 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-9"
602 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-10"
603 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-11"
604 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-12"
605 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-13"
606 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-14"
607 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test2-15"
608 # cancel
609 edit-environment env, 0x1b/escape, 0/no-disk
610 render-environment screen, env
611 # move cursor to the left until it's on the word again
612 edit-environment env, 0x80/left-arrow, 0/no-disk
613 render-environment screen, env
614 edit-environment env, 0x80/left-arrow, 0/no-disk
615 render-environment screen, env
616 # hit ctrl-g again
617 edit-environment env, 7/ctrl-g, 0/no-disk
618 render-environment screen, env
619 # word prepopulated like before
620 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-0"
621 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-1"
622 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-2"
623 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-3"
624 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-4"
625 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-5"
626 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"
627 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-6"
628 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-7"
629 # word at cursor
630 check-screen-row screen, 8/y, " fn1 ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-text"
631 # new cursor position
632 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8-cursor"
633 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ... ............................................................ ", "F - test-go-modal-prepopulates-word-at-cursor/test3-8"
634 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-9"
635 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-10"
636 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-11"
637 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-12"
638 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-13"
639 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-14"
640 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-go-modal-prepopulates-word-at-cursor/test3-15"
641 }
643 fn test-jump-to-nonexistent-global {
644 var env-storage: environment
645 var env/esi: (addr environment) <- address env-storage
646 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
647 # setup: screen
648 var screen-on-stack: screen
649 var screen/edi: (addr screen) <- address screen-on-stack
650 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
651 # type in any (nonexistent) global name
652 type-in env, screen, "f"
653 # hit ctrl-g
654 edit-environment env, 7/ctrl-g, 0/no-disk
655 render-environment screen, env
656 # submit
657 edit-environment env, 0xa/newline, 0/no-disk
658 render-environment screen, env
659 # modal now shows an error
660 # | global definitions | sandbox
661 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-nonexistent-global/0"
662 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-nonexistent-global/1"
663 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-nonexistent-global/2"
664 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-nonexistent-global/3"
665 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-nonexistent-global/4"
666 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-nonexistent-global/5"
667 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-jump-to-nonexistent-global/6-text"
668 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/6"
669 check-screen-row-in-color screen, 4/fg=error, 7/y, " no such global ", "F - test-jump-to-nonexistent-global/7-text"
670 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/7"
671 check-screen-row screen, 8/y, " f ", "F - test-jump-to-nonexistent-global/8-text"
672 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-jump-to-nonexistent-global/8-cursor"
673 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-jump-to-nonexistent-global/8"
674 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-nonexistent-global/9"
675 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-nonexistent-global/10"
676 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-nonexistent-global/11"
677 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-nonexistent-global/12"
678 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-nonexistent-global/13"
679 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-nonexistent-global/14"
680 # menu at bottom is correct in context
681 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"
682 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-nonexistent-global/15"
683 # cancel
684 edit-environment env, 0x1b/escape, 0/no-disk
685 render-environment screen, env
686 # hit ctrl-g again
687 edit-environment env, 7/ctrl-g, 0/no-disk
688 render-environment screen, env
689 # word prepopulated like before, but no error
690 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-jump-to-nonexistent-global/test2-0"
691 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-jump-to-nonexistent-global/test2-1"
692 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-jump-to-nonexistent-global/test2-2"
693 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-jump-to-nonexistent-global/test2-3"
694 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-jump-to-nonexistent-global/test2-4"
695 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-jump-to-nonexistent-global/test2-5"
696 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"
697 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/test2-6"
698 check-screen-row-in-color screen, 4/fg=error, 7/y, " ", "F - test-jump-to-nonexistent-global/test2-7-text"
699 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-jump-to-nonexistent-global/test2-7"
700 # same word at cursor
701 check-screen-row screen, 8/y, " f ", "F - test-jump-to-nonexistent-global/test2-8-text"
702 # new cursor position
703 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-jump-to-nonexistent-global/test2-8-cursor"
704 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-jump-to-nonexistent-global/test2-8"
705 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-jump-to-nonexistent-global/test2-9"
706 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-jump-to-nonexistent-global/test2-10"
707 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-jump-to-nonexistent-global/test2-11"
708 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-jump-to-nonexistent-global/test2-12"
709 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-jump-to-nonexistent-global/test2-13"
710 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-jump-to-nonexistent-global/test2-14"
711 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-jump-to-nonexistent-global/test2-15"
712 }
714 fn test-create-global {
715 var env-storage: environment
716 var env/esi: (addr environment) <- address env-storage
717 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
718 # setup: screen
719 var screen-on-stack: screen
720 var screen/edi: (addr screen) <- address screen-on-stack
721 initialize-screen screen, 0x80/width, 0x30/height, 0/no-pixel-graphics
722 # hit ctrl-g
723 edit-environment env, 7/ctrl-g, 0/no-disk
724 render-environment screen, env
725 # type global name
726 type-in env, screen, "fn1"
727 # create
728 edit-environment env, 0xd/ctrl-m, 0/no-disk
729 render-environment screen, env
730 # | global definitions | sandbox
731 # cursor now on global side
732 check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, " | ", "F - test-create-global/1-cursor"
733 # no modal
734 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-global/bg0"
735 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-global/bg1"
736 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-global/bg2"
737 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-global/bg3"
738 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-global/bg4"
739 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-global/bg5"
740 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ", "F - test-create-global/bg6"
741 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ", "F - test-create-global/bg7"
742 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " ", "F - test-create-global/bg8"
743 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-global/bg9"
744 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-global/bg10"
745 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-global/bg11"
746 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-global/bg12"
747 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-global/bg13"
748 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-global/bg14"
749 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-global/bg15"
750 }
752 fn test-create-nonexistent-global {
753 var env-storage: environment
754 var env/esi: (addr environment) <- address env-storage
755 initialize-environment env, 8/fake-screen-width, 3/fake-screen-height
756 # setup: screen
757 var screen-on-stack: screen
758 var screen/edi: (addr screen) <- address screen-on-stack
759 initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
760 # define a global
761 type-in env, screen, "(define f 42)"
762 edit-environment env, 0x13/ctrl-s, 0/no-disk
763 render-environment screen, env
764 # type in its name
765 type-in env, screen, "f"
766 # hit ctrl-g
767 edit-environment env, 7/ctrl-g, 0/no-disk
768 render-environment screen, env
769 # submit
770 edit-environment env, 0xd/ctrl-m, 0/no-disk
771 render-environment screen, env
772 # modal now shows an error
773 # | global definitions | sandbox
774 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-nonexistent-global/0"
775 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-nonexistent-global/1"
776 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-nonexistent-global/2"
777 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-nonexistent-global/3"
778 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-nonexistent-global/4"
779 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-nonexistent-global/5"
780 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-create-nonexistent-global/6-text"
781 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-create-nonexistent-global/6"
782 check-screen-row-in-color screen, 4/fg=error, 7/y, " already exists ", "F - test-create-nonexistent-global/7-text"
783 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-create-nonexistent-global/7"
784 check-screen-row-in-color screen, 0/fg, 8/y, " f ", "F - test-create-nonexistent-global/8-text"
785 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-create-nonexistent-global/8-cursor"
786 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-create-nonexistent-global/8"
787 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-nonexistent-global/9"
788 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-nonexistent-global/10"
789 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-nonexistent-global/11"
790 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-nonexistent-global/12"
791 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-nonexistent-global/13"
792 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-nonexistent-global/14"
793 # menu at bottom is correct in context
794 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"
795 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-nonexistent-global/15"
796 # cancel
797 edit-environment env, 0x1b/escape, 0/no-disk
798 render-environment screen, env
799 # hit ctrl-g again
800 edit-environment env, 7/ctrl-g, 0/no-disk
801 render-environment screen, env
802 # word prepopulated like before, but no error
803 check-background-color-in-screen-row screen, 0xf/bg=modal, 0/y, " ", "F - test-create-nonexistent-global/test2-0"
804 check-background-color-in-screen-row screen, 0xf/bg=modal, 1/y, " ", "F - test-create-nonexistent-global/test2-1"
805 check-background-color-in-screen-row screen, 0xf/bg=modal, 2/y, " ", "F - test-create-nonexistent-global/test2-2"
806 check-background-color-in-screen-row screen, 0xf/bg=modal, 3/y, " ", "F - test-create-nonexistent-global/test2-3"
807 check-background-color-in-screen-row screen, 0xf/bg=modal, 4/y, " ", "F - test-create-nonexistent-global/test2-4"
808 check-background-color-in-screen-row screen, 0xf/bg=modal, 5/y, " ", "F - test-create-nonexistent-global/test2-5"
809 check-screen-row screen, 6/y, " go to global (or leave blank to go to REPL) ", "F - test-create-nonexistent-global/test2-6-text"
810 check-background-color-in-screen-row screen, 0xf/bg=modal, 6/y, " ................................................................ ", "F - test-create-nonexistent-global/test2-6"
811 check-screen-row-in-color screen, 4/fg=error, 7/y, " ", "F - test-create-nonexistent-global/test2-7-text"
812 check-background-color-in-screen-row screen, 0xf/bg=modal, 7/y, " ................................................................ ", "F - test-create-nonexistent-global/test2-7"
813 # same word at cursor
814 check-screen-row-in-color screen, 0/fg, 8/y, " f ", "F - test-create-nonexistent-global/test2-8-text"
815 # new cursor position
816 check-background-color-in-screen-row screen, 0/bg=cursor, 8/y, " | ", "F - test-create-nonexistent-global/test2-8-cursor"
817 check-background-color-in-screen-row screen, 0xf/bg=modal, 8/y, " . .............................................................. ", "F - test-create-nonexistent-global/test2-8"
818 check-background-color-in-screen-row screen, 0xf/bg=modal, 9/y, " ", "F - test-create-nonexistent-global/test2-9"
819 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xa/y, " ", "F - test-create-nonexistent-global/test2-10"
820 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xb/y, " ", "F - test-create-nonexistent-global/test2-11"
821 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xc/y, " ", "F - test-create-nonexistent-global/test2-12"
822 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xd/y, " ", "F - test-create-nonexistent-global/test2-13"
823 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xe/y, " ", "F - test-create-nonexistent-global/test2-14"
824 check-background-color-in-screen-row screen, 0xf/bg=modal, 0xf/y, " ", "F - test-create-nonexistent-global/test2-15"
825 }
827 fn render-go-modal screen: (addr screen), _self: (addr environment) {
828 var self/esi: (addr environment) <- copy _self
829 var width/eax: int <- copy 0
830 var height/ecx: int <- copy 0
831 width, height <- screen-size screen
832 # xmin = max(0, width/2 - 0x20)
833 var xmin: int
834 var tmp/edx: int <- copy width
835 tmp <- shift-right 1
836 tmp <- subtract 0x20/half-global-name-capacity
837 {
838 compare tmp, 0
839 break-if->=
840 tmp <- copy 0
841 }
842 copy-to xmin, tmp
843 # xmax = min(width, width/2 + 0x20)
844 var xmax: int
845 tmp <- copy width
846 tmp <- shift-right 1
847 tmp <- add 0x20/half-global-name-capacity
848 {
849 compare tmp, width
850 break-if-<=
851 tmp <- copy width
852 }
853 copy-to xmax, tmp
854 # ymin = height/2 - 2
855 var ymin: int
856 tmp <- copy height
857 tmp <- shift-right 1
858 tmp <- subtract 2
859 copy-to ymin, tmp
860 # ymax = height/2 + 1
861 var ymax: int
862 tmp <- add 3
863 copy-to ymax, tmp
864 #
865 clear-rect screen, xmin, ymin, xmax, ymax, 0xf/bg=modal
866 add-to xmin, 4
867 set-cursor-position screen, xmin, ymin
868 draw-text-rightward-from-cursor screen, "go to global (or leave blank to go to REPL)", xmax, 8/fg=dark-grey, 0xf/bg=modal
869 var partial-global-name-ah/eax: (addr handle gap-buffer) <- get self, partial-global-name
870 var _partial-global-name/eax: (addr gap-buffer) <- lookup *partial-global-name-ah
871 var partial-global-name/edx: (addr gap-buffer) <- copy _partial-global-name
872 subtract-from xmin, 4
873 increment ymin
874 {
875 var go-modal-error-ah/eax: (addr handle array byte) <- get self, go-modal-error
876 var go-modal-error/eax: (addr array byte) <- lookup *go-modal-error-ah
877 compare go-modal-error, 0
878 break-if-=
879 var dummy/eax: int <- draw-text-rightward screen, go-modal-error, xmin, xmax, ymin, 4/fg=error, 0xf/bg=modal
880 }
881 increment ymin
882 var dummy/eax: int <- copy 0
883 var dummy2/ecx: int <- copy 0
884 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
885 }
887 fn render-go-modal-menu screen: (addr screen), _self: (addr environment) {
888 var self/esi: (addr environment) <- copy _self
889 var _width/eax: int <- copy 0
890 var height/ecx: int <- copy 0
891 _width, height <- screen-size screen
892 var width/edx: int <- copy _width
893 var y/ecx: int <- copy height
894 y <- decrement
895 var height/ebx: int <- copy y
896 height <- increment
897 clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg
898 set-cursor-position screen, 0/x, y
899 draw-text-rightward-from-cursor screen, " ^r ", width, 0/fg, 0x5c/bg=menu-highlight
900 draw-text-rightward-from-cursor screen, " run main ", width, 7/fg, 0xc5/bg=blue-bg
901 draw-text-rightward-from-cursor screen, " enter ", width, 0/fg, 0xc/bg=menu-really-highlight
902 draw-text-rightward-from-cursor screen, " go ", width, 7/fg, 0xc5/bg=blue-bg
903 draw-text-rightward-from-cursor screen, " ^m ", width, 0/fg, 0xc/bg=menu-really-highlight
904 draw-text-rightward-from-cursor screen, " create ", width, 7/fg, 0xc5/bg=blue-bg
905 draw-text-rightward-from-cursor screen, " esc ", width, 0/fg, 0x5c/bg=menu-highlight
906 draw-text-rightward-from-cursor screen, " cancel ", width, 7/fg, 0xc5/bg=blue-bg
907 draw-text-rightward-from-cursor screen, " ^a ", width, 0/fg, 0x5c/bg=menu-highlight
908 draw-text-rightward-from-cursor screen, " << ", width, 7/fg, 0xc5/bg=blue-bg
909 draw-text-rightward-from-cursor screen, " ^b ", width, 0/fg, 0x5c/bg=menu-highlight
910 draw-text-rightward-from-cursor screen, " <word ", width, 7/fg, 0xc5/bg=blue-bg
911 draw-text-rightward-from-cursor screen, " ^f ", width, 0/fg, 0x5c/bg=menu-highlight
912 draw-text-rightward-from-cursor screen, " word> ", width, 7/fg, 0xc5/bg=blue-bg
913 draw-text-rightward-from-cursor screen, " ^e ", width, 0/fg, 0x5c/bg=menu-highlight
914 draw-text-rightward-from-cursor screen, " >> ", width, 7/fg, 0xc5/bg=blue-bg
915 }
917 fn word-at-cursor _self: (addr environment), out: (addr stream byte) {
918 var self/esi: (addr environment) <- copy _self
919 var cursor-in-go-modal-a/eax: (addr boolean) <- get self, cursor-in-go-modal?
920 compare *cursor-in-go-modal-a, 0/false
921 {
922 break-if-=
923 # cursor in go modal
924 return
925 }
926 var cursor-in-globals-a/edx: (addr boolean) <- get self, cursor-in-globals?
927 compare *cursor-in-globals-a, 0/false
928 {
929 break-if-=
930 # cursor in some global editor
931 var globals/eax: (addr global-table) <- get self, globals
932 var cursor-index/ecx: int <- cursor-global globals
933 var globals-data-ah/eax: (addr handle array global) <- get globals, data
934 var globals-data/eax: (addr array global) <- lookup *globals-data-ah
935 var cursor-offset/ecx: (offset global) <- compute-offset globals-data, cursor-index
936 var curr-global/eax: (addr global) <- index globals-data, cursor-offset
937 var curr-global-data-ah/eax: (addr handle gap-buffer) <- get curr-global, input
938 var curr-global-data/eax: (addr gap-buffer) <- lookup *curr-global-data-ah
939 word-at-gap curr-global-data, out
940 return
941 }
942 # cursor in sandbox
943 var sandbox/ecx: (addr sandbox) <- get self, sandbox
944 var sandbox-data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
945 var sandbox-data/eax: (addr gap-buffer) <- lookup *sandbox-data-ah
946 word-at-gap sandbox-data, out
947 }
949 # Gotcha: some saved state may not load.
950 fn load-state _self: (addr environment), data-disk: (addr disk) {
951 var self/esi: (addr environment) <- copy _self
952 # data-disk -> stream
953 var s-storage: (stream byte 0x40000) # space for 0x200/sectors
954 var s/ebx: (addr stream byte) <- address s-storage
955 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sectors from data disk", 3/fg, 0/bg
956 move-cursor-to-left-margin-of-next-line 0/screen
957 load-sectors data-disk, 0/lba, 0x200/sectors, s
958 #? draw-stream-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, s, 7/fg, 0xc5/bg=blue-bg
959 # stream -> gap-buffer (HACK: we temporarily cannibalize the sandbox's gap-buffer)
960 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "parsing", 3/fg, 0/bg
961 move-cursor-to-left-margin-of-next-line 0/screen
962 var sandbox/eax: (addr sandbox) <- get self, sandbox
963 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
964 var data/eax: (addr gap-buffer) <- lookup *data-ah
965 load-gap-buffer-from-stream data, s
966 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into gap buffer", 3/fg, 0/bg
967 move-cursor-to-left-margin-of-next-line 0/screen
968 clear-stream s
969 # read: gap-buffer -> cell
970 var initial-root-storage: (handle cell)
971 var initial-root/ecx: (addr handle cell) <- address initial-root-storage
972 var trace-storage: trace
973 var trace/edi: (addr trace) <- address trace-storage
974 initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
975 read-cell data, initial-root, trace
976 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, " into s-expressions", 3/fg, 0/bg
977 move-cursor-to-left-margin-of-next-line 0/screen
978 clear-gap-buffer data
979 #
980 {
981 var initial-root-addr/eax: (addr cell) <- lookup *initial-root
982 compare initial-root-addr, 0
983 break-if-!=
984 return
985 }
986 # load globals from assoc(initial-root, 'globals)
987 var globals-literal-storage: (handle cell)
988 var globals-literal-ah/eax: (addr handle cell) <- address globals-literal-storage
989 new-symbol globals-literal-ah, "globals"
990 var globals-literal/eax: (addr cell) <- lookup *globals-literal-ah
991 var globals-cell-storage: (handle cell)
992 var globals-cell-ah/edx: (addr handle cell) <- address globals-cell-storage
993 clear-trace trace
994 lookup-symbol globals-literal, globals-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
995 var globals-cell/eax: (addr cell) <- lookup *globals-cell-ah
996 {
997 compare globals-cell, 0
998 break-if-=
999 var globals/eax: (addr global-table) <- get self, globals
1000 load-globals globals-cell-ah, globals
1001 }
1002 # sandbox = assoc(initial-root, 'sandbox)
1003 draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "loading sandbox", 3/fg, 0/bg
1004 var sandbox-literal-storage: (handle cell)
1005 var sandbox-literal-ah/eax: (addr handle cell) <- address sandbox-literal-storage
1006 new-symbol sandbox-literal-ah, "sandbox"
1007 var sandbox-literal/eax: (addr cell) <- lookup *sandbox-literal-ah
1008 var sandbox-cell-storage: (handle cell)
1009 var sandbox-cell-ah/edx: (addr handle cell) <- address sandbox-cell-storage
1010 clear-trace trace
1011 lookup-symbol sandbox-literal, sandbox-cell-ah, *initial-root, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
1012 var sandbox-cell/eax: (addr cell) <- lookup *sandbox-cell-ah
1013 {
1014 compare sandbox-cell, 0
1015 break-if-=
1016 var sandbox-data-ah/eax: (addr handle stream byte) <- get sandbox-cell, text-data
1017 var _sandbox-data/eax: (addr stream byte) <- lookup *sandbox-data-ah
1018 var sandbox-data/ecx: (addr stream byte) <- copy _sandbox-data
1019 # stream -> gap-buffer
1020 var sandbox/eax: (addr sandbox) <- get self, sandbox
1021 var data-ah/eax: (addr handle gap-buffer) <- get sandbox, data
1022 var data/eax: (addr gap-buffer) <- lookup *data-ah
1023 load-gap-buffer-from-stream data, sandbox-data
1024 }
1025 }
1027 # Save state as an alist of alists:
1028 # ((globals . ((a . (fn ...))
1029 # ...))
1030 # (sandbox . ...))
1031 fn store-state data-disk: (addr disk), sandbox: (addr sandbox), globals: (addr global-table) {
1032 compare data-disk, 0/no-disk
1033 {
1034 break-if-!=
1035 return
1036 }
1037 var stream-storage: (stream byte 0x40000) # space enough for 0x200/sectors
1038 var stream/edi: (addr stream byte) <- address stream-storage
1039 write stream, "(\n"
1040 write-globals stream, globals
1041 write-sandbox stream, sandbox
1042 write stream, ")\n"
1043 store-sectors data-disk, 0/lba, 0x200/sectors, stream
1044 }