#lang scheme/gui
;;; Conway's Game of Life
;;;
;;; http://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
;;;
;;; Rules
;;; -----------------------------------------------------------------------------
;;; The universe of the Game of Life is an infinite two-dimensional orthogonal
;;; grid of square cells, each of which is in one of two possible states, live or
;;; dead. Every cell interacts with its eight neighbours, which are the cells
;;; that are directly horizontally, vertically, or diagonally adjacent. At each
;;; step in time, the following transitions occur:
;;; 1. Any live cell with fewer than two live neighbours dies, as if by needs
;;; caused by underpopulation.
;;; 2. Any live cell with more than three live neighbours dies, as if by
;;; overcrowding.
;;; 3. Any live cell with two or three live neighbours lives, unchanged, to the
;;; next generation.
;;; 4. Any dead cell with exactly three live neighbours becomes a live cell.
;;; The initial pattern constitutes the 'seed' of the system. The first genera-
;;; tion is created by applying the above rules simultaneously to every cell in
;;; the seed — births and deaths happen simultaneously, and the discrete moment
;;; at which this happens is sometimes called a tick. (In other words, each
;;; generation is a pure function of the one before.) The rules continue to be
;;; applied repeatedly to create further generations.
(require (planet williams/animated-canvas/animated-canvas)
(planet williams/science/random-source)
(planet williams/science/random-distributions/flat)
"matrix-faster.ss")
;;; Randomize the random source.
(random-source-randomize! (current-random-source))
;;; Global Parameters
;;; n-rows : exact-positive-integer? = 100
;;; n-cols : exact-positive-integer? = 100
;;; The world extent is n-rows x n-cols. Change these values to change the size
;;; of the world.
(define-values (n-rows n-cols) (values 100 100))
;;; initial-density : (real-in 0 1) = 0.35
;;; The initial density of the world grid.
(define initial-density 0.35)
;;; cell-size : exact-positive-integer? = 5
;;; The width and height (in pixels) of each grid on the canvas.
(define cell-size 5)
;;; The world - initially empty
;;; world-area : exact-positive-integer? = (* n-rows n-cols)
;;; The area of the world.
(define world-area (* n-rows n-cols))
;;; world-grid : (vectorof boolean?)
;;; The world grid is a vector of Booleans. All of the cells are initially #f.
(define world-grid (make-matrix n-rows n-cols #f))
;;; (get-cell i j) -> boolean?
;;; i : exact-integer?
;;; j : exact-integer?
;;; Returns the (i,j)-th cell. The axis are wrapped using the modulo function.
(define (get-cell i j)
(let ((ii (modulo i n-rows))
(jj (modulo j n-cols)))
(matrix-ref world-grid ii jj)))
;;; (set-cell! i j value) -> void?
;;; i : exact-integer?
;;; j : exact-integer?
;;; Sets the (i,j)-th cell to the specified value. The axes are wrapped using the
;;; modulo function.
(define (set-cell! i j value)
(let ((ii (modulo i n-rows))
(jj (modulo j n-cols)))
(matrix-set! world-grid ii jj value)))
;;; (setup-world density) -> void?
;;; Set up the world. Each cell is initialized to #t or #f to give approximately
;;; the specified density.
(define (setup-world density)
(for ((i (in-range n-rows)))
(for ((j (in-range n-cols)))
(set-cell! i j (<= (random-real) density)))))
;;; n-neighbors : (vectorof exact-non-negative-integer?)
;;; The matrix, which is the same size as the world grid, that contains the count
;;; of the number of (8-) neighbors for the corresponding cells. All of the
;;; counts are initialized to 0.
(define n-neighbors (make-matrix n-rows n-cols 0))
;;; (get-count i j) -> (and exact? (integer-in 0 8))
;;; i : exact-integer?
;;; j : exact-integer?
;;; Returns the count of the (8-) neighbors of the (i,j)-th cell. The axes are
;;; wrapped using the modulo function.
(define (get-count i j)
(let ((ii (modulo i n-rows))
(jj (modulo j n-cols)))
(matrix-ref n-neighbors ii jj)))
;;; (set-count! i j value) -> void?
;;; i : exact-integer?
;;; j : exact-integer?
;;; value : (and exact? (integer-in 0 8))
(define (set-count! i j value)
(let ((ii (modulo i n-rows))
(jj (modulo j n-cols)))
(matrix-set! n-neighbors ii jj value)))
;;; (compute-neighbors) -> void?
;;; Compute the number of (8-) neighbors for each cell in the world grid. The
;;; counts are stored in the n-neighbors matrix.
(define (compute-neighbors)
;; Set counts to zero.
(matrix-fill! n-neighbors 0)
;; Compute the counts.
(for ((i (in-range n-rows)))
(for ((j (in-range n-cols)))
(when (get-cell i j)
;; Update the neighbors counts.
(for ((ii (in-range (- i 1) (+ i 2))))
(for ((jj (in-range (- j 1) (+ j 2))))
(unless (and (= ii i) (= jj j))
;; Update the neighbor at (ii,jj).
(set-count! ii jj (+ (get-count ii jj) 1)))))))))
;;; (update-world) -> void?
;;; Update the cell world according the the rules.
(define (update-world)
;; Compute the number of (8-) neighbors for each cell in the world grid.
(compute-neighbors)
;; Apply the rules to each cell in the world grid.
(for ((i (in-range n-rows)))
(for ((j (in-range n-cols)))
(let ((populated? (get-cell i j))
(count (get-count i j)))
(if populated?
(when (or (< count 2) (> count 3))
(set-cell! i j #f))
(when (= count 3)
(set-cell! i j #t)))))))
;;; cell-brush : (is-a?/c brush%)
;;; = (send the-brush-list find-or-create-brush "blue" 'solid)
;;; The brush to use to draw the cells in the world grid.
(define cell-brush (send the-brush-list find-or-create-brush "blue" 'solid))
;;; cell-bitmap : (is-a?/c bitmap?) = (make-object bitmap% cell-size cell-size)
;;; The bitmap for a cell.
(define cell-bitmap (make-object bitmap% cell-size cell-size))
;;; (setup-cell-bitmap) -> void?
;;; Set up the contents of the cell bitmap.
(define (setup-cell-bitmap)
(let ((dc (make-object bitmap-dc% cell-bitmap)))
(send dc set-brush cell-brush)
(send dc draw-rectangle 0 0 cell-size cell-size)))
;;; (draw-world canvas) -> void?
;;; canvas : (is-a?/c animated-canvas%)
;;; Draw the world grid on the specified animated canvas.
(define (draw-world canvas)
(let ((dc (send canvas get-dc)))
;; Draw each of the cells.
(for ((i (in-range n-rows)))
(for ((j (in-range n-cols)))
(when (get-cell i j)
(let ((x (* j cell-size))
(y (* (- n-rows i 1) cell-size)))
(send dc draw-bitmap cell-bitmap x y)))))
;; Swap the bitmaps.
(send canvas swap-bitmaps)))
;;; Main
;;; running? : boolean? = #t
;;; Set to #f when the frame is closed. This stops the main loop.
(define running? #t)
;;; (main) -> void?
;;; The main routine that continually draws the world grid (from the previous
;;; generation and updates the world grid for the next generation.
(define (main)
;; Set up the cell bitmap.
(setup-cell-bitmap)
;; Set up the world grid.
(setup-world initial-density)
;; Loop forever.
(let loop ()
;; Draw the world grid (from the previous generation).
(draw-world the-canvas)
;; Update the world grid for the next generation
(update-world)
;; Loop as long as the application frame is shown.
(when running? (loop))))
;;; Graphical Elements
;;; life-frame% : class?
;;; superclass: frame%
;;; A new frame class that augments the on-close method to terminate the main
;;; application when the frame is closed.
(define life-frame%
(class frame%
(super-instantiate ("Conway's Game of Life"))
(define/augment (on-close)
(set! running? #f))))
;;; the-frame : (is-a?/c frame%)
(define the-frame
(instantiate life-frame%
()
(style '(no-resize-border))))
;;; the-canvas : (is-a?/c animated-canvas%)
(define the-canvas
(instantiate animated-canvas%
(the-frame)
(min-width (* cell-size n-cols))
(min-height (* cell-size n-rows))
(stretchable-width #f)
(stretchable-height #f)))
;;; Show the application frame and start the application code.
(send the-frame show #t)
(main)