clean up Bresenham line-drawing

2 files changed, 54 insertions, 26 deletions

diff --git a/shell/data.limg b/shell/data.limg
index dd40fbdc..f276e9b5 100644
--- a/shell/data.limg
+++ b/shell/data.limg
@@ -23,32 +23,28 @@
     (hline1 screen y1 x1 x2 color)
     (set y1 (+ y1 1)))))])
   (brline . [(def brline (fn (screen x0 y0 x1 y1 color)
-  ((fn (dx dy sx sy)
-     ((fn (err)
-        (brline1 screen x0 y0 x1 y1 dx dy sx sy err color))
-      (+ dx dy)))
-   (abs (- x1 x0))
-   (- 0 (abs (- y1 y0)))
-   (sgn (- x1 x0))
-   (sgn (- y1 y0)))))])
-  (brline1 . [(def brline1 (fn (screen x y xlast ylast dx dy sx sy err color)
-  (while (not (and (= x xlast) (= y ylast)))
+  (let (x y) `(,x0 ,y0)
+  (let dx (abs (- x1 x0))
+  (let dy (- 0 (abs (- y1 y0)))
+  (let sx (sgn (- x1 x0))
+  (let sy (sgn (- y1 y0))
+  (let err (+ dx dy)
+  (while (not (and (= x x1)
+                   (= y y1)))
     (pixel screen x y color)
-    ((fn (e2)
-       (if (>= e2 dy)
-         (set x (+ x sx))
-         ())
-       (if (<= e2 dx)
-         (set y (+ y sy)))
-       (set err (+ err
-            (+
-              (if (>= e2 dy)
-                dy
-                0)
-              (if (<= e2 dx)
-                dx
-                0)))))
-     (* err 2)))))])
+    (let e2 (* err 2)
+    (when (>= e2 dy)
+      (set x (+ x sx)))
+    (when (<= e2 dx)
+      (set y (+ y sy)))
+    (set err
+      (+ err
+         (+ (if (>= e2 dy)
+              dy
+              0)
+            (if (<= e2 dx)
+              dx
+              0))))))))))))))])
   (read_line_2 . [(def read_line_2 (fn (keyboard stream)
   ((fn (c)
      (if (= c 10)
@@ -97,5 +93,5 @@
   (main . [(def main (fn (screen keyboard)
   (chessboard screen 16)))])
   ))
-  (sandbox . (fill_rect screen 0 0 8 8 2))
+  (sandbox . (brline screen 1 1 5 5 4))
 )
diff --git a/shell/global.mu b/shell/global.mu
index 21076549..4cf17de3 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -35,6 +35,7 @@ fn initialize-globals _self: (addr global-table) {
   append-primitive self, "="
   append-primitive self, "no"
   append-primitive self, "not"
+  append-primitive self, "dbg"
   # for pairs
   append-primitive self, "car"
   append-primitive self, "cdr"
@@ -608,6 +609,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand
     return
   }
   {
+    var debug?/eax: boolean <- string-equal? f-name, "dbg"
+    compare debug?, 0/false
+    break-if-=
+    apply-debug args-ah, out, trace
+    return
+  }
+  {
     var lesser?/eax: boolean <- string-equal? f-name, "<"
     compare lesser?, 0/false
     break-if-=
@@ -1181,6 +1189,30 @@ fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr
   new-integer out, 1
 }
 
+fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
+  trace-text trace, "eval", "apply debug"
+  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, "not needs 1 arg but got 0"
+    return
+  }
+  # dump args->left uglily to screen and wait for a keypress
+  var first-ah/eax: (addr handle cell) <- get args, left
+  dump-cell-from-cursor-over-full-screen first-ah
+  {
+    var foo/eax: byte <- read-key 0/keyboard
+    compare foo, 0
+    loop-if-=
+  }
+  # return nothing
+}
+
 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
   trace-text trace, "eval", "apply '<'"
   var args-ah/eax: (addr handle cell) <- copy _args-ah