akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

shell: UI now showing fake keyboard 

But we don't actually support fake keyboards anywhere yet.
This commit is contained in:
Kartik K. Agaram 2021-04-10 21:20:35 -07:00
parent a509279aea
commit 770cac9412
4 changed files with 131 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
shell/cell.mu
View File

@ -13,7 +13,7 @@ type cell {
# type 5: screen
screen-data: (handle screen)
# type 6: keyboard
keyboard-data: (handle stream byte)
keyboard-data: (handle gap-buffer)
# TODO: array, (associative) table, stream
}
@ -151,12 +151,21 @@ fn clear-screen-cell _self-ah: (addr handle cell) {
clear-screen screen
}
fn allocate-keyboard _out: (addr handle cell), capacity: int {
fn allocate-keyboard _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/ecx: (addr handle stream byte) <- get out-addr, keyboard-data
populate-stream dest-ah, capacity
var dest-ah/ecx: (addr handle gap-buffer) <- get out-addr, keyboard-data
allocate dest-ah
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 6/keyboard
}
fn new-keyboard _out: (addr handle cell), capacity: int {
var out/eax: (addr handle cell) <- copy _out
allocate-keyboard out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
initialize-gap-buffer dest-addr, capacity
}

42
shell/evaluate.mu
View File

@ -1,7 +1,7 @@
# env is an alist of ((sym . val) (sym . val) ...)
# we never modify `in` or `env`
# ignore 'screen-cell' on a first reading; it's a hack for sandboxes
fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
var in/esi: (addr handle cell) <- copy _in
#? dump-cell in
#? {
@ -47,7 +47,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
{
break-if-!=
trace-text trace, "eval", "symbol"
lookup-symbol in-addr, out, env-h, globals, trace, screen-cell
lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell
trace-higher trace
return
}
@ -121,7 +121,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
rest-ah <- get rest, right
rest <- lookup *rest-ah
var second-arg-ah/edx: (addr handle cell) <- get rest, left
evaluate second-arg-ah, out, env-h, globals, trace, screen-cell
evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
trace-text trace, "eval", "saving global binding"
var first-arg/eax: (addr cell) <- lookup *first-arg-ah
var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
@ -158,7 +158,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
var first-arg-ah/ecx: (addr handle cell) <- get rest, left
var guard-h: (handle cell)
var guard-ah/esi: (addr handle cell) <- address guard-h
evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell
evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell
rest-ah <- get rest, right
rest <- lookup *rest-ah
var branch-ah/edi: (addr handle cell) <- get rest, left
@ -173,7 +173,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
rest <- lookup *rest-ah
branch-ah <- get rest, left
}
evaluate branch-ah, out, env-h, globals, trace, screen-cell
evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
trace-higher trace
return
}
@ -192,7 +192,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
var curr-out/eax: (addr cell) <- lookup *curr-out-ah
var left-out-ah/edi: (addr handle cell) <- get curr-out, left
var left-ah/esi: (addr handle cell) <- get curr, left
evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell
evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell
#
curr-out-ah <- get curr-out, right
var right-ah/eax: (addr handle cell) <- get curr, right
@ -205,7 +205,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
var args-ah/edx: (addr handle cell) <- get evaluated-list, right
#? dump-cell args-ah
#? abort "aaa"
apply function-ah, args-ah, out, env-h, globals, trace, screen-cell
apply function-ah, args-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
trace-higher trace
# trace "=> " out {{{
{
@ -218,7 +218,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
# }}}
}
fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
var f-ah/eax: (addr handle cell) <- copy _f-ah
var _f/eax: (addr cell) <- lookup *f-ah
var f/esi: (addr cell) <- copy _f
@ -257,14 +257,14 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand
var rest/eax: (addr cell) <- lookup *rest-ah
var params-ah/ecx: (addr handle cell) <- get rest, left
var body-ah/eax: (addr handle cell) <- get rest, right
apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace, screen-cell
apply-function params-ah, args-ah, body-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
trace-higher trace
return
}
error trace, "unknown function"
}
fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
# push bindings for params to env
var new-env-storage: (handle cell)
var new-env-ah/esi: (addr handle cell) <- address new-env-storage
@ -282,7 +282,7 @@ fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _b
# evaluate each expression, writing result to `out`
{
var curr-ah/eax: (addr handle cell) <- get body, left
evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell
evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell, keyboard-cell
}
#
body-ah <- get body, right
@ -375,7 +375,7 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o
trace-higher trace
}
fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
# trace sym
{
var stream-storage: (stream byte 0x40)
@ -408,7 +408,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
var env-nil?/eax: boolean <- nil? env
compare env-nil?, 0/false
break-if-=
lookup-symbol-in-globals sym, out, globals, trace, screen-cell
lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell
trace-higher trace
# trace "=> " out " (global)" {{{
{
@ -480,7 +480,7 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
var env-tail-storage: (handle cell)
var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
cdr env, env-tail-ah, trace
lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell
lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell
trace-higher trace
# trace "=> " out " (recurse)" {{{
{
@ -518,7 +518,7 @@ fn test-lookup-symbol-in-env {
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
new-symbol tmp-ah, "a"
var in/eax: (addr cell) <- lookup *tmp-ah
lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen
lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
var result/eax: (addr cell) <- lookup *tmp-ah
var result-type/edx: (addr int) <- get result, type
check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
@ -540,7 +540,7 @@ fn test-lookup-symbol-in-globals {
var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
new-symbol tmp-ah, "+"
var in/eax: (addr cell) <- lookup *tmp-ah
lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen
lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
var result/eax: (addr cell) <- lookup *tmp-ah
var result-type/edx: (addr int) <- get result, type
check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0"
@ -755,7 +755,7 @@ fn test-evaluate-is-well-behaved {
var tmp-storage: (handle cell)
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
new-symbol tmp-ah, "a"
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard
# doesn't die
check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
}
@ -769,7 +769,7 @@ fn test-evaluate-number {
var tmp-storage: (handle cell)
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
new-integer tmp-ah, 3
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
#
var result/eax: (addr cell) <- lookup *tmp-ah
var result-type/edx: (addr int) <- get result, type
@ -799,7 +799,7 @@ fn test-evaluate-symbol {
var tmp-storage: (handle cell)
var tmp-ah/edx: (addr handle cell) <- address tmp-storage
new-symbol tmp-ah, "a"
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen
evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
var result/eax: (addr cell) <- lookup *tmp-ah
var result-type/edx: (addr int) <- get result, type
check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
@ -821,7 +821,7 @@ fn test-evaluate-primitive-function {
# eval +, nil env
var tmp-storage: (handle cell)
var tmp-ah/esi: (addr handle cell) <- address tmp-storage
evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen
evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
#
var result/eax: (addr cell) <- lookup *tmp-ah
var result-type/edx: (addr int) <- get result, type
@ -856,7 +856,7 @@ fn test-evaluate-primitive-function-call {
var globals/edx: (addr global-table) <- address globals-storage
initialize-globals globals
#
evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen
evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard
#? dump-trace t
#
var result/eax: (addr cell) <- lookup *tmp-ah

12
shell/global.mu
View File

@ -130,7 +130,7 @@ fn append-global _self: (addr global-table), name: (addr array byte), value: (ha
copy-handle value, curr-value-ah
}
fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
var sym/eax: (addr cell) <- copy _sym
var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
@ -160,6 +160,16 @@ fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals
copy-object screen-cell, out
return
}
# if sym is "keyboard" and keyboard-cell exists, return it
{
var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
compare sym-is-keyboard?, 0/false
break-if-=
compare keyboard-cell, 0
break-if-=
copy-object keyboard-cell, out
return
}
# otherwise error "unbound symbol: ", sym
var stream-storage: (stream byte 0x40)
var stream/ecx: (addr stream byte) <- address stream-storage

95
shell/sandbox.mu
View File

@ -5,6 +5,7 @@ type sandbox {
keyboard-var: (handle cell)
trace: (handle trace)
cursor-in-trace?: boolean
cursor-in-keyboard?: boolean
}
fn initialize-sandbox _self: (addr sandbox), screen-and-keyboard?: boolean {
@ -23,7 +24,7 @@ fn initialize-sandbox _self: (addr sandbox), screen-and-keyboard?: boolean {
var screen-ah/eax: (addr handle cell) <- get self, screen-var
new-screen screen-ah, 5/width, 4/height
var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
allocate-keyboard keyboard-ah, 5/capacity
new-keyboard keyboard-ah, 0x10/keyboard-capacity
}
#
var trace-ah/eax: (addr handle trace) <- get self, trace
@ -61,6 +62,7 @@ fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin:
var x/eax: int <- copy xmin
var y/ecx: int <- copy ymin
y <- maybe-render-empty-screen screen, self, xmin, y
y <- maybe-render-keyboard screen, self, xmin, y
var cursor-in-sandbox?/ebx: boolean <- copy 0/false
{
var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
@ -282,6 +284,79 @@ fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int
return screen-y
}
fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
var self/esi: (addr sandbox) <- copy _self
var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
compare keyboard-obj-cell, 0
{
break-if-!=
return ymin
}
var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
compare *keyboard-obj-cell-type, 6/keyboard
{
break-if-=
return ymin # silently give up on rendering the keyboard
}
var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, ymin, 7/fg, 0/bg
var y/ecx: int <- copy ymin
var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
return y
}
# draw an evocative shape
fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
var keyboard/esi: (addr gap-buffer) <- copy _keyboard
var width/edx: int <- copy 0x10/keyboard-capacity
var y/edi: int <- copy ymin
# top border
{
set-cursor-position screen, xmin, y
move-cursor-right screen
var x/ebx: int <- copy 0
{
compare x, width
break-if->=
draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
move-cursor-right screen
x <- increment
loop
}
y <- increment
}
# keyboard
var x/eax: int <- copy xmin
draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
x <- increment
x <- render-gap-buffer screen, keyboard, x, y, render-cursor?
x <- copy xmin
x <- add 1 # for left bar
x <- add 0x10/keyboard-capacity
draw-code-point screen, 0x7c/vertical-bar, x, y, 0x18/fg, 0/bg
y <- increment
# bottom border
{
set-cursor-position screen, xmin, y
move-cursor-right screen
var x/ebx: int <- copy 0
{
compare x, width
break-if->=
draw-code-point-at-cursor screen, 0x2d/horizontal-bar, 0x18/fg, 0/bg
move-cursor-right screen
x <- increment
loop
}
y <- increment
}
return y
}
fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
var target/ecx: (addr screen) <- copy _target
var data-ah/eax: (addr handle array screen-cell) <- get target, data
@ -349,7 +424,9 @@ fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table),
clear-trace trace
var screen-cell/eax: (addr handle cell) <- get self, screen-var
clear-screen-cell screen-cell
run data, value, globals, trace, screen-cell
var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
# don't clear
run data, value, globals, trace, screen-cell, keyboard-cell
return
}
# tab
@ -384,7 +461,7 @@ fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table),
return
}
fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell) {
fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
var read-result-storage: (handle cell)
var read-result/esi: (addr handle cell) <- address read-result-storage
read-cell in, read-result, trace
@ -399,7 +476,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-tab
allocate-pair nil-ah
var eval-result-storage: (handle cell)
var eval-result/edi: (addr handle cell) <- address eval-result-storage
evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell
evaluate read-result, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell
var error?/eax: boolean <- has-errors? trace
{
compare error?, 0/false
@ -414,7 +491,7 @@ fn run in: (addr gap-buffer), out: (addr stream byte), globals: (addr global-tab
fn test-run-integer {
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 0/no-screen
initialize-sandbox sandbox, 0/no-screen-or-keyboard
# type "1"
edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
# eval
@ -433,7 +510,7 @@ fn test-run-integer {
fn test-run-with-spaces {
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 0/no-screen
initialize-sandbox sandbox, 0/no-screen-or-keyboard
# type input with whitespace before and after
edit-sandbox sandbox, 0x20/space, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
@ -456,7 +533,7 @@ fn test-run-with-spaces {
fn test-run-quote {
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 0/no-screen
initialize-sandbox sandbox, 0/no-screen-or-keyboard
# type "'a"
edit-sandbox sandbox, 0x27/quote, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
@ -476,7 +553,7 @@ fn test-run-quote {
fn test-run-error-invalid-integer {
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 0/no-screen
initialize-sandbox sandbox, 0/no-screen-or-keyboard
# type "1a"
edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
edit-sandbox sandbox, 0x61/a, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
@ -496,7 +573,7 @@ fn test-run-error-invalid-integer {
fn test-run-move-cursor-into-trace {
var sandbox-storage: sandbox
var sandbox/esi: (addr sandbox) <- address sandbox-storage
initialize-sandbox sandbox, 0/no-screen
initialize-sandbox sandbox, 0/no-screen-or-keyboard
# type "12"
edit-sandbox sandbox, 0x31/1, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
edit-sandbox sandbox, 0x32/2, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk