6742 - support for formatting in fake screens

We still need a few primitives, but we can implement these as needed. I'm
ready to call the fake screen done.

1 files changed, 112 insertions, 6 deletions

diff --git a/405screen.mu b/405screen.mu
index f7e04c53..8555b494 100644
--- a/405screen.mu
+++ b/405screen.mu
@@ -258,8 +258,10 @@ $print-grapheme:body: {
     var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
     var data/eax: (addr array screen-cell) <- lookup *data-ah
     var offset/ecx: (offset screen-cell) <- compute-offset data, idx
-    var cell/eax: (addr screen-cell) <- index data, offset
-    var dest/eax: (addr grapheme) <- get cell, data
+    var dest-cell/ecx: (addr screen-cell) <- index data, offset
+    var src-cell/eax: (addr screen-cell) <- get screen-addr, curr-attributes
+    copy-object src-cell, dest-cell
+    var dest/eax: (addr grapheme) <- get dest-cell, data
     var c2/ecx: grapheme <- copy c
 #?     print-grapheme-to-real-screen c2
 #?     print-string-to-real-screen "\n"
@@ -315,6 +317,23 @@ fn screen-grapheme-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> r
   result <- copy *src
 }
 
+fn screen-color-at screen-on-stack: (addr screen), row: int, col: int -> result/eax: int {
+  var screen-addr/esi: (addr screen) <- copy screen-on-stack
+  var idx/ecx: int <- screen-cell-index screen-addr, row, col
+  result <- screen-color-at-idx screen-addr, idx
+}
+
+fn screen-color-at-idx screen-on-stack: (addr screen), idx-on-stack: int -> result/eax: int {
+  var screen-addr/esi: (addr screen) <- copy screen-on-stack
+  var data-ah/eax: (addr handle array screen-cell) <- get screen-addr, data
+  var data/eax: (addr array screen-cell) <- lookup *data-ah
+  var idx/ecx: int <- copy idx-on-stack
+  var offset/ecx: (offset screen-cell) <- compute-offset data, idx
+  var cell/eax: (addr screen-cell) <- index data, offset
+  var src/eax: (addr int) <- get cell, color
+  result <- copy *src
+}
+
 fn print-code-point screen: (addr screen), c: code-point {
   var g/eax: grapheme <- to-grapheme c
   print-grapheme screen, g
@@ -346,6 +365,11 @@ $reset-formatting:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var dest/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var empty-cell: screen-cell
+    var empty-cell-addr/eax: (addr screen-cell) <- address empty-cell
+    copy-object empty-cell-addr, dest
   }
 }
 }
@@ -361,6 +385,14 @@ $start-color:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var dest/edx: (addr int) <- get attr, color
+    var src/eax: int <- copy fg
+    copy-to *dest, src
+    var dest/edx: (addr int) <- get attr, background-color
+    var src/eax: int <- copy bg
+    copy-to *dest, src
   }
 }
 }
@@ -376,6 +408,10 @@ $start-bold:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var dest/edx: (addr boolean) <- get attr, bold?
+    copy-to *dest, 1
   }
 }
 }
@@ -391,6 +427,10 @@ $start-underline:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var dest/edx: (addr boolean) <- get attr, underline?
+    copy-to *dest, 1
   }
 }
 }
@@ -406,6 +446,10 @@ $start-reverse-video:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var dest/edx: (addr boolean) <- get attr, reverse?
+    copy-to *dest, 1
   }
 }
 }
@@ -421,6 +465,10 @@ $start-blinking:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var attr/ecx: (addr screen-cell) <- get screen-addr, curr-attributes
+    var dest/edx: (addr boolean) <- get attr, blink?
+    copy-to *dest, 1
   }
 }
 }
@@ -436,6 +484,9 @@ $hide-cursor:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var hide?/ecx: (addr boolean) <- get screen-addr, cursor-hide?
+    copy-to *hide?, 1
   }
 }
 }
@@ -451,6 +502,9 @@ $show-cursor:body: {
   {
     break-if-=
     # fake screen
+    var screen-addr/esi: (addr screen) <- copy screen
+    var hide?/ecx: (addr boolean) <- get screen-addr, cursor-hide?
+    copy-to *hide?, 0
   }
 }
 }
