game of life in lisp

Super slow; each frame is cleared as a sort of progress indicator while
it computes the next frame.

In the process I realize I need to adjust every single trace in the
shell sources to be more fault-tolerant to a filled-up trace stream.

2 files changed, 91 insertions, 29 deletions

diff --git a/shell/data.limg b/shell/data.limg
index 88e81da6..b11e50c8 100644
--- a/shell/data.limg
+++ b/shell/data.limg
@@ -165,28 +165,68 @@
       for x 0 (x < w) ++x
         (pixel screen x y (palette Greys x*y))])
     (main . [def (main screen keyboard)
-  (pat screen)])
-    (lifreres . [define liferes 8])
+  (life screen keyboard)])
+    (liferes . [define liferes 8])
     (life . [def (life screen)
-  let g (grid (/ (width screen) liferes)
-              (/ (height screen) liferes)
-              0)
-    isetgrid g 5 5 1
-    isetgrid g 6 5 1
-    isetgrid g 4 6 1
-    isetgrid g 5 6 1
-    isetgrid g 5 7 1
-    while 1
-      steplife g
-      renderlife screen g])
-    (steplife . [def (steplife g)
-  ])
+  with (w (/ (width screen) liferes)
+        h (/ (height screen) liferes))
+    with (g1 (grid w h 0)
+          g2 (grid w h 0))
+      isetgrid g1 w/2 h/2-1 1
+      isetgrid g1 w/2+1 h/2-1 1
+      isetgrid g1 w/2-1 h/2 1
+      isetgrid g1 w/2 h/2 1
+      isetgrid g1 w/2 h/2+1 1
+      renderlife screen g1
+      while 1
+        steplife g1 g2 screen
+        renderlife screen g2
+        steplife g2 g1 screen
+        renderlife screen g1])
+    (steplife . [def (steplife old new screen)
+  ++lifetime
+  with (h (len old)
+        w (len (index old 0)))
+    for x 0 (< x w) ++x
+      for y 0 (< y h) ++y
+        fill_rect screen x*liferes y*liferes x+1*liferes y+1*liferes 0
+        with (curr (indexgrid old x y)
+              n (neighbors old x y w h)
+             )
+          isetgrid new x y (if (= n 2)
+                             curr
+                             (if (= n 3)
+                               1
+                               0))])
     (renderlife . [def (renderlife screen g)
   with (w (width screen)
         h (height screen))
-    for y 0 (< y h) ++y
-      for x 0 (< x w) ++x
-        (pixel screen x y (indexgrid g x/liferes y/liferes))])
+    for y 0 (< y h) y+=liferes
+      for x 0 (< x w) x+=liferes
+        (fill_rect screen x y x+liferes y+liferes 
+          (if (0 = (indexgrid g x/liferes y/liferes))
+            3
+#            (1 + lifetime%15)
+            0))])
+    (neighbors . [def (neighbors g x y w h)
+  ret result 0
+    when (y > 0)
+      when (x > 0)
+        result += (indexgrid g x-1 y-1)
+      result += (indexgrid g x y-1)
+      when (x < w-1)
+        result += (indexgrid g x+1 y-1)
+    when (x > 0)
+      result += (indexgrid g x-1 y)
+    when (x < w-1)
+      result += (indexgrid g x+1 y)
+    when (y < h-1)
+      when (x > 0)
+        result += (indexgrid g x-1 y+1)
+      result += (indexgrid g x y+1)
+      when (x < w-1)
+        result += (indexgrid g x+1 y+1)])
+    (lifetime . [define lifetime 0])
   ))
   (sandbox . [life screen])
 )
diff --git a/shell/evaluate.mu b/shell/evaluate.mu
index cb2c84ef..932a0fa5 100644
--- a/shell/evaluate.mu
+++ b/shell/evaluate.mu
@@ -799,15 +799,21 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o
     break-if-=
     var stream-storage: (stream byte 0x200)
     var stream/ecx: (addr stream byte) <- address stream-storage
-    write stream, "pushing bindings from "
+    var overflow?/eax: boolean <- try-write stream, "pushing bindings from "
+    compare overflow?, 0/false
+    break-if-!=
     var nested-trace-storage: trace
     var nested-trace/edi: (addr trace) <- address nested-trace-storage
     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
     print-cell params-ah, stream, nested-trace
-    write stream, " to "
+    var overflow?/eax: boolean <- try-write stream, " to "
+    compare overflow?, 0/false
+    break-if-!=
     clear-trace nested-trace
     print-cell args-ah, stream, nested-trace
-    write stream, " onto "
+    var overflow?/eax: boolean <- try-write stream, " onto "
+    compare overflow?, 0/false
+    break-if-!=
     var old-env-ah/eax: (addr handle cell) <- address old-env-h
     clear-trace nested-trace
     print-cell old-env-ah, stream, nested-trace
@@ -881,13 +887,17 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
     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 "
+    var overflow?/eax: boolean <- try-write stream, "look up "
+    compare overflow?, 0/false
+    break-if-!=
     var sym2/eax: (addr cell) <- copy sym
     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
     rewind-stream sym-data
     write-stream stream, sym-data
-    write stream, " in "
+    var overflow?/eax: boolean <- try-write stream, " in "
+    compare overflow?, 0/false
+    break-if-!=
     var env-ah/eax: (addr handle cell) <- address env-h
     var nested-trace-storage: trace
     var nested-trace/edi: (addr trace) <- address nested-trace-storage
@@ -926,12 +936,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
       break-if-!=
       var stream-storage: (stream byte 0x200)
       var stream/ecx: (addr stream byte) <- address stream-storage
-      write stream, "=> "
+      var overflow?/eax: boolean <- try-write stream, "=> "
+      compare overflow?, 0/false
+      break-if-!=
       var nested-trace-storage: trace
       var nested-trace/edi: (addr trace) <- address nested-trace-storage
       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
       print-cell out, stream, nested-trace
-      write stream, " (global)"
+      var overflow?/eax: boolean <- try-write stream, " (global)"
+      compare overflow?, 0/false
+      break-if-!=
       trace trace, "eval", stream
     }
     # }}}
@@ -983,12 +997,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
       break-if-!=
       var stream-storage: (stream byte 0x800)
       var stream/ecx: (addr stream byte) <- address stream-storage
-      write stream, "=> "
+      var overflow?/eax: boolean <- try-write stream, "=> "
+      compare overflow?, 0/false
+      break-if-!=
       var nested-trace-storage: trace
       var nested-trace/edi: (addr trace) <- address nested-trace-storage
       initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
       print-cell out, stream, nested-trace
-      write stream, " (match)"
+      var overflow?/eax: boolean <- try-write stream, " (match)"
+      compare overflow?, 0/false
+      break-if-!=
       trace trace, "eval", stream
     }
     # }}}
@@ -1011,12 +1029,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
     break-if-!=
     var stream-storage: (stream byte 0x200)
     var stream/ecx: (addr stream byte) <- address stream-storage
-    write stream, "=> "
+    var overflow?/eax: boolean <- try-write stream, "=> "
+    compare overflow?, 0/false
+    break-if-!=
     var nested-trace-storage: trace
     var nested-trace/edi: (addr trace) <- address nested-trace-storage
     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
     print-cell out, stream, nested-trace
-    write stream, " (recurse)"
+    var overflow?/eax: boolean <- try-write stream, " (recurse)"
+    compare overflow?, 0/false
+    break-if-!=
     trace trace, "eval", stream
   }
   # }}}