diff options
| -rw-r--r-- | 501draw-text.mu | 22 | ||||
| -rw-r--r-- | shell/cell.mu | 19 | ||||
| -rw-r--r-- | shell/global.mu | 70 | ||||
| -rw-r--r-- | shell/main.mu | 2 | ||||
| -rw-r--r-- | shell/sandbox.mu | 25 |
5 files changed, 125 insertions, 13 deletions
diff --git a/501draw-text.mu b/501draw-text.mu index ce87634e..79ec1930 100644 --- a/501draw-text.mu +++ b/501draw-text.mu @@ -196,6 +196,28 @@ fn draw-stream-wrapping-right-then-down screen: (addr screen), stream: (addr str 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 { var cursor-x/eax: int <- copy 0 var cursor-y/ecx: int <- copy 0 diff --git a/shell/cell.mu b/shell/cell.mu index 1aed590d..11a16821 100644 --- a/shell/cell.mu +++ b/shell/cell.mu @@ -10,6 +10,8 @@ type cell { text-data: (handle stream byte) # type 4: primitive function index-data: int + # type 5: screen + screen-data: (handle screen) # TODO: array, (associative) table, stream } @@ -114,3 +116,20 @@ fn new-primitive-function out: (addr handle cell), n: int { allocate-primitive-function out 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 +} diff --git a/shell/global.mu b/shell/global.mu index 5d34298b..72b4a178 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -21,6 +21,12 @@ fn initialize-globals _self: (addr global-table) { append-primitive self, "cdr" append-primitive self, "cons" 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 { @@ -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/eax: (addr array byte) <- lookup *curr-name-ah 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 - tmpx <- draw-text-rightward screen, " ", tmpx, xmax, bottom-line, 7/fg=grey, 0x12/bg=almost-black - x <- copy tmpx + { + var skip?/eax: boolean <- string-equal? curr-name, "screen" + compare skip?, 0/false + 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 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/eax: (addr array byte) <- lookup *curr-name-ah 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 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 @@ -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 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" } @@ -586,3 +607,44 @@ fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), env-h: ( } 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 +} diff --git a/shell/main.mu b/shell/main.mu index 6ebbbc47..cbaa3af2 100644 --- a/shell/main.mu +++ b/shell/main.mu @@ -11,7 +11,7 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) load-sandbox data-disk, sandbox { 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 compare key, 0 diff --git a/shell/sandbox.mu b/shell/sandbox.mu index 28ace92f..cc343259 100644 --- a/shell/sandbox.mu +++ b/shell/sandbox.mu @@ -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 var self/esi: (addr sandbox) <- copy _self # data @@ -76,6 +76,7 @@ fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: var x2/edx: int <- copy x 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 var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace? 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 } +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) { var width/eax: 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 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, 1/y, "... ", "F - test-run-integer/1" 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 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, 1/y, " ", "F - test-run-with-spaces/1" 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 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, 1/y, "... ", "F - test-run-quote/1" 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 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, 1/y, "... ", "F - test-run-error-invalid-integer/0" 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 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-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" @@ -306,7 +315,7 @@ fn test-run-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 # - 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-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" @@ -316,7 +325,7 @@ fn test-run-move-cursor-into-trace { # move cursor into input 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-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" |