@@ -479,14 +533,13 @@ fn check-screen-row-from screen-on-stack: (addr screen), row-idx: int, col-idx:
     var expected-grapheme/eax: grapheme <- read-grapheme e-addr
     var expected-grapheme2/eax: int <- copy expected-grapheme
     # compare graphemes
-    $check-screen-row:compare-graphemes: {
+    $check-screen-row-from:compare-graphemes: {
       # if expected-grapheme is space, null grapheme is also ok
       {
         compare expected-grapheme2, 0x20
         break-if-!=
         compare g2, 0
-        break-if-!=
-        break $check-screen-row:compare-graphemes
+        break-if-= $check-screen-row-from:compare-graphemes
       }
       check-ints-equal g2, expected-grapheme2, msg
     }
@@ -497,10 +550,47 @@ fn check-screen-row-from screen-on-stack: (addr screen), row-idx: int, col-idx:
 
 # various variants by screen-cell attribute; spaces in the 'expected' data should not match the attribute
 
-fn check-screen-row-in-color screen-on-stack: (addr screen), fg: color, row-idx: int, expected: (addr array byte), msg: (addr array byte) {
+fn check-screen-row-in-color screen: (addr screen), fg: color, row-idx: int, expected: (addr array byte), msg: (addr array byte) {
+  check-screen-row-in-color-from screen, fg, row-idx, 1, expected, msg
 }
 
 fn check-screen-row-in-color-from screen-on-stack: (addr screen), fg: color, row-idx: int, col-idx: int, expected: (addr array byte), msg: (addr array byte) {
+  var screen/esi: (addr screen) <- copy screen-on-stack
+  var idx/ecx: int <- screen-cell-index screen, row-idx, col-idx
+  # compare 'expected' with the screen contents starting at 'idx', grapheme by grapheme
+  var e: (stream byte 0x100)
+  var e-addr/edx: (addr stream byte) <- address e
+  write e-addr, expected
+  {
+    var done?/eax: boolean <- stream-empty? e-addr
+    compare done?, 0
+    break-if-!=
+    var g/eax: grapheme <- screen-grapheme-at-idx screen, idx
+    var g2/ebx: int <- copy g
+    var expected-grapheme/eax: grapheme <- read-grapheme e-addr
+    var expected-grapheme2/edx: int <- copy expected-grapheme
+    # compare graphemes
+    $check-screen-row-in-color-from:compare-graphemes: {
+      # if expected-grapheme is space, null grapheme is also ok
+      {
+        compare expected-grapheme2, 0x20
+        break-if-!=
+        compare g2, 0
+        break-if-= $check-screen-row-in-color-from:compare-graphemes
+      }
+      # if expected-grapheme is space, a different color is ok
+      {
+        compare expected-grapheme2, 0x20
+        break-if-!=
+        var color/eax: int <- screen-color-at-idx screen, idx
+        compare color, fg
+        break-if-!= $check-screen-row-in-color-from:compare-graphemes
+      }
+      check-ints-equal g2, expected-grapheme2, msg
+    }
+    idx <- increment
+    loop
+  }
 }
 
 # background color is visible even for spaces, so 'expected' behaves as an array of booleans.
@@ -704,7 +794,23 @@ fn test-check-screen-scrolls-on-overflow {
   check-screen-row-from screen, 5, 1, "b", "F - test-check-screen-scrolls-on-overflow/2"
 }
 
+fn test-check-screen-color {
+  var screen-on-stack: screen
+  var screen/esi: (addr screen) <- address screen-on-stack
+  initialize-screen screen, 5, 4
+  var c/eax: grapheme <- copy 0x61  # 'a'
+  print-grapheme screen, c
+  start-color screen, 1, 0  # foreground=1
+  c <- copy 0x62  # 'b'
+  print-grapheme screen, c
+  start-color screen, 0, 0  # back to default
+  c <- copy 0x63  # 'c'
+  print-grapheme screen, c
+  check-screen-row-in-color screen, 0, 1, "a c", "F - test-check-screen-color"
+}
+
 #? fn main -> exit-status/ebx: int {
+#? #?   test-check-screen-color
 #?   run-tests
 #?   exit-status <- copy 0
 #? }