Skip to content

Instantly share code, notes, and snippets.

@amasad
Last active December 29, 2015 21:18
Show Gist options
  • Save amasad/7729001 to your computer and use it in GitHub Desktop.
Save amasad/7729001 to your computer and use it in GitHub Desktop.
Conway's Game of Life
#lang racket
(require 2htdp/image
2htdp/universe)
; Cell object.
(define make-cell
(lambda (x y)
(list (list x y) #f)))
(define is-alive cadr)
(define is-dead (lambda (cell) (not (is-alive cell))))
(define get-cord car)
(define live
(lambda (c)
(list (get-cord c) #t)))
(define die
(lambda (c)
(list (get-cord c) #f)))
; Board.
(define make-board
(lambda (rows cols)
(letrec ([make-row
(lambda (row r c)
(if (< c 0)
row
(make-row (cons
(let ((cell (make-cell r c)))
(if (> (random) 0.5)
(live cell)
cell))
row)
r
(- c 1))))]
[make-rows
(lambda (board r)
(if (< r 0)
board
(make-rows (cons
(make-row '() r (- cols 1))
board)
(- r 1))))])
(make-rows '() (- rows 1)))))
(define rows length)
(define cols
(lambda (board)
(length (car board))))
(define get-cell
(lambda (board cord)
; Handle bounds.
(if (or (< (car cord) 0)
(< (cadr cord) 0)
(>= (car cord) (rows board))
(>= (cadr cord) (cols board)))
'()
(list-ref (list-ref board (car cord))
(cadr cord)))))
(define iter-neighbors
(lambda (board cell cb)
(letrec ([row (car (get-cord cell))]
[col (cadr (get-cord cell))]
[iter
(lambda (r c)
(cond
[(= r (+ row 2)) '()]
[(= c (+ col 2)) (iter (+ 1 r) (- col 1))]
[(and (= r row) (= c col)) (iter r (+ 1 c))]
(else
(let ([neighbor (get-cell board (list r c))])
(if (not (null? neighbor)) (cb neighbor) #f))
(iter r (+ 1 c)))))])
(iter (- row 1) (- col 1)))))
(define map-board
(lambda (board cb)
(map (lambda (row)
(map cb row))
board)))
(define num-alive-neighbors
(lambda (board cell)
(define num-alive 0)
(iter-neighbors
board
cell
(lambda (cell)
(if (is-alive cell) (set! num-alive (+ 1 num-alive)) #f)))
num-alive))
(define update-board
(lambda (board)
(map-board board
(lambda (cell)
(cond [(is-alive cell)
(cond
[(< (num-alive-neighbors board cell) 2) (die cell)]
[(< (num-alive-neighbors board cell) 4) (live cell)]
(else (die cell)))]
[(and (is-dead cell) (= (num-alive-neighbors board cell) 3))
(live cell)]
(else (die cell)))))))
(define SCALE 5)
(define make-image
(lambda (board)
(let ([img (rectangle (* (rows board) SCALE) (* (cols board) SCALE) "solid" "white")])
(map-board board
(lambda (cell)
(if (is-alive cell)
(set! img
(underlay/xy
img
(* (car (get-cord cell)) (+ SCALE 1))
(* (cadr (get-cord cell)) (+ SCALE 1))
(square (- SCALE 2) "solid" "black")))
#f)))
img)))
(define game-of-life
(lambda (board refresh-rate)
(animate (lambda (n)
(cond [(= (modulo n refresh-rate) 0)
(set! board (update-board board))
(make-image board)]
(else
(make-image board)))))))
(define cross
(lambda (col row)
(map-board (make-board col row)
(lambda (cell)
(if (or
(= (car (get-cord cell))
(cadr (get-cord cell)))
(= (- (- col 1) (car (get-cord cell)))
(cadr (get-cord cell))))
(live cell)
(die cell))))))
; This is faster than big-bang.
;(game-of-life (cross 100s 100) 2)
(big-bang (cross 100 100)
(on-tick update-board 0.25)
(to-draw make-image)
(record? #t))
@amasad
Copy link
Author

amasad commented Dec 1, 2013

demo

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment