The Game of Life on Gauche

Lifegame.scm

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

(define *screen-width* 500)
(define *screen-height* 500)
(define *field-width* 100)
(define *field-height* 100)

(define field
  (let* ([tbl (make-hash-table 'equal?)]
	 [mt (make <mersenne-twister> :seed (sys-time))]
	 [as (list-ec (: x *field-width*)
		      (: y *field-height*)
		      (cons (cons x y) (<= 0.5 (mt-random-real0 mt))))])
    (for-each (lambda (p)
		(hash-table-put! tbl (car p) (cdr p)))
	      as)
    tbl))

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

(define (x-of p)
  (car p))

(define (y-of p)
  (cdr p))

(define (adjacent-point p dx dy)
  (let* ([x (x-of p)]
	 [y (y-of p)]
	 [nx (mod (+ x dx) *field-width*)]
	 [ny (mod (+ y dy) *field-height*)])
    (make-point nx ny)))

(define (alive? p)
  (~ field p))

(define (count-surrounding-lives p)
  (count alive? (list-ec (: dx -1 2)
			 (: dy -1 2)
			 (not (and (= dx 0) (= dy 0)))
			 (adjacent-point p dx dy))))

(define (tobeinverted? p)
  (let1 c (count-surrounding-lives p)
    (if (alive? p)
	(or (<= c 1) (>= c 4))
	(= c 3))))

(define-macro (inv! x)
  `(set! ,x (not ,x)))

(define (step)
  (let1 torev ()
    (for-each (lambda (p)
		      (when (tobeinverted? p)
			(push! torev p)))
	      (hash-table-keys field))
    (for-each (lambda (p) (inv! (~ field p))) torev)))

(define (dispfield)
  (for-each (lambda (y)
	      (for-each (lambda (x)
			  (display (if (~ field (cons x y)) "*" "-")))
			(iota *field-width*))
	      (newline))
	    (iota *field-height*)))

(use rfb)

(define (screen-draw-field)
  (let ([cw (/ *screen-width* *field-width*)]
	[ch (/ *screen-height* *field-height*)])
    (for-each (lambda (p)
		(let ([x (* (x-of p) cw)]
		      [y (* (y-of p) ch)])
		  (rfb-box x y (+ x cw) (+ y ch) 'white :filled? #t)))
	      (filter (^p (~ field p))
		      (hash-table-keys field)))))

(rfb-init *screen-width* *screen-height* :port 8080)
(while #t
  (sys-nanosleep (inexact (/ 1 60)))
  (with-rfb-transaction
   (lambda()
     (rfb-clear 'black)
     (screen-draw-field)))
  (step))