shell: start of 'print' primitive

4 files changed, 103 insertions, 13 deletions

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"