Conway's game of life in chez scheme

life.scm

(define-record generation (num cols rows board))

(define (board-at g x y)
  (let
    ([board (generation-board g)]
     [cols (generation-cols g)])
    (fxvector-ref board (+ (* y cols) x))))

(define (board-set! g x y value)
  (let
    ([board (generation-board g)]
     [cols (generation-cols g)])
    (fxvector-set! board (+ (* y cols) x) value)))

(define (cell-alive? g x y)
  (define (prev-x)
    (if (= x 0) 0 (- x 1)))
  
  (define (next-x)
    (let*
      ([cols (generation-cols g)]
       [cols* (- cols 1)])
      (if (= x cols*) cols* (+ x 1))))
  
  (define (prev-y)
    (if (= y 0) 0 (- y 1)))
  
  (define (next-y)
    (let*
      ([rows (generation-rows g)]
       [rows* (- rows 1)])
      (if (= y rows*) rows* (+ y 1))))
  (let*
    ([c1 (board-at g (prev-x) (prev-y))]
     [c2 (board-at g x (prev-y))]
     [c3 (board-at g (next-x) (prev-y))]
     [c4 (board-at g (prev-x) y)]
     [c5 (board-at g x y)]
     [c6 (board-at g (next-x) y)]
     [c7 (board-at g (prev-x) (next-y))]
     [c8 (board-at g x (next-y))]
     [c9 (board-at g (next-x) (next-y))]

     [neighs (list c1 c2 c3 c4 c6 c7 c8 c9)]
     [alive (fold-left + 0 neighs)])
    (cond
      ((and (= 1 c5) (or (= 2 alive) (= 3 alive)))
        1)
      ((and (= 0 c5) (= 3 alive))
        1)
      (#t
        0))))

(define (next-generation g)
  (let*
    ([cols (generation-cols g)]
     [rows (generation-rows g)]
     [num (generation-num g)]
     [new-board (make-fxvector (* rows cols))]
     [g+1 (make-generation (+ 1 num) cols rows new-board)])
    (do ([y 0 (+ y 1)])
        ((= y rows) y)
        (do ([x 0 (+ x 1)])
            ((= x cols) x)
            (board-set! g+1 x y (cell-alive? g x y))))
    g+1))

(define (randomize-board g)
  (let
    ([cols (generation-cols g)]
     [rows (generation-rows g)])
    (define (fill-row y)
      (do ([x 0 (+ x 1)])
          ((= x cols) x)
          (board-set! g x y (random 2))))
    (do ([y 0 (+ y 1)])
        ((= y rows) y)
        (fill-row y))
    g))

(define (clear)
  (printf "\033c"))

(define (print-board g)
  (let
    ([cols (generation-cols g)]
     [rows (generation-rows g)])
    (define (print-row y)
      (do ([x 0 (+ x 1)])
          ((= x cols) x)
          (printf (format "~a" (if (= 1 (board-at g x y)) #\@ #\.)))))
    (do ([y 0 (+ y 1)])
        ((= y rows) y)
        (begin
          (print-row y)
          (printf "~n")))
    (clear)))

(define (generation-run g)
  (print-board g)
  (sleep (make-time 'time-duration 200000000 0))
  (generation-run (next-generation g)))

(define (main rows cols)
  (let*
    ([b (make-fxvector (* rows cols))]
     [g (make-generation 0 cols rows b)])
    (clear)
    (generation-run (randomize-board g))))

(let*
  ([args (cdr (command-line))]
   [cols (string->number (car args))]
   [rows (string->number (car (cdr args)))])
  (main rows cols))