Terminal-based "Game of Life" in R7RS Scheme

life.scm

;;;
;;; Conway's "Game of Life" in Scheme. This version is R7RS and runs
;;; with Chibi Scheme. "> chibi-scheme life.scm"
;;;

(import (scheme base)
        (scheme write)
        (only (srfi 18) thread-sleep!) ;; Multi-threading support
        (srfi 27)) ;; Source of random bits

(define-values (width height) (values 50 25))

;; Return a grid initialized with random placements of "living" cells.
(define (initialize-grid width height)
  (let ((grid (make-vector height)))
    (do ((row 0 (+ row 1)))
        ((= row height))
      (vector-set! grid row (make-vector width))
      (do ((col 0 (+ col 1)))
          ((= col width))
        (vector-set! (vector-ref grid row) col (random-integer 2))))
    grid))

;; Display the contents of the grid on the terminal.
(define (show-grid! grid)
  (display "\x1b;[2J\x1b;[H") ;; Clear the screen, move cursor to home.
  (do ((row 0 (+ row 1)))
      ((= row (vector-length grid)))
    (do ((col 0 (+ col 1)))
        ((= col (vector-length (vector-ref grid 0))))
      (let ((cell (vector-ref (vector-ref grid row) col)))
        (display (if (zero? cell) " " "O"))))
    (newline)))

;; Count and return the number of "living" neighbors of the cell
;; at the given coordinates.
(define (count-neighbors grid row col)
  (let* ((occupied? (lambda (r c)
                      (= (vector-ref (vector-ref grid r) c) 1)))
         (in-bounds? (lambda (r c)
                       (and (>= r 0)
                            (>= c 0)
                            (< r (vector-length grid))
                            (< c (vector-length (vector-ref grid r))))))
         (row-plus-2 (+ row 2))
         (col-plus-2 (+ col 2))
         (count-neighbors  (lambda ()
                             (let ((count 0))
                               (do ((r (- row 1) (+ r 1)))
                                   ((= r row-plus-2))
                                 (do ((c (- col 1) (+ c 1)))
                                     ((= c col-plus-2))
                                   (when (and (in-bounds? r c)
                                              (not (and (= r row) (= c col)))
                                              (occupied? r c))
                                     (set! count (+ count 1)))))
                               count))))
    (count-neighbors)))

;; Create and return a new grid based on application of the rules
;;; of the game to the contents of the previous generation.
(define (evolve-grid grid)
  (let ((next-grid (make-vector (vector-length grid)))
        (num-rows (vector-length grid))
        (num-cols (vector-length (vector-ref grid 0))))
    (do ((row 0 (+ row 1)))
        ((= row num-rows))
      (vector-set! next-grid row (make-vector num-cols)))
    (do ((row 0 (+ row 1)))
        ((= row (vector-length grid)))
      (do ((col 0 (+ col 1)))
          ((= col (vector-length (vector-ref grid 0))))
        (let ((num-neighbors (count-neighbors grid row col))
              (cell (vector-ref (vector-ref grid row) col)))
          (vector-set! (vector-ref next-grid row) col
                       (cond ((= num-neighbors 3) 1)
                             ((and (= num-neighbors 2) (= cell 1)) 1)
                             (else 0))))))
    next-grid))

;; Run a few generations of the game. The pause-milliseconds determines
;; how long to pause between generations. (Helps with animating the
;; appearance of the grid.)
(define (run-life width height generations pause-milliseconds)
  (let ((grid (initialize-grid width height))
        (wait-time (/ pause-milliseconds 1000)))
    (dynamic-wind
      (lambda ()
        (display "\x1b;[?25l")) ;; Hide the cursor.
      (lambda ()
        (do ((i 0 (+ i 1)))
            ((= i generations))
          (show-grid! grid)
          (newline)
          (set! grid (evolve-grid grid))
          (thread-sleep! wait-time)))
      (lambda ()
        (display  "\x1b;[?25h"))))) ;; Show the cursor.

(run-life width height 200 50)