DouKaku?beta

challenge ライフゲーム 

セルオートマトンに関するお題です. 
2次元タイプの'ライフゲーム'を実装して下さい. 
初期値としては10行10列程度の格子上の平面に0.3程度の人口(?)密度を考え, 
末端はループするようにして下さい. (例: 座標[-1, -1] = [10, 10])

それだけだと簡単すぎると思われる方は, 
過密状態で間引きが発生するような機能を組み込んで下さい. 
間引きは, 少なくともその後の1時間ステップにおける死亡率が, 
それをしなかった場合よりも小さくなれば結構です. 
(死亡率の最小化は複雑性が高すぎる感がありますし. )
サンプル:
t = 0
[ ][*][ ][ ][ ][ ][*][*][*][ ]
[ ][ ][ ][ ][*][ ][ ][*][*][ ]
[ ][ ][ ][*][ ][ ][*][ ][*][ ]
[*][ ][*][*][ ][ ][*][ ][ ][ ]
[ ][*][ ][ ][ ][ ][ ][ ][*][ ]
[*][ ][ ][ ][*][ ][*][*][ ][*]
[ ][*][ ][ ][ ][ ][*][ ][ ][ ]
[ ][ ][ ][ ][ ][ ][ ][ ][ ][*]
[*][ ][ ][ ][ ][ ][*][ ][ ][*]
[ ][ ][ ][ ][*][*][ ][ ][*][ ]
t = 1
[ ][ ][ ][ ][*][ ][ ][ ][ ][*]
[ ][ ][ ][ ][ ][*][ ][ ][ ][*]
[ ][ ][*][ ][*][*][*][ ][*][*]
[ ][*][ ][*][ ][ ][ ][ ][ ][*]
[ ][ ][*][*][ ][*][*][ ][*][ ]
[ ][*][ ][ ][ ][*][*][ ][*][*]
[ ][ ][ ][ ][ ][*][*][*][*][*]
[ ][ ][ ][ ][ ][ ][ ][ ][ ][*]
[*][ ][ ][ ][ ][*][ ][ ][*][ ]
[*][ ][ ][ ][ ][ ][ ][ ][ ][ ]

see: Wikipedia:ライフゲーム

post comment

Posted feedbacks - Scheme

  • (life-game board upper-time)で実行
    • boardは100要素の0, 1のリストとする
  • e以外を入力すると1ステップ進みステップ数と盤面を出力
  • eを入力すると打ち切り
  • ステップ数がupper-timeに到達したら終了

ところでt=1で(x,y)=(10,9)のセルは生きてるんじゃないでしょうか?

t=0で隣接する(10,8), (9, 10), (1,9)が生きているので. 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
(use util.list)
(use srfi-1)

(define (life-next-board board) ;盤面の更新
  (define (life-neighbours n) ;隣接セルのインデックス
    (define (ln-in x y)
      (+ (* (modulo x 10) 10) (modulo y 10)))
    (receive
     (x y)
     (quotient&remainder n 10)
     (list (ln-in (- x 1) (- y 1))
           (ln-in (- x 1) y)
           (ln-in (- x 1) (+ y 1))
           (ln-in x (- y 1))
           (ln-in x (+ y 1))
           (ln-in (+ x 1) (- y 1))
           (ln-in (+ x 1) y)
           (ln-in (+ x 1) (+ y 1)))))
  (define (life-live? n board) ;セルが生きているかどうか
    (= (list-ref board n) 1))
  (define (life-next-cell n board) ;セルの更新
    (let [(count
           (apply +
                  (map (lambda (x) (list-ref board x))
                       (life-neighbours n))))]
      (cond [(life-live? n board)
            (if (or (= count 2) (= count 3)) 1 0)]
            [else
            (if (= count 3) 1 0)])))
  (map (lambda (n) (life-next-cell n board))
       (iota 100)))

