From 5908943f47dd1c054b3335c963672bc652bad140 Mon Sep 17 00:00:00 2001
From: "Kartik K. Agaram" <vc@akkartik.com>
Date: Sat, 17 Apr 2021 09:01:22 -0700
Subject: Bresenham line-drawing now working

I can't run tests right now, and the trace is disabled. Still, progress.

https://merveilles.town/@akkartik/106081486035689980

Current state of the disk image:
  (
    (globals . (
      (hline1 . (fn () (screen y lo hi)
                  (if (>= lo hi)
                    ()
                    ((fn ()
                       (pixel screen lo y 12)
                       (hline1 screen y (+ lo 1) hi))))))
      (vline1 . (fn () (screen x lo hi)
                  (if (>= lo hi)
                    ()
                    ((fn ()
                       (pixel screen x lo 12)
                       (vline1 screen x (+ lo 1) hi))))))
      (hline . (fn () (screen y)
                 (hline1 screen y 0 (width screen))))
      (vline . (fn () (screen y)
                 (vline1 screen y 0 (height screen))))
      (andf . (fn () (a b)
                (if a
                  (if b
                    1
                    ())
                  ())))
      (brline . (fn () (screen x0 y0 x1 y1)
                   ((fn (dx dy sx sy)
                      ((fn (err)
                         (brline1 screen x0 y0 x1 y1 dx dy sx sy err))
                       (+ dx dy)))
                    (abs (- x1 x0))
                    (- 0 (abs (- y1 y0)))
                    (sgn (- x1 x0))
                    (sgn (- y1 y0)))))
      (brline1 . (fn () (screen x y xmax ymax dx dy sx sy err)
                   (pixel screen x y 12)
                   (if (andf (= x xmax) (= y ymax))
                     ()
                     ((fn (e2)
                        (brline1 screen
                          (if (>= e2 dy)
                            (+ x sx)
                            x)
                          (if (<= e2 dx)
                            (+ y sy)
                            y)
                          xmax
                          ymax
                          dx
                          dy
                          sx
                          sy
                          (+ err
                             (+
                               (if (>= e2 dy)
                                 dy
                                 0)
                               (if (<= e2 dx)
                                 dx
                                 0)))))
                      (* err 2)))))
    ))
    (sandbox . (brline screen 1 1 5 5))
  )
---
 shell/evaluate.mu | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)

diff --git a/shell/evaluate.mu b/shell/evaluate.mu
index 6ecb6047..8c8bf933 100644
--- a/shell/evaluate.mu
+++ b/shell/evaluate.mu
@@ -11,6 +11,8 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
 #?   }
   # trace "evaluate " in " in environment " env {{{
   {
+    compare trace, 0
+    break-if-=
     var stream-storage: (stream byte 0x100)
     var stream/ecx: (addr stream byte) <- address stream-storage
     write stream, "evaluate "
@@ -220,6 +222,8 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
   trace-higher trace
   # trace "=> " out {{{
   {
+    compare trace, 0
+    break-if-=
     var stream-storage: (stream byte 0x100)
     var stream/ecx: (addr stream byte) <- address stream-storage
     write stream, "=> "
@@ -244,6 +248,8 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand
   # if it's not a primitive function it must be an anonymous function
   # trace "apply anonymous function " f " in environment " env {{{
   {
+    compare trace, 0
+    break-if-=
     var stream-storage: (stream byte 0x100)
     var stream/ecx: (addr stream byte) <- address stream-storage
     write stream, "apply anonymous function "
@@ -335,6 +341,8 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o
   # Params can only be symbols or pairs. Args can be anything.
   # trace "pushing bindings from " params " to " args {{{
   {
+    compare trace, 0
+    break-if-=
     var stream-storage: (stream byte 0x200)
     var stream/ecx: (addr stream byte) <- address stream-storage
     write stream, "pushing bindings from "
@@ -394,6 +402,8 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o
 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
   # trace sym
   {
+    compare trace, 0
+    break-if-=
     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
     var stream/ecx: (addr stream byte) <- address stream-storage
     write stream, "look up "
@@ -428,6 +438,8 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
     trace-higher trace
     # trace "=> " out " (global)" {{{
     {
+      compare trace, 0
+      break-if-=
       var error?/eax: boolean <- has-errors? trace
       compare error?, 0/false
       break-if-!=
@@ -478,6 +490,8 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
     cdr env-head, out, 0/no-trace
     # trace "=> " out " (match)" {{{
     {
+      compare trace, 0
+      break-if-=
       var error?/eax: boolean <- has-errors? trace
       compare error?, 0/false
       break-if-!=
@@ -500,6 +514,8 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
   trace-higher trace
     # trace "=> " out " (recurse)" {{{
     {
+      compare trace, 0
+      break-if-=
       var error?/eax: boolean <- has-errors? trace
       compare error?, 0/false
       break-if-!=
-- 
cgit 1.4.1-2-gfad0