shell: pixel graphics

3 files changed, 194 insertions, 26 deletions

diff --git a/500text-screen.mu b/500fake-screen.mu
index a266eb07..1731a63c 100644
--- a/500text-screen.mu
+++ b/500fake-screen.mu
@@ -1,17 +1,25 @@
-# Testable primitives for writing text to screen.
-# (Mu doesn't yet have testable primitives for graphics.)
+# Testable primitives for writing to screen.
 #
-# Unlike the top-level, this text mode has no scrolling.
+# Mu mostly uses the screen for text, but it builds it out of pixel graphics
+# and a bitmap font. There is no support for a blinking cursor, scrolling and
+# so on.
+#
+# Fake screens are primarily for testing text-mode prints. However, they do
+# support some rudimentary pixel operations as well. Caveats:
+#
+# - Drawing pixels atop text or vice versa is not supported. Results in a fake
+#   screen will not mimic real screens in these situations.
+# - Fake screens currently also assume a fixed-width 8x16 font.
 
-# coordinates here don't match top-level
-# Here we're consistent with graphics mode. Top-level is consistent with
-# terminal emulators.
 type screen {
+  # text mode
   width: int
   height: int
   data: (handle array screen-cell)
-  cursor-x: int
-  cursor-y: int
+  cursor-x: int  # [0..width)
+  cursor-y: int  # [0..height)
+  # pixel graphics
+  pixels: (handle stream pixel)  # sparse representation
 }
 
 type screen-cell {
@@ -20,6 +28,12 @@ type screen-cell {
   background-color: int
 }
 
+type pixel {
+  x: int  # [0..width*font-width)
+  y: int  # [0..height*font-height)
+  color: int  # [0..256)
+}
+
 fn initialize-screen _screen: (addr screen), width: int, height: int {
   var screen/esi: (addr screen) <- copy _screen
   var tmp/eax: int <- copy 0
@@ -38,6 +52,9 @@ fn initialize-screen _screen: (addr screen), width: int, height: int {
     tmp <- multiply width
     populate data-addr, tmp
   }
+  # pixels
+  var pixels-ah/ecx: (addr handle stream pixel) <- get screen, pixels
+  populate-stream pixels-ah, tmp
   # screen->cursor-x = 0
   dest <- get screen, cursor-x
   copy-to *dest, 0
@@ -64,6 +81,33 @@ fn screen-size _screen: (addr screen) -> _/eax: int, _/ecx: int {
   return width, height
 }
 
+fn pixel screen: (addr screen), x: int, y: int, color: int {
+  {
+    compare screen, 0
+    break-if-!=
+    pixel-on-real-screen x, y, color
+    return
+  }
+  # fake screen
+  # prepare a pixel
+  var pixel-storage: pixel
+  var src/ecx: int <- copy x
+  var dest/edx: (addr int) <- get pixel-storage, x
+  copy-to *dest, src
+  src <- copy y
+  dest <- get pixel-storage, y
+  copy-to *dest, src
+  src <- copy color
+  dest <- get pixel-storage, color
+  copy-to *dest, src
+  # save it
+  var src/ecx: (addr pixel) <- address pixel-storage
+  var screen/eax: (addr screen) <- copy screen
+  var dest-stream-ah/eax: (addr handle stream pixel) <- get screen, pixels
+  var dest-stream/eax: (addr stream pixel) <- lookup *dest-stream-ah
+  write-to-stream dest-stream, src
+}
+
 # testable screen primitive
 fn draw-grapheme _screen: (addr screen), g: grapheme, x: int, y: int, color: int, background-color: int {
   var screen/esi: (addr screen) <- copy _screen
@@ -219,6 +263,9 @@ fn clear-screen _screen: (addr screen) {
     loop
   }
   set-cursor-position screen, 0, 0
+  var dest-stream-ah/eax: (addr handle stream pixel) <- get screen, pixels
+  var dest-stream/eax: (addr stream pixel) <- lookup *dest-stream-ah
+  clear-stream dest-stream
 }
 
 fn fake-screen-empty? _screen: (addr screen) -> _/eax: boolean {
@@ -247,7 +294,10 @@ fn fake-screen-empty? _screen: (addr screen) -> _/eax: boolean {
     y <- increment
     loop
   }
-  return 1/true
+  var pixels-ah/eax: (addr handle stream pixel) <- get screen, pixels
+  var pixels/eax: (addr stream pixel) <- lookup *pixels-ah
+  var result/eax: boolean <- stream-empty? pixels
+  return result
 }
 
 fn clear-rect _screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int, background-color: int {
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
   {