From 7418ec72be49f8b9d6432bcba651597a7a1cc6f9 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 19 Apr 2016 04:04:54 -0400
Subject: [PATCH] initial file

---
 examples/game-of-life-png/example/grid.sld | 35 +++++++++++++++
 examples/game-of-life-png/example/life.sld | 51 ++++++++++++++++++++++
 examples/game-of-life-png/life.scm         | 35 +++++++++++++++
 3 files changed, 121 insertions(+)
 create mode 100644 examples/game-of-life-png/example/grid.sld
 create mode 100644 examples/game-of-life-png/example/life.sld
 create mode 100644 examples/game-of-life-png/life.scm

diff --git a/examples/game-of-life-png/example/grid.sld b/examples/game-of-life-png/example/grid.sld
new file mode 100644
index 00000000..cfefb242
--- /dev/null
+++ b/examples/game-of-life-png/example/grid.sld
@@ -0,0 +1,35 @@
+; Example from draft 6 of R7RS
+(define-library (example grid)
+    (export make rows cols ref each
+            put!) ;(rename put! set!))
+    (import (scheme base))
+    (begin
+      ;; Create an NxM grid.
+      (define (make n m)
+        (let ((grid (make-vector n)))
+          (do ((i 0 (+ i 1)))
+              ((= i n) grid)
+            (let ((v (make-vector m #f)))
+              (vector-set! grid i v)))))
+      (define (rows grid)
+        (vector-length grid))
+      (define (cols grid)
+        (vector-length (vector-ref grid 0)))
+      ;; Return #false if out of range.
+      (define (ref grid n m)
+        (and (< -1 n (rows grid))
+             (< -1 m (cols grid))
+             (vector-ref (vector-ref grid n) m)))
+      (define (put! grid n m v)
+        (define tmp (vector-ref grid n))
+        (vector-set! 
+            grid
+            n
+            (vector-set! tmp m v)))
+        ;(vector-set! (vector-ref grid n) m v))
+      (define (each grid proc)
+        (do ((j 0 (+ j 1)))
+            ((= j (rows grid)))
+          (do ((k 0 (+ k 1)))
+              ((= k (cols grid)))
+            (proc j k (ref grid j k)))))))
diff --git a/examples/game-of-life-png/example/life.sld b/examples/game-of-life-png/example/life.sld
new file mode 100644
index 00000000..6df7a0c1
--- /dev/null
+++ b/examples/game-of-life-png/example/life.sld
@@ -0,0 +1,51 @@
+(define-library (example life)
+  (export life)
+  (import (scheme base) ;TODO: (except (scheme base) set!)
+          (scheme write)
+          (example grid))
+  (begin
+    (define (life-count grid i j)
+      (define (count i j)
+        (if (ref grid i j) 1 0))
+      (+ (count (- i 1) (- j 1))
+         (count (- i 1) j)
+         (count (- i 1) (+ j 1))
+         (count i (- j 1))
+         (count i (+ j 1))
+         (count (+ i 1) (- j 1))
+         (count (+ i 1) j)
+         (count (+ i 1) (+ j 1))))
+    (define (life-alive? grid i j)
+      (case (life-count grid i j)
+            ((3) #t)
+            ((2) (ref grid i j))
+            (else #f)))
+    (define (clear-vt100)
+        (display
+            (string 
+                (integer->char #x1B) 
+                #\[
+                #\H
+                (integer->char #x1B)
+                #\[
+                #\J)))
+    (define (life-print grid)
+      (clear-vt100)
+      (each grid
+        (lambda (i j v)
+          (display (if v "*" " "))
+          (if (= j (- (cols grid) 1))
+          ;(when (= j (- (cols grid) 1))
+            (newline)))))
+    (define (life grid iterations)
+      (do ((i 0 (+ i 1))
+           (grid0 grid grid1)
+           (grid1 (make (rows grid) (cols grid))
+                  grid0))
+          ((= i iterations))
+        (each grid0
+          (lambda (j k v)
+            (let ((a (life-alive? grid0 j k)))
+              (put! grid1 j k a))))
+              ;(set! grid1 j k a))))
+        (life-print grid1)))))
diff --git a/examples/game-of-life-png/life.scm b/examples/game-of-life-png/life.scm
new file mode 100644
index 00000000..93b8171b
--- /dev/null
+++ b/examples/game-of-life-png/life.scm
@@ -0,0 +1,35 @@
+;;;
+;;; Justin Ethier
+;;; husk scheme
+;;;
+;;; The game of life example from r7rs. 
+;;; Main program
+;;;
+;;; To execute from the husk directory:
+;;;
+;;;  > cd examples/game-of-life
+;;;  > huski life.scm
+;;;
+(import (scheme base)
+        (example life)
+        (example grid))
+;; TODO:
+;        (only (example life) life)
+;        (rename (prefix (example grid) grid-)
+;                (grid-make make-grid)))
+
+;; Initialize a grid with a glider.
+;(define grid (make-grid 24 24))
+;(grid-put! grid 1 1 #t)
+;(grid-put! grid 2 2 #t)
+;(grid-put! grid 3 0 #t)
+;(grid-put! grid 3 1 #t)
+;(grid-put! grid 3 2 #t)
+(define grid (make 24 24))
+(put! grid 1 1 #t)
+(put! grid 2 2 #t)
+(put! grid 3 0 #t)
+(put! grid 3 1 #t)
+(put! grid 3 2 #t)
+;; Run for x iterations.
+(life grid 80)