#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)) ;;; 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-vector world-area #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 ((cell (+ (* (modulo i n-rows) n-cols) (modulo j n-cols)))) (vector-ref world-grid cell))) ;;; (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 ((cell (+ (* (modulo i n-rows) n-cols) (modulo j n-cols)))) (vector-set! world-grid cell 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-vector world-area 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 ((cell (+ (* (modulo i n-rows) n-cols) (modulo j n-cols)))) (vector-ref n-neighbors cell))) ;;; (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 ((cell (+ (* (modulo i n-rows) n-cols) (modulo j n-cols)))) (vector-set! n-neighbors cell 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. (for ((i (in-range world-area))) (vector-set! n-neighbors i 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)