r7rs-small-library-example

(define-library (example grid)
                (export make rows cols ref each)
                (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 #false)))
                          (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 (grid-put! grid n 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)))))))

(define-library (example life)
                (export life)
                (import (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) #true)
                      ((2) (ref grid i j))
                      (else #false)))
                  (define (life-print grid)
                    (display "\x1B;[1H\x1B;[J") ; clear vt100
                    (each grid
                          (lambda (i j v)
                            (display (if v "*" " "))
                            (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)))
                                (grid-put! grid1 j k a))))
                      (life-print grid1)))))

;; Main program.
(import (scheme base)
        (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-set! grid 1 1 #true)
(grid-set! grid 2 2 #true)
(grid-set! grid 3 0 #true)
(grid-set! grid 3 1 #true)
(grid-set! grid 3 2 #true)
;; Run for 80 iterations.
(life grid 80)