~ chicken-core (master) /tests/life.scm

 1;;; The following example shows how a program can be divided into libraries plus a
 2;;; relatively small main program.
 3
 4(define-library (example grid)
 5  (export make rows cols ref each
 6          (rename put! set!))
 7  (import (scheme base))
 8  (begin
 9    ;; Create an NxM grid.
10    (define (make n m)
11      (let ((grid (make-vector n)))
12        (do ((i 0 (+ i 1)))
13            ((= i n) grid)
14          (let ((v (make-vector m #false)))
15            (vector-set! grid i v)))))
16    (define (rows grid)
17      (vector-length grid))
18    (define (cols grid)
19      (vector-length (vector-ref grid 0)))
20    (define (ref grid n m)
21      (vector-ref (vector-ref grid (modulo n (rows grid))) (modulo m (cols grid))))
22    (define (put! grid n m v)
23      (vector-set! (vector-ref grid n) m v))
24    (define (each grid proc)
25      (do ((j 0 (+ j 1)))
26          ((= j (rows grid)))
27        (do ((k 0 (+ k 1)))
28            ((= k (cols grid)))
29          (proc j k (ref grid j k)))))))
30
31(define-library (example life)
32  (export life)
33  (import (except (scheme base) set!)
34          (scheme write)
35          (example grid))
36  (begin
37    (define (life-count grid i j)
38      (define (count i j)
39        (if (ref grid i j) 1 0))
40      (+ (count (- i 1) (- j 1))
41         (count (- i 1) j)
42         (count (- i 1) (+ j 1))
43         (count i (- j 1))
44         (count i (+ j 1))
45         (count (+ i 1) (- j 1))
46         (count (+ i 1) j)
47         (count (+ i 1) (+ j 1))))
48    (define (life-alive? grid i j)
49      (case (life-count grid i j)
50        ((3) #true)
51        ((2) (ref grid i j))
52        (else #false)))
53    (define (life-print grid)
54      (newline) ;(display "\x1B;[1H\x1B;[J")  ; clear vt100
55      (each grid
56       (lambda (i j v)
57         (display (if v "*" " "))
58         (when (= j (- (cols grid) 1))
59           (newline)))))
60    (define (life grid iterations)
61      (do ((i 0 (+ i 1))
62           (grid0 grid grid1)
63           (grid1 (make (rows grid) (cols grid))
64                  grid0))
65          ((= i iterations))
66        (each grid0
67         (lambda (j k v)
68           (let ((a (life-alive? grid0 j k)))
69             (set! grid1 j k a))))
70        (life-print grid1)))))
71
72;; Main program.
73(import (only (example life) life)
74        (rename (prefix (example grid) grid-)
75                (grid-make make-grid)))
76
77;; Initialize a grid with a glider.
78(define grid (make-grid 8 8))
79(grid-set! grid 1 1 #true)
80(grid-set! grid 2 2 #true)
81(grid-set! grid 3 0 #true)
82(grid-set! grid 3 1 #true)
83(grid-set! grid 3 2 #true)
84
85;; Run for 40 iterations.
86(life grid 40)