(define (life-print b t) ;出力用
  (begin
    (newline)
    (format #t "Time = ~d" t)
    (newline)
    (map print (slices b 10))))

(define (life-game b u-t) ;本体
  (define (lg-in b t)
    (let ((c (read-char)))
      (if (not (char=? #\e c))
          (unless (> t u-t)
            (begin
              (life-print b t)
              (lg-in (life-next-board b) (+ t 1)))))))
  (lg-in b 0))

(define b1 (list
            0 1 0 0 0 0 1 1 1 0
            0 0 0 0 1 0 0 1 1 0
            0 0 0 1 0 0 1 0 1 0
            1 0 1 1 0 0 1 0 0 0
            0 1 0 0 0 0 0 0 1 0
            1 0 0 0 1 0 1 1 0 1
            0 1 0 0 0 0 1 0 0 0
            0 0 0 0 0 0 0 0 0 1
            1 0 0 0 0 0 1 0 0 1
            0 0 0 0 1 1 0 0 1 0))

(life-game b1 10)

Gaucheでライフゲームを実装しました(間引き処理は実装していません)。あと、この実装過程をニコニコ動画にアップロードしてみました(http://www.nicovideo.jp/watch/sm2143250)。

プログラムの説明ですが、Gauche-rfbを使っているので、ブラウザでライフゲームを見ることができます。

実行方法は、以下のように画面のサイズ(ドット数)とフィールドのサイズと初期分布の確率を引数に与えてください。

% gosh lifegame.scm 400 400 10 10 0.3

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#!/usr/bin/env gosh
;; lifegame

(use srfi-42)
(use math.mt-random)
(use rfb)
(use util.match)

;; point
(define (make-point x y)
  (cons x y))

(define (point-x p)
  (car p))

(define (point-y p)
  (cdr p))


;; field
(define (make-field w h lifes)
  (list w h lifes))

(define (field-width field)
  (ref field 0))

(define (field-height field)
  (ref field 1))

(define (field-lifes field)
  (ref field 2))

(define make-random-field
  (let ((m (make <mersenne-twister> :seed (sys-time))))
    (lambda (w h prob)
      (make-field w h (list-ec (: x 0 w)
                               (: y 0 h)
                               (if (<= (mt-random-real m)
                                       prob))
                               (make-point x y))))))

(define (field-adjacent-point field p dx dy)
  (make-point (modulo (+ (point-x p) dx)
                      (field-width field))
              (modulo (+ (point-y p) dy)
                      (field-height field))))

(define (count-up-adjacent-points tbl field p)
  (for-each
   (match-lambda
    ((dx dy)
     (hash-table-update! tbl
                         (field-adjacent-point field
                                               p
                                               dx
                                               dy)
                         (cut + 1 <>)
                         0)))
   (list-ec (: x -1 2)
            (: y -1 2)
            (not (and (= x 0) (= y 0)))
            (list x y))))

(define (survive-lifes tbl field)
  (let ((lifes (field-lifes field)))
    (hash-table-fold
     tbl
     (lambda (p v lst)
       (if (or (and (or (= v 2) (= v 3))
                     (member p lifes))
               (and (= v 3)
                    (not (member p lifes))))
           (cons p lst)
           lst))
     '())))

(define (next-field field)
  (let ((tbl (make-hash-table 'equal?)))
    (for-each (lambda (p)
                (count-up-adjacent-points tbl
                                          field
                                          p))
              (field-lifes field))
    (make-field (field-width field)
                (field-height field)
                (survive-lifes tbl field))))

;; screen
(define *screen-width* 200)
(define *screen-height* 200)

(define (screen-draw-box w h p)
  (let* ((cx (/ *screen-width* w))
         (cy (/ *screen-height* h))
         (x (* cx (point-x p)))
         (y (* cy (point-y p))))
    (rfb-box x y (+ x cx -1) (+ y cy -1) 'white
             :filled? #t)))

(define (screen-clear)
  (rfb-clear 'black))

(define (screen-draw-field field)
  (for-each (lambda (p)
              (screen-draw-box (field-width field)
                               (field-height field)
                               p))
            (field-lifes field)))

(define (lifegame w h prob)
  (let ((f (make-random-field w h prob)))
    (while #t
      (with-rfb-transaction
       (lambda ()
         (screen-clear)
         (screen-draw-field f)))
      (set! f (next-field f)))))

(define (main args)
  (match-let1 (_ scr-w-str scr-h-str
                 field-w-str field-h-str
                 prob-str) args
    (set! *screen-width*
          (string->number scr-w-str))
    (set! *screen-height*
          (string->number scr-h-str))
    (rfb-init *screen-width*
              *screen-height*
              :port 8080)
    (apply lifegame (map string->number
                         (list field-w-str
                               field-h-str
                               prob-str)))
    0))

生まれてはじめてライフゲームを書いてみました。いままで人の書いたものを見たことはあったのですが。

ポイントとしては、循環リストを使って実装したことでしょうか。循環リストを使うことで、マップ境界に関する処理を一切考えなくてもよいようにしました。

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
#!/usr/bin/env gosh
;; -*- coding: utf-8 mode: scheme -*-


(use math.mt-random)
(use srfi-1)

(define map-size 10)

(define (main args)
  (let1 m
      (map-init
       #?=(let1 init-data ()
     (let ((mt (make <mersenne-twister> :seed (sys-time))))
       (for-each
        (lambda (x)
          (for-each
           (lambda (y)
         (if (<= (mt-random-real mt) 0.3)
             (set! init-data (cons (cons x y) init-data))))
           (iota map-size 1)))
        (iota map-size 1)))
     init-data))
    ;; (print-map m)
    (lifegame-loop m)
    )
  0)

(define (map-init init-data)
  (let1 map-data (make-map)
    (for-each
     (lambda (datum)
       (let ((x (car datum))
         (y (cdr datum)))
     (map-set! map-data #t x y)))
     init-data)
    map-data))

(define (make-map)
  (define (list->ring ls)
    (let loop((ls_ ls))
    (if (null? (cdr ls_))
        (begin (set-cdr! ls_ ls) ls)
        (loop (cdr ls_)))))

  (define (make-ring-line)
    (list->ring (make-list map-size #f)))

  (define (make-ring-map)
    (let1 ls
    (let loop((ret ()) (itr map-size))
      (if (= 0 itr)
          ret
          (loop (cons (make-ring-line) ret) (- itr 1))))
      (list->ring ls)))

  (make-ring-map))

(define (print-map map-data)
  (define (print-line line)
    (let loop((itr 1))
      (if (> itr map-size)
      (newline)
      (begin
        (if (ref line itr) (display "[*]") (display "[ ]"))
        (loop (+ itr 1))))))
  (let loop ((itr 1))
    (if (> itr map-size)
    (newline)
    (begin
      (print-line (ref map-data itr))
      (loop (+ 1 itr))))))

(define (delete-map)
  (for-each
   display
   (make-list (+ 1 (* 3 map-size map-size ) map-size) "\x08"))
  )

(define (map-examine map-data x y)
  (let1 args
      (map
       (lambda (x)
     (while (< x 1)
        (set! x (+ x map-size)))
     x)
       (list x y))
    (set! x (car args))
    (set! y (cadr args)))
  (ref (ref map-data y) x)
  )

(define (map-on! map-data x y)
  (print-map (map-set! map-data #t x y)))

(define (map-off! map-data x y)
  (print-map (map-set! map-data #f x y)))

(define (map-set! map-data new-val x y)
  (define (nth-cdr ls n)
    (let loop((ret ls) (n n))
      (if (= n 0)
      ret
      (loop (cdr ret) (- n 1)))))

  (let1 args
      (map
       (lambda (x)
     (while (< x 1)
        (set! x (+ x map-size)))
     x)
       (list x y))
    (set! x (car args))
    (set! y (cadr args)))
  
  (set-car! (nth-cdr (ref map-data y) x)
        new-val)
  map-data)

(define (count-neighbors map-data x y)
    (let1 count 0
      (for-each
       (lambda (arg)
     (let ((x (car arg)) (y (cdr arg)))
       (if (map-examine map-data x y)
           (set! count (+ count 1)))))
       (let loop ((ret ()) (nx (- x 1)) (ny (- y 1)))
     (cond
      ((> ny (+ y 1))
       ret)
      ((> nx (+ x 1))
       (loop ret (- x 1) (+ ny 1)))
      (else
       (loop (if (and (= x nx) (= y ny))
             ret
             (cons `(,nx . ,ny) ret))
         (+ nx 1)
         ny)))))
      count))

(define (map-next-step old-map)
  (let1 new-map
      (make-map)
    (for-each
     (lambda (x)
       (for-each
    (lambda (y)
      (let1 count (count-neighbors old-map x y)
        (if (map-examine old-map x y)
        ;;; if alive
        (if (or (= count 2) (= 3 count))
            (map-set! new-map #t x y)
            (map-set! new-map #f x y))

        ;;; if dead
        (if (= count 3)
            (map-set! new-map #t x y)
            (map-set! new-map #f x y))))
      )
    (iota map-size 1)))
     (iota map-size 1))
    new-map))

(define (lifegame-loop map-data)
  (print-map map-data)
  (let loop((m map-data))
    (delete-map)
    (print-map m)
    (sys-nanosleep 100000000)
    (loop (map-next-step m))))

初めて投稿します。 よろしくお願いします。 普段はC++を扱う事が多いのですが、趣味でSchemeを勉強しています。 書き方が変なところなどがあれば、ご指摘くださいませ。

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
(use srfi-1)
(use srfi-27)
(use srfi-43)

;;主手続き
(define (life-game n t)
  (let loop ((board (make-initial-board n))
             (count 0))
    (if (= count t)
        #f
        (begin
          (display-life-game board n)
          (loop (next-step board n) (+ count 1))))))

;;画面出力
(define (display-life-game board n)
  (begin
    (vector-for-each (lambda (position state)
                  (if (= (remainder (+ position 1) n) 0)
                      (print state)
                      (display state)))
                board)
    (newline)))

;;初期の盤面を作成
;;ランダムな盤面を作成
(define (make-initial-board n)
  (let1 board (make-vector (* n n) 0)
    (vector-map (lambda (x y)
                  (random-integer 2))
                board)))

;;盤面を更新
(define (next-step board size)
  (vector-map (lambda (loc stat)
                (state-change-rule stat
                                   (fold +
                                         0
                                         (map (pa$ vector-ref board)
                                              (neighbor-cell loc size)))))
              board))

;;状態を変えるルール
(define (state-change-rule self neighbor-sum)
  (if (= self 0)
      (if (= neighbor-sum 3)
          1
          0)
      (if (or (= neighbor-sum 2) (= neighbor-sum 3))
          1
          0)))

;;近傍セルを取得
(define (neighbor-cell r size)
  (define (boundary-check x)
    (cond ((< x 0) (+ x size))
          ((>= x size) (- x size))
  (define (make-coodinate-change-proc x y)
    (lambda (offset)
      (+ (boundary-check (+ x (car offset)))
         (* (boundary-check (- y (cdr offset)))
            size))))

  (receive (y x) (quotient&remainder r size)
    (map (make-coodinate-change-proc x y)
         (list (cons 1 0)
               (cons 1 -1)
               (cons 0 -1)
               (cons -1 -1)
               (cons -1 0)
               (cons -1 1)
               (cons 0 1)
               (cons 1 1)))))


Scheme勉強中なのでチャレンジしてみました
12x12のフィールドを用意して、毎回フチの部分をコピーして[-1, -1] = [10, 10]な感じにしました

Enter押す→次の時刻
eを入力する→終わる

Scheme的に自然な書き方になっているかどうかわからないのでコメントいただけると嬉しいです
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
(use srfi-1)
(use srfi-27)

(define width 10)
(define height 10)
(define population 0.3)

(define birth '(3))
(define keep '(2 3))

(define element-x caar)
(define element-y cadar)
(define element-value cadr)

(define xy-asix
    (fold-right append '()
        (let
            ((width (+ width 2))
             (height (+ height 2)))
            (map
                (lambda (x)
                    (zip
                        (iota width 0)
                        (make-list width x)))
                (iota height 0)))))

(define visible-xy-asix
    (filter
        (lambda (e)
            (let
                ((x (car e))
                 (y (cadr e)))
                (and (< 0 x) (<= x width) (< 0 y) (<= y height))))
        xy-asix))

(define (step-exec value next proc)
    (define (iter value cc)
        (cc value
            (lambda () (iter (next value) cc))))
    (lambda () 
        (iter
            value
            (lambda (value cc) (proc value) cc))))

(define (make-field)
    (zip
        xy-asix
        (make-list (* (+ width 2) (+ height 2)) #f)))

(define (count field)
    (length (filter (lambda (e) (element-value e)) field)))

(define (print-field field)
    (define (print-cell e)
        (if    (element-value e)
            (display "[*]")
            (display "[ ]")))
    (define (visible-field)
        (filter
            (lambda (e) (find (cut equal? (car e) <>) visible-xy-asix))
            field))
    (let loop ((left (visible-field)))
        (if    (not (null? left))
            (begin
                (print-cell (car left))
                (if    (= (element-x (car left)) width)
                    (newline))
                (loop (cdr left))))))

(define (randomize-field field)
    (random-source-randomize! default-random-source)
    (map
        (lambda (e) 
            (if (< (random-real) population)
                (list (car e) #t)
                (list (car e) #f)))
        field))

(define (copy-overlap-field field)
    (define (relation-zip proc from to)
        (zip
            (filter (lambda (e) (= (proc e) from)) field)
            (filter (lambda (e) (= (proc e) to)) field)))
    (define (copy relation)
        (let loop ((r relation))
            (if    (null? r)
                #f
                (begin
                    (set! (element-value (caar r)) (element-value (cadar r)))
                    (loop (cdr r))))))
    (let*
        ((left        (relation-zip element-x 0 width))
         (right        (relation-zip element-x (+ width 1) 1))
         (top        (relation-zip element-y 0 height))
         (bottom    (relation-zip element-y (+ height 1) 1)))
        (copy (append left right top bottom)))
    field)

(define (game-next field)
    (define (get-neighbors x y)
        (filter
            (lambda (e)
                (and
                    (<= (- x 1) (element-x e) (+ x 1))
                    (<= (- y 1) (element-y e) (+ y 1))
                    (not (and (= x (element-x e)) (= y (element-y e))))))
            field))
    (define (next-state e)
        (define neighbors (count (get-neighbors (element-x e) (element-y e))))
        (define live? element-value)
        (define (live->next)
            (if (fold (lambda (x y) (or x y)) #f (map (cut = neighbors <>) keep))
                e
                (list (car e) #f)))
        (define (dead->next)
            (if (fold (lambda (x y) (or x y)) #f (map (cut = neighbors <>) birth))
                (list (car e) #t)
                e))
        (if    (live? e)
            (live->next)
            (dead->next)))
    (define (calc-next)
        (map
            (lambda (e)
                (if    (find (cut equal? (car e) <>) visible-xy-asix)
                    (next-state e)
                    e))
            field))
    (copy-overlap-field (calc-next)))

;準備
(define next
    (step-exec
        (copy-overlap-field (randomize-field (make-field)))
        game-next
        (lambda (e) (print-field e))))

;実行
(let loop
    ((c (read-char))
     (count 1))
    (if    (char=? #\e c)
        (exit 0)
        (begin
            (display count)
            (newline)
            (set! next (next))
            (newline)
            (loop (read-char) (+ count 1)))))

ライフゲーム、はじめて作りましたがなかなか面白いですね。
もう既にたくさん回答されてますが、せっかくなので投稿させてください。
Gauche-GL で作ってみました。 
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
(use gl)
(use gl.glut)
(use srfi-42)
(use gauche.uvector)

(define *life-width* 20)
(define *life-height* 20)

(define *field-width* 10)
(define *field-height* 10)

;; 出題パターン
(define *field* '(
    (0 1 0 0 0 0 1 1 1 0)
    (0 0 0 0 1 0 0 1 1 0)
    (0 0 0 1 0 0 1 0 1 0)
    (1 0 1 1 0 0 1 0 0 0)
    (0 1 0 0 0 0 0 0 1 0)
    (1 0 0 0 1 0 1 1 0 1)
    (0 1 0 0 0 0 1 0 0 0)
    (0 0 0 0 0 0 0 0 0 1)
    (1 0 0 0 0 0 1 0 0 1)
    (0 0 0 0 1 1 0 0 1 0)))

;; グライダーパターン
#;(define *field* '(
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 1 0 0 0 0 0 0)
    (0 0 1 0 0 0 0 0 0 0)
    (0 0 1 1 1 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)
    (0 0 0 0 0 0 0 0 0 0)))

(define field-ref (lambda (x y)
    (cond
        ((< x 0) (field-ref (+ x *field-width*) y))
        ((>= x *field-width*) (field-ref (- x *field-width*) y))
        ((< y 0) (field-ref x (+ y *field-height*)))
        ((>= y *field-height*) (field-ref x (- y *field-height*)))
        (else (list-ref (list-ref *field* y) x)))))

(define count-around (lambda (x y)
    (let loop ((count 0) (ls
        '((-1 . -1) (0 . -1) (1 . -1) (1 . 0)
        (1 . 1) (0 . 1) (-1 . 1) (-1 . 0))))
        (if (pair? ls)
            (loop
                (+ count (field-ref (+ x (caar ls)) (+ y (cdar ls))))
                (cdr ls))
            count))))

(define born? (lambda (x y)
    (= 3 (count-around x y))))

(define live? (lambda (x y)
    (let ((n (count-around x y)))
        (or (= n 2) (= n 3)))))

(define next-field (lambda ()
    (list-ec (: y *field-height*)
        (list-ec (: x *field-width*)
            (cond
                ((= 0 (field-ref x y)) (if (born? x y) 1 0))
                ((= 1 (field-ref x y)) (if (live? x y) 1 0))
                (else 0))))))

(define gl-draw-fill-rect (lambda (x y w h)
    (gl-begin* GL_POLYGON
        (gl-vertex (f32vector x y 0.0))
        (gl-vertex (f32vector (+ x w) y 0.0))
        (gl-vertex (f32vector (+ x w) (+ y h) 0.0))
        (gl-vertex (f32vector x (+ y h) 0.0)))))

(define gl-idle (lambda ()
    (set! *field* (next-field))
    (sys-sleep 1)
    (glut-post-redisplay)))

(define gl-disp (lambda ()
    (gl-clear GL_COLOR_BUFFER_BIT)
    (gl-color (f32vector 0.0 0.0 0.0))
    (do-ec (: x *field-width*) (: y *field-height*)
        (if (= 1 (field-ref x y))
            (gl-draw-fill-rect
                (* x *life-width*)
                (* y *life-height*)
                *life-width*
                *life-height*)))
    (glut-swap-buffers)))

(define gl-resize (lambda (w h)
    (gl-viewport 0 0 w h)))

(define gl-keyboard (lambda (key x y)
    (if (= key (char->integer #\escape)) (exit 0))))

(define gl-visible (lambda (v)
    (if (= v GLUT_VISIBLE)
        (glut-idle-func gl-idle)
        (glut-idle-func #f))))

(define main (lambda (args)
    (let ((width (* *life-width* *field-width*))
            (height (* *life-height* *field-height*)))
        (glut-init args)
        (glut-init-display-mode (logior GLUT_DOUBLE GLUT_RGB))
        (glut-init-window-size width height)
        (glut-init-window-position 100 100)
        (glut-create-window "LIFEGAME")
        (gl-clear-color 1.0 1.0 1.0 0.0)
        (gl-matrix-mode GL_PROJECTION)
        (gl-load-identity)
        (gl-ortho 0.0 width height 0.0 -1.0 1.0)
        (glut-display-func gl-disp)
        (glut-reshape-func gl-resize)
        (glut-keyboard-func gl-keyboard)
        (glut-visibility-func gl-visible)
        (