shell: start of 'print' primitive
This commit is contained in:
parent
1d724f9260
commit
97cffa20d4
|
@ -196,6 +196,28 @@ fn draw-stream-wrapping-right-then-down screen: (addr screen), stream: (addr str
|
||||||
return xcurr, ycurr
|
return xcurr, ycurr
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn draw-stream-wrapping-right-then-down-from-cursor screen: (addr screen), stream: (addr stream byte), xmin: int, ymin: int, xmax: int, ymax: int, color: int, background-color: int {
|
||||||
|
var cursor-x/eax: int <- copy 0
|
||||||
|
var cursor-y/ecx: int <- copy 0
|
||||||
|
cursor-x, cursor-y <- cursor-position screen
|
||||||
|
var end-x/edx: int <- copy cursor-x
|
||||||
|
end-x <- increment
|
||||||
|
compare end-x, xmax
|
||||||
|
{
|
||||||
|
break-if-<
|
||||||
|
cursor-x <- copy xmin
|
||||||
|
cursor-y <- increment
|
||||||
|
}
|
||||||
|
cursor-x, cursor-y <- draw-stream-wrapping-right-then-down screen, stream, xmin, ymin, xmax, ymax, cursor-x, cursor-y, color, background-color
|
||||||
|
}
|
||||||
|
|
||||||
|
fn draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen: (addr screen), stream: (addr stream byte), color: int, background-color: int {
|
||||||
|
var width/eax: int <- copy 0
|
||||||
|
var height/ecx: int <- copy 0
|
||||||
|
width, height <- screen-size screen
|
||||||
|
draw-stream-wrapping-right-then-down-from-cursor screen, stream, 0/xmin, 0/ymin, width, height, color, background-color
|
||||||
|
}
|
||||||
|
|
||||||
fn move-cursor-rightward-and-downward screen: (addr screen), xmin: int, xmax: int {
|
fn move-cursor-rightward-and-downward screen: (addr screen), xmin: int, xmax: int {
|
||||||
var cursor-x/eax: int <- copy 0
|
var cursor-x/eax: int <- copy 0
|
||||||
var cursor-y/ecx: int <- copy 0
|
var cursor-y/ecx: int <- copy 0
|
||||||
|
|
|
@ -10,6 +10,8 @@ type cell {
|
||||||
text-data: (handle stream byte)
|
text-data: (handle stream byte)
|
||||||
# type 4: primitive function
|
# type 4: primitive function
|
||||||
index-data: int
|
index-data: int
|
||||||
|
# type 5: screen
|
||||||
|
screen-data: (handle screen)
|
||||||
# TODO: array, (associative) table, stream
|
# TODO: array, (associative) table, stream
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -114,3 +116,20 @@ fn new-primitive-function out: (addr handle cell), n: int {
|
||||||
allocate-primitive-function out
|
allocate-primitive-function out
|
||||||
initialize-primitive-function out, n
|
initialize-primitive-function out, n
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn allocate-screen _out: (addr handle cell) {
|
||||||
|
var out/eax: (addr handle cell) <- copy _out
|
||||||
|
allocate out
|
||||||
|
var out-addr/eax: (addr cell) <- lookup *out
|
||||||
|
var type/ecx: (addr int) <- get out-addr, type
|
||||||
|
copy-to *type, 5/screen
|
||||||
|
}
|
||||||
|
|
||||||
|
fn new-screen _out: (addr handle cell), width: int, height: int {
|
||||||
|
var out/eax: (addr handle cell) <- copy _out
|
||||||
|
allocate-screen out
|
||||||
|
var out-addr/eax: (addr cell) <- lookup *out
|
||||||
|
var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
|
||||||
|
var dest-addr/eax: (addr screen) <- lookup *dest-ah
|
||||||
|
initialize-screen dest-addr, width, height
|
||||||
|
}
|
||||||
|
|
|
@ -21,6 +21,12 @@ fn initialize-globals _self: (addr global-table) {
|
||||||
append-primitive self, "cdr"
|
append-primitive self, "cdr"
|
||||||
append-primitive self, "cons"
|
append-primitive self, "cons"
|
||||||
append-primitive self, "="
|
append-primitive self, "="
|
||||||
|
append-primitive self, "print"
|
||||||
|
# TODO: isolate screens per-sandbox
|
||||||
|
var screen-storage: (handle cell)
|
||||||
|
var screen-ah/ecx: (addr handle cell) <- address screen-storage
|
||||||
|
new-screen screen-ah, 5/width, 4/height
|
||||||
|
append-global self, "screen", *screen-ah
|
||||||
}
|
}
|
||||||
|
|
||||||
fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
|
fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
|
||||||
|
@ -42,10 +48,15 @@ fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int,
|
||||||
var curr-name-ah/eax: (addr handle array byte) <- get curr, name
|
var curr-name-ah/eax: (addr handle array byte) <- get curr, name
|
||||||
var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
|
var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
|
||||||
var curr-name/ebx: (addr array byte) <- copy _curr-name
|
var curr-name/ebx: (addr array byte) <- copy _curr-name
|
||||||
var tmpx/eax: int <- copy x
|
{
|
||||||
tmpx <- draw-text-rightward screen, curr-name, tmpx, xmax, bottom-line, 0x2a/fg=orange, 0x12/bg=almost-black
|
var skip?/eax: boolean <- string-equal? curr-name, "screen"
|
||||||
tmpx <- draw-text-rightward screen, " ", tmpx, xmax, bottom-line, 7/fg=grey, 0x12/bg=almost-black
|
compare skip?, 0/false
|
||||||
x <- copy tmpx
|
break-if-!=
|
||||||
|
var tmpx/eax: int <- copy x
|
||||||
|
tmpx <- draw-text-rightward screen, curr-name, tmpx, xmax, bottom-line, 0x2a/fg=orange, 0x12/bg=almost-black
|
||||||
|
tmpx <- draw-text-rightward screen, " ", tmpx, xmax, bottom-line, 7/fg=grey, 0x12/bg=almost-black
|
||||||
|
x <- copy tmpx
|
||||||
|
}
|
||||||
curr-index <- increment
|
curr-index <- increment
|
||||||
loop
|
loop
|
||||||
}
|
}
|
||||||
|
@ -66,6 +77,9 @@ fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int,
|
||||||
var curr-name-ah/eax: (addr handle array byte) <- get curr, name
|
var curr-name-ah/eax: (addr handle array byte) <- get curr, name
|
||||||
var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
|
var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
|
||||||
var curr-name/edx: (addr array byte) <- copy _curr-name
|
var curr-name/edx: (addr array byte) <- copy _curr-name
|
||||||
|
var skip?/eax: boolean <- string-equal? curr-name, "screen"
|
||||||
|
compare skip?, 0/false
|
||||||
|
break-if-!=
|
||||||
var x/eax: int <- copy xmin
|
var x/eax: int <- copy xmin
|
||||||
x, y <- draw-text-wrapping-right-then-down screen, curr-name, xmin, ymin, xmax, ymax, x, y, 0x2a/fg=orange, 0x12/bg=almost-black
|
x, y <- draw-text-wrapping-right-then-down screen, curr-name, xmin, ymin, xmax, ymax, x, y, 0x2a/fg=orange, 0x12/bg=almost-black
|
||||||
x, y <- draw-text-wrapping-right-then-down screen, " <- ", xmin, ymin, xmax, ymax, x, y, 7/fg=grey, 0x12/bg=almost-black
|
x, y <- draw-text-wrapping-right-then-down screen, " <- ", xmin, ymin, xmax, ymax, x, y, 7/fg=grey, 0x12/bg=almost-black
|
||||||
|
@ -245,6 +259,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
|
||||||
apply-compare args-ah, out, env-h, trace
|
apply-compare args-ah, out, env-h, trace
|
||||||
return
|
return
|
||||||
}
|
}
|
||||||
|
{
|
||||||
|
var is-print?/eax: boolean <- string-equal? f-name, "print"
|
||||||
|
compare is-print?, 0/false
|
||||||
|
break-if-=
|
||||||
|
apply-print args-ah, out, env-h, trace
|
||||||
|
return
|
||||||
|
}
|
||||||
abort "unknown primitive function"
|
abort "unknown primitive function"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -586,3 +607,44 @@ fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), env-h: (
|
||||||
}
|
}
|
||||||
new-integer out, 1/true
|
new-integer out, 1/true
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) {
|
||||||
|
trace-text trace, "eval", "apply print"
|
||||||
|
var args-ah/eax: (addr handle cell) <- copy _args-ah
|
||||||
|
var _args/eax: (addr cell) <- lookup *args-ah
|
||||||
|
var args/esi: (addr cell) <- copy _args
|
||||||
|
var _env/eax: (addr cell) <- lookup env-h
|
||||||
|
var env/edi: (addr cell) <- copy _env
|
||||||
|
# TODO: check that args is a pair
|
||||||
|
var empty-args?/eax: boolean <- nil? args
|
||||||
|
compare empty-args?, 0/false
|
||||||
|
{
|
||||||
|
break-if-=
|
||||||
|
error trace, "cons needs 2 args but got 0"
|
||||||
|
return
|
||||||
|
}
|
||||||
|
# screen = args->left
|
||||||
|
var first-ah/eax: (addr handle cell) <- get args, left
|
||||||
|
var first/eax: (addr cell) <- lookup *first-ah
|
||||||
|
var first-type/ecx: (addr int) <- get first, type
|
||||||
|
compare *first-type, 5/screen
|
||||||
|
{
|
||||||
|
break-if-=
|
||||||
|
error trace, "first arg for 'print' is not a screen"
|
||||||
|
return
|
||||||
|
}
|
||||||
|
var screen-ah/eax: (addr handle screen) <- get first, screen-data
|
||||||
|
var _screen/eax: (addr screen) <- lookup *screen-ah
|
||||||
|
var screen/ecx: (addr screen) <- copy _screen
|
||||||
|
# args->right->left
|
||||||
|
var right-ah/eax: (addr handle cell) <- get args, right
|
||||||
|
var right/eax: (addr cell) <- lookup *right-ah
|
||||||
|
# TODO: check that right is a pair
|
||||||
|
var second-ah/eax: (addr handle cell) <- get right, left
|
||||||
|
var stream-storage: (stream byte 0x100)
|
||||||
|
var stream/edi: (addr stream byte) <- address stream-storage
|
||||||
|
print-cell second-ah, stream, trace
|
||||||
|
draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
|
||||||
|
# return what was printed
|
||||||
|
copy-object second-ah, out
|
||||||
|
}
|
||||||
|
|
|
@ -11,7 +11,7 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk)
|
||||||
load-sandbox data-disk, sandbox
|
load-sandbox data-disk, sandbox
|
||||||
{
|
{
|
||||||
render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu
|
render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu
|
||||||
render-sandbox screen, sandbox, 0x40/x, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu
|
render-sandbox screen, sandbox, 0x40/x, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu, globals
|
||||||
{
|
{
|
||||||
var key/eax: byte <- read-key keyboard
|
var key/eax: byte <- read-key keyboard
|
||||||
compare key, 0
|
compare key, 0
|
||||||
|
|
|
@ -38,7 +38,7 @@ fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
|
||||||
|
|
||||||
##
|
##
|
||||||
|
|
||||||
fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
|
fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int, globals: (addr global-table) {
|
||||||
clear-rect screen, xmin, ymin, xmax, ymax, 0/bg=black
|
clear-rect screen, xmin, ymin, xmax, ymax, 0/bg=black
|
||||||
var self/esi: (addr sandbox) <- copy _self
|
var self/esi: (addr sandbox) <- copy _self
|
||||||
# data
|
# data
|
||||||
|
@ -76,6 +76,7 @@ fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin:
|
||||||
var x2/edx: int <- copy x
|
var x2/edx: int <- copy x
|
||||||
var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0/bg
|
var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0/bg
|
||||||
}
|
}
|
||||||
|
y <- maybe-render-screen screen, globals, xmin, y, xmax, ymax
|
||||||
# render menu
|
# render menu
|
||||||
var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
|
var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
|
||||||
compare *cursor-in-trace?, 0/false
|
compare *cursor-in-trace?, 0/false
|
||||||
|
@ -87,6 +88,14 @@ fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin:
|
||||||
render-sandbox-menu screen
|
render-sandbox-menu screen
|
||||||
}
|
}
|
||||||
|
|
||||||
|
fn maybe-render-screen screen: (addr screen), globals: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int -> _/ecx: int {
|
||||||
|
var x/eax: int <- copy xmin
|
||||||
|
var y/ecx: int <- copy ymin
|
||||||
|
y <- add 2
|
||||||
|
x, y <- draw-text-wrapping-right-then-down screen, "abc", x, y, xmax, ymax, x, y, 7/fg, 0/bg
|
||||||
|
return y
|
||||||
|
}
|
||||||
|
|
||||||
fn render-sandbox-menu screen: (addr screen) {
|
fn render-sandbox-menu screen: (addr screen) {
|
||||||
var width/eax: int <- copy 0
|
var width/eax: int <- copy 0
|
||||||
var height/ecx: int <- copy 0
|
var height/ecx: int <- copy 0
|
||||||
|
@ -213,7 +222,7 @@ fn test-run-integer {
|
||||||
var screen/edi: (addr screen) <- address screen-on-stack
|
var screen/edi: (addr screen) <- address screen-on-stack
|
||||||
initialize-screen screen, 0x80/width, 0x10/height
|
initialize-screen screen, 0x80/width, 0x10/height
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "1 ", "F - test-run-integer/0"
|
check-screen-row screen, 0/y, "1 ", "F - test-run-integer/0"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-integer/1"
|
check-screen-row screen, 1/y, "... ", "F - test-run-integer/1"
|
||||||
check-screen-row screen, 2/y, "=> 1 ", "F - test-run-integer/2"
|
check-screen-row screen, 2/y, "=> 1 ", "F - test-run-integer/2"
|
||||||
|
@ -235,7 +244,7 @@ fn test-run-with-spaces {
|
||||||
var screen/edi: (addr screen) <- address screen-on-stack
|
var screen/edi: (addr screen) <- address screen-on-stack
|
||||||
initialize-screen screen, 0x80/width, 0x10/height
|
initialize-screen screen, 0x80/width, 0x10/height
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, " 1 ", "F - test-run-with-spaces/0"
|
check-screen-row screen, 0/y, " 1 ", "F - test-run-with-spaces/0"
|
||||||
check-screen-row screen, 1/y, " ", "F - test-run-with-spaces/1"
|
check-screen-row screen, 1/y, " ", "F - test-run-with-spaces/1"
|
||||||
check-screen-row screen, 2/y, "... ", "F - test-run-with-spaces/2"
|
check-screen-row screen, 2/y, "... ", "F - test-run-with-spaces/2"
|
||||||
|
@ -256,7 +265,7 @@ fn test-run-quote {
|
||||||
var screen/edi: (addr screen) <- address screen-on-stack
|
var screen/edi: (addr screen) <- address screen-on-stack
|
||||||
initialize-screen screen, 0x80/width, 0x10/height
|
initialize-screen screen, 0x80/width, 0x10/height
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "'a ", "F - test-run-quote/0"
|
check-screen-row screen, 0/y, "'a ", "F - test-run-quote/0"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-quote/1"
|
check-screen-row screen, 1/y, "... ", "F - test-run-quote/1"
|
||||||
check-screen-row screen, 2/y, "=> a ", "F - test-run-quote/2"
|
check-screen-row screen, 2/y, "=> a ", "F - test-run-quote/2"
|
||||||
|
@ -276,7 +285,7 @@ fn test-run-error-invalid-integer {
|
||||||
var screen/edi: (addr screen) <- address screen-on-stack
|
var screen/edi: (addr screen) <- address screen-on-stack
|
||||||
initialize-screen screen, 0x80/width, 0x10/height
|
initialize-screen screen, 0x80/width, 0x10/height
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "1a ", "F - test-run-error-invalid-integer/0"
|
check-screen-row screen, 0/y, "1a ", "F - test-run-error-invalid-integer/0"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-error-invalid-integer/0"
|
check-screen-row screen, 1/y, "... ", "F - test-run-error-invalid-integer/0"
|
||||||
check-screen-row screen, 2/y, "invalid number ", "F - test-run-error-invalid-integer/2"
|
check-screen-row screen, 2/y, "invalid number ", "F - test-run-error-invalid-integer/2"
|
||||||
|
@ -296,7 +305,7 @@ fn test-run-move-cursor-into-trace {
|
||||||
var screen/edi: (addr screen) <- address screen-on-stack
|
var screen/edi: (addr screen) <- address screen-on-stack
|
||||||
initialize-screen screen, 0x80/width, 0x10/height
|
initialize-screen screen, 0x80/width, 0x10/height
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/pre-0"
|
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/pre-0"
|
||||||
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
|
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/pre-1"
|
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/pre-1"
|
||||||
|
@ -306,7 +315,7 @@ fn test-run-move-cursor-into-trace {
|
||||||
# move cursor into trace
|
# move cursor into trace
|
||||||
edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
|
edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/trace-0"
|
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/trace-0"
|
||||||
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
|
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/trace-1"
|
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/trace-1"
|
||||||
|
@ -316,7 +325,7 @@ fn test-run-move-cursor-into-trace {
|
||||||
# move cursor into input
|
# move cursor into input
|
||||||
edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
|
edit-sandbox sandbox, 9/tab, 0/no-globals, 0/no-screen, 0/no-keyboard, 0/no-disk
|
||||||
#
|
#
|
||||||
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
|
render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height, 0/no-globals
|
||||||
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/input-0"
|
check-screen-row screen, 0/y, "12 ", "F - test-run-move-cursor-into-trace/input-0"
|
||||||
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor"
|
check-background-color-in-screen-row screen, 7/bg=cursor, 0/y, " | ", "F - test-run-move-cursor-into-trace/input-0/cursor"
|
||||||
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/input-1"
|
check-screen-row screen, 1/y, "... ", "F - test-run-move-cursor-into-trace/input-1"
|
||||||
|
|
Loading…
Reference in New Issue