Conway's Game of Life in Scheme

CGoL.scm

;; Using srfi.1 srfi.18 srfi.27
;;
;; gosh -u srfi.1 -u srfi.18 -u srfi.27 CGoL.scm
;; chibi-scheme -m srfi.1 -m srfi.18 -m srfi.27 CGoL.scm

(define xs 80) (define ys 38)

(random-source-randomize! default-random-source)
(define (randbinlist n)
  (list-tabulate n (lambda (n) (random-integer 2))))
(define (cinit)
  (let loop ((j ys) (rj '()))
    (if (= j 0) rj
        (loop (- j 1) (cons (randbinlist xs) rj)))))

(define (cprintline l)
  (let ((df (lambda (x) (if (= x 1) #\* #\space))))
    (display (list->string (map df l))) (newline)))
(define (cprint c)
  (display "\x1b[H\x1b[2J\x1b[3J")
  (for-each cprintline c) c)

(define (getxy c x y) (list-ref (list-ref c y) x))

(define (x_neighbor c i j l)
  (let loop ((k '(-1 0 1)) (t 0))
    (if (null? k) t
        (let ((tx (modulo (+ i (car k)) xs))
              (ty (modulo (+ j (car l)) ys)))
          (if (and (= (car k) 0) (= (car l) 0))
              (loop (cdr k) t)
              (loop (cdr k) (+ t (getxy c tx ty))))))))
(define (neighbor c i j)
  (let loopl ((l '(-1 0 1)) (tl 0))
    (if (null? l) tl
        (loopl (cdr l) (+ tl (x_neighbor c i j l))))))

(define (rule c i j)
  (let ((rl (neighbor c i j)))
    (if (= (getxy c i j) 1)
        (if (or (= rl 2) (= rl 3)) 1 0)
        (if (= rl 3) 1 0))))

(define (x_gen c j)
  (let loop ((i 0) (r '()))
    (if (= i xs) (reverse r)
        (loop (+ i 1) (cons (rule c i j) r)))))
(define (gen c)
  (let loop ((j 0) (r '()))
    (if (= j ys) (reverse r)
        (loop (+ j 1) (cons (x_gen c j) r)))))

(let loop ((c (cinit)))
  (cprint c) (thread-sleep! 0.2) (loop (gen c)))