shell: pixel graphics

2 files changed, 135 insertions, 17 deletions

diff --git a/shell/global.mu b/shell/global.mu
index 325ace44..cb3eeb78 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -26,6 +26,7 @@ fn initialize-globals _self: (addr global-table) {
   append-primitive self, "cons"
   # for screens
   append-primitive self, "print"
+  append-primitive self, "pixel"
   # for keyboards
   append-primitive self, "key"
   # for streams
@@ -303,6 +304,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     return
   }
   {
+    var is-pixel?/eax: boolean <- string-equal? f-name, "pixel"
+    compare is-pixel?, 0/false
+    break-if-=
+    apply-pixel args-ah, out, trace
+    return
+  }
+  {
     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
     compare wait-for-key?, 0/false
     break-if-=
@@ -686,6 +694,84 @@ fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad
   copy-object second-ah, out
 }
 
+fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply pixel"
+  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
+  # TODO: check that args is a pair
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "pixel needs 4 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 'pixel' 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/edi: (addr screen) <- copy _screen
+  # x = args->right->left->value
+  var rest-ah/eax: (addr handle cell) <- get args, right
+  var _rest/eax: (addr cell) <- lookup *rest-ah
+  var rest/esi: (addr cell) <- copy _rest
+  # TODO: check that rest is a pair
+  var second-ah/eax: (addr handle cell) <- get rest, left
+  var second/eax: (addr cell) <- lookup *second-ah
+  var second-type/ecx: (addr int) <- get second, type
+  compare *second-type, 1/number
+  {
+    break-if-=
+    error trace, "second arg for 'pixel' is not an int (x coordinate)"
+    return
+  }
+  var second-value/eax: (addr float) <- get second, number-data
+  var x/edx: int <- convert *second-value
+  # y = rest->right->left->value
+  var rest-ah/eax: (addr handle cell) <- get rest, right
+  var _rest/eax: (addr cell) <- lookup *rest-ah
+  rest <- copy _rest
+  # TODO: check that rest is a pair
+  var third-ah/eax: (addr handle cell) <- get rest, left
+  var third/eax: (addr cell) <- lookup *third-ah
+  var third-type/ecx: (addr int) <- get third, type
+  compare *third-type, 1/number
+  {
+    break-if-=
+    error trace, "third arg for 'pixel' is not an int (y coordinate)"
+    return
+  }
+  var third-value/eax: (addr float) <- get third, number-data
+  var y/ebx: int <- convert *third-value
+  # color = rest->right->left->value
+  var rest-ah/eax: (addr handle cell) <- get rest, right
+  var _rest/eax: (addr cell) <- lookup *rest-ah
+  rest <- copy _rest
+  # TODO: check that rest is a pair
+  var fourth-ah/eax: (addr handle cell) <- get rest, left
+  var fourth/eax: (addr cell) <- lookup *fourth-ah
+  var fourth-type/ecx: (addr int) <- get fourth, type
+  compare *fourth-type, 1/number
+  {
+    break-if-=
+    error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
+    return
+  }
+  var fourth-value/eax: (addr float) <- get fourth, number-data
+  var color/eax: int <- convert *fourth-value
+  pixel screen, x, y, color
+  # return nothing
+}
+
 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
   trace-text trace, "eval", "apply key"
   var args-ah/eax: (addr handle cell) <- copy _args-ah
diff --git a/shell/sandbox.mu b/shell/sandbox.mu
index ad51df8f..68b04344 100644
--- a/shell/sandbox.mu
+++ b/shell/sandbox.mu
@@ -250,29 +250,61 @@ fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int
     }
     screen-y <- increment
   }
-  # screen
-  var height/edx: (addr int) <- get target-screen, height
-  var y/ecx: int <- copy 0
+  # text data
   {
-    compare y, *height
-    break-if->=
-    set-cursor-position screen, xmin, screen-y
-    draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
-    move-cursor-right screen
-    var width/edx: (addr int) <- get target-screen, width
-    var x/ebx: int <- copy 0
+    var height/edx: (addr int) <- get target-screen, height
+    var y/ecx: int <- copy 0
     {
-      compare x, *width
+      compare y, *height
       break-if->=
-      print-screen-cell-of-fake-screen screen, target-screen, x, y
+      set-cursor-position screen, xmin, screen-y
+      draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
       move-cursor-right screen
-      x <- increment
+      var width/edx: (addr int) <- get target-screen, width
+      var x/ebx: int <- copy 0
+      {
+        compare x, *width
+        break-if->=
+        print-screen-cell-of-fake-screen screen, target-screen, x, y
+        move-cursor-right screen
+        x <- increment
+        loop
+      }
+      draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
+      y <- increment
+      screen-y <- increment
+      loop
+    }
+  }
+  # pixel data
+  {
+    var left/ebx: int <- copy xmin
+    left <- add 1/margin-left
+    left <- shift-left 3/log-font-width
+    var top/edx: int <- copy ymin
+    top <- add 1/margin-top
+    top <- shift-left 4/log-font-height
+    var pixels-ah/esi: (addr handle stream pixel) <- get target-screen, pixels
+    var _pixels/eax: (addr stream pixel) <- lookup *pixels-ah
+    var pixels/esi: (addr stream pixel) <- copy _pixels
+    rewind-stream pixels
+    {
+      var done?/eax: boolean <- stream-empty? pixels
+      compare done?, 0/false
+      break-if-!=
+      var curr-pixel: pixel
+      var curr-pixel-addr/eax: (addr pixel) <- address curr-pixel
+      read-from-stream pixels, curr-pixel-addr
+      var curr-x/eax: (addr int) <- get curr-pixel, x
+      var x/eax: int <- copy *curr-x
+      x <- add left
+      var curr-y/ecx: (addr int) <- get curr-pixel, y
+      var y/ecx: int <- copy *curr-y
+      y <- add top
+      var curr-color/edx: (addr int) <- get curr-pixel, color
+      pixel screen, x, y, *curr-color
       loop
     }
-    draw-code-point-at-cursor screen, 0x7c/vertical-bar, 0x18/fg, 0/bg
-    y <- increment
-    screen-y <- increment
-    loop
   }
   # bottom border
   {