#lang racket (require graphics/graphics) (require racket/bool) (define screen-width 600) (define screen-height screen-width) (define board-width 15) (define board-height 15) (define cell-vertical-size (/ screen-width board-width)) (define cell-horizontal-size (/ screen-height board-height)) (define line-color (make-rgb 0.8 0.8 0.8)) (define cell-color (make-rgb 0.95 0.95 0)) (define starting-board (set '(1 0) '(2 1) '(0 2) '(1 2) '(2 2))) (open-graphics) (define w (open-viewport "Game of Life" screen-width screen-height)) (define (draw-vertical-lines coord step) (cond [(< coord screen-width) (begin ((draw-line w) (make-posn coord 0) (make-posn coord screen-height) line-color) (draw-vertical-lines (+ coord step) step))])) (define (draw-horizontal-lines coord step) (cond [(< coord screen-width) (begin ((draw-line w) (make-posn 0 coord) (make-posn screen-height coord) line-color) (draw-horizontal-lines (+ coord step) step))])) (define (draw-lines width height) (draw-vertical-lines cell-vertical-size cell-vertical-size) (draw-horizontal-lines cell-horizontal-size cell-horizontal-size)) (define (draw-cell cell) ((draw-solid-ellipse w) (make-posn (* cell-horizontal-size (car cell)) (* cell-horizontal-size (car (cdr cell)))) cell-vertical-size cell-horizontal-size cell-color)) (define (draw-board board) (for ([cell board]) (draw-cell cell))) (define (count-alive-neighbors orig-cell board) (let* ([orig-x (car orig-cell)] [orig-y (car (cdr orig-cell))]) (define (iterate y sum) (define (iterate-row x row-sum) (let ([cell (list x y)]) (if (<= x (+ orig-x 1)) (iterate-row (+ x 1) (if (set-member? board cell) (+ row-sum 1) row-sum)) row-sum))) (if (<= y (+ orig-y 1)) (iterate (+ y 1) (+ sum (iterate-row (- orig-x 1) 0))) sum)) (let ([neighbors (iterate (- orig-y 1) 0)]) (if (set-member? board orig-cell) (- neighbors 1) neighbors)))) (define (will-be-alive cell board) (let* ([alive-neighbors (count-alive-neighbors cell board)] [is-alive (set-member? board cell)]) (or (and is-alive (or (eq? alive-neighbors 2) (eq? alive-neighbors 3))) (and (not is-alive) (eq? alive-neighbors 3))))) (define (next-generation current-board) (define new-board (mutable-set)) (define (iterate y) (define (iterate-row x) (let ([cell (list x y)]) (cond [(will-be-alive cell current-board) (set-add! new-board cell)]) (cond [(< x board-width) (iterate-row (+ x 1))]))) (iterate-row 0) (cond [(< y board-height) (iterate (+ y 1))])) (iterate 0) new-board) (define (play board) ((clear-viewport w)) (draw-lines board-width board-height) (draw-board board) (sleep 0.5) (play (next-generation board))) (play starting-board) (close-graphics)