replace 'line' with Mu implementation

2 files changed, 196 insertions, 32 deletions

diff --git a/shell/data.limg b/shell/data.limg
index fcc7a1ba..576d91a0 100644
--- a/shell/data.limg
+++ b/shell/data.limg
@@ -134,29 +134,6 @@
   (hline1 scr y 0 (width scr) color)])
     (vline . [def (vline scr x color)
   (vline1 scr x 0 (height scr) color)])
-    (line . [def (line screen x0 y0 x1 y1 color)
-  with (x x0
-        y y0
-        dx (abs x1-x0)
-        dy (0 - (abs y1-y0))
-        sx (sgn x1-x0)
-        sy (sgn y1-y0))
-    let err dx+dy
-      while (not (and (x = x1)
-                      (y = y1)))
-        (pixel screen x y color)
-        let e2 err*2
-          when (e2 >= dy)
-            x += sx
-          when (e2 <= dx)
-            y += sy
-          err +=
-              (+ (if (e2 >= dy)
-                   dy
-                   0)
-                 (if (e2 <= dx)
-                   dx
-                   0))])
     (read_line . [def (read_line keyboard)
   ret str (stream)
     let c (key keyboard)
diff --git a/shell/primitives.mu b/shell/primitives.mu
index bac3e416..af89c690 100644
--- a/shell/primitives.mu
+++ b/shell/primitives.mu
@@ -38,6 +38,7 @@ fn initialize-primitives _self: (addr global-table) {
   append-primitive self, "right"
   append-primitive self, "cr"
   append-primitive self, "pixel"
+  append-primitive self, "line"
   append-primitive self, "width"
   append-primitive self, "height"
   # for keyboards
@@ -56,7 +57,7 @@ fn initialize-primitives _self: (addr global-table) {
 # evaluate all their arguments.
 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
   var y/ecx: int <- copy ymax
-  y <- subtract 0x11/primitives-border
+  y <- subtract 0x10/primitives-border
   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
   y <- increment
   var right-min/edx: int <- copy xmax
@@ -98,7 +99,7 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
 #?     loop-if-=
 #?   }
   y <- copy ymax
-  y <- subtract 0x10/primitives-border
+  y <- subtract 0xf/primitives-border
   var left-max/edx: int <- copy xmax
   left-max <- subtract 0x20/primitives-divider
   var tmpx/eax: int <- copy xmin
@@ -125,15 +126,11 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
   y <- increment
   var tmpx/eax: int <- copy xmin
-  tmpx <- draw-text-rightward screen, "  width height", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
-  y <- increment
-  var tmpx/eax: int <- copy xmin
-  tmpx <- draw-text-rightward screen, "  pixel", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
-  tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
+  tmpx <- draw-text-rightward screen, "  line pixel", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
   y <- increment
   var tmpx/eax: int <- copy xmin
-  tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
+  tmpx <- draw-text-rightward screen, "  width height", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
+  tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
   y <- increment
   var tmpx/eax: int <- copy xmin
   tmpx <- draw-text-rightward screen, "  clear", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
@@ -437,6 +434,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     return
   }
   {
+    var line?/eax: boolean <- string-equal? f-name, "line"
+    compare line?, 0/false
+    break-if-=
+    apply-line args-ah, out, trace
+    return
+  }
+  {
     var width?/eax: boolean <- string-equal? f-name, "width"
     compare width?, 0/false
     break-if-=
@@ -1932,6 +1936,189 @@ fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (ad
   # return nothing
 }
 
+fn apply-line _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply 'line'"
+  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 args-type/eax: (addr int) <- get args, type
+    compare *args-type, 0/pair
+    break-if-=
+    error trace, "args to 'line' are not a list"
+    return
+  }
+  var empty-args?/eax: boolean <- nil? args
+  compare empty-args?, 0/false
+  {
+    break-if-=
+    error trace, "'line' needs 6 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/eax: (addr int) <- get first, type
+    compare *first-type, 5/screen
+    break-if-=
+    error trace, "first arg for 'line' 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
+  # x1 = 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
+  {
+    var rest-type/eax: (addr int) <- get rest, type
+    compare *rest-type, 0/pair
+    break-if-=
+    error trace, "'line' encountered non-pair"
+    return
+  }
+  {
+    var rest-nil?/eax: boolean <- nil? rest
+    compare rest-nil?, 0/false
+    break-if-=
+    error trace, "'line' needs 6 args but got 1"
+    return
+  }
+  var second-ah/eax: (addr handle cell) <- get rest, left
+  var second/eax: (addr cell) <- lookup *second-ah
+  {
+    var second-type/eax: (addr int) <- get second, type
+    compare *second-type, 1/number
+    break-if-=
+    error trace, "second arg for 'line' is not a number (screen x coordinate of start point)"
+    return
+  }
+  var second-value/eax: (addr float) <- get second, number-data
+  var x1/edx: int <- convert *second-value
+  # y1 = 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
+  {
+    var rest-type/eax: (addr int) <- get rest, type
+    compare *rest-type, 0/pair
+    break-if-=
+    error trace, "'line' encountered non-pair"
+    return
+  }
+  {
+    var rest-nil?/eax: boolean <- nil? rest
+    compare rest-nil?, 0/false
+    break-if-=
+    error trace, "'line' needs 6 args but got 2"
+    return
+  }
+  var third-ah/eax: (addr handle cell) <- get rest, left
+  var third/eax: (addr cell) <- lookup *third-ah
+  {
+    var third-type/eax: (addr int) <- get third, type
+    compare *third-type, 1/number
+    break-if-=
+    error trace, "third arg for 'line' is not a number (screen y coordinate of start point)"
+    return
+  }
+  var third-value/eax: (addr float) <- get third, number-data
+  var y1/ebx: int <- convert *third-value
+  # x2 = rest->right->left->value
+  var rest-ah/eax: (addr handle cell) <- get rest, right
+  var _rest/eax: (addr cell) <- lookup *rest-ah
+  var rest/esi: (addr cell) <- copy _rest
+  {
+    var rest-type/eax: (addr int) <- get rest, type
+    compare *rest-type, 0/pair
+    break-if-=
+    error trace, "'line' encountered non-pair"
+    return
+  }
+  {
+    var rest-nil?/eax: boolean <- nil? rest
+    compare rest-nil?, 0/false
+    break-if-=
+    error trace, "'line' needs 6 args but got 3"
+    return
+  }
+  var fourth-ah/eax: (addr handle cell) <- get rest, left
+  var fourth/eax: (addr cell) <- lookup *fourth-ah
+  {
+    var fourth-type/eax: (addr int) <- get fourth, type
+    compare *fourth-type, 1/number
+    break-if-=
+    error trace, "fourth arg for 'line' is not a number (screen x coordinate of end point)"
+    return
+  }
+  var fourth-value/eax: (addr float) <- get fourth, number-data
+  var x2/ecx: int <- convert *fourth-value
+  # y2 = 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
+  {
+    var rest-type/eax: (addr int) <- get rest, type
+    compare *rest-type, 0/pair
+    break-if-=
+    error trace, "'line' encountered non-pair"
+    return
+  }
+  {
+    var rest-nil?/eax: boolean <- nil? rest
+    compare rest-nil?, 0/false
+    break-if-=
+    error trace, "'line' needs 6 args but got 4"
+    return
+  }
+  var fifth-ah/eax: (addr handle cell) <- get rest, left
+  var fifth/eax: (addr cell) <- lookup *fifth-ah
+  {
+    var fifth-type/eax: (addr int) <- get fifth, type
+    compare *fifth-type, 1/number
+    break-if-=
+    error trace, "fifth arg for 'line' is not a number (screen y coordinate of end point)"
+    return
+  }
+  var fifth-value/eax: (addr float) <- get fifth, number-data
+  var tmp/eax: int <- convert *fifth-value
+  var y2: int
+  copy-to y2, tmp
+  # 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
+  {
+    var rest-type/eax: (addr int) <- get rest, type
+    compare *rest-type, 0/pair
+    break-if-=
+    error trace, "'line' encountered non-pair"
+    return
+  }
+  {
+    var rest-nil?/eax: boolean <- nil? rest
+    compare rest-nil?, 0/false
+    break-if-=
+    error trace, "'line' needs 6 args but got 5"
+    return
+  }
+  var sixth-ah/eax: (addr handle cell) <- get rest, left
+  var sixth/eax: (addr cell) <- lookup *sixth-ah
+  {
+    var sixth-type/eax: (addr int) <- get sixth, type
+    compare *sixth-type, 1/number
+    break-if-=
+    error trace, "sixth arg for 'line' is not an int (color; 0..0xff)"
+    return
+  }
+  var sixth-value/eax: (addr float) <- get sixth, number-data
+  var color/eax: int <- convert *sixth-value
+  draw-line screen, x1, y1, x2, y2, 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