To be or not to be... a game of life in Chicken Scheme

In order to further develop my doodle egg for chicken scheme I have toyed with the possibilities of user interaction in doodle as well as minimal UI element creations. So in this article I will show you a graphical game of life written for doodle.

So to be able to "play" the game we will first need an array of cells and the accessor procedures for it. In this design I settled on using a vector holding cons cells with the current and the future content of a cell:

(use doodle loop matchable clojurian-syntax miscmacros (srfi 1) vector-lib)

; world size in number of cells
(define-constant +rows+ 50)
(define-constant +cols+ 50)

; our world is a flat vextor of pairs (current . next) generations
(define *world* (make-vector (* +rows+ +cols+) '(0 . 0)))

; these accessor bindings will get swapped after each iteration
(define current car)
(define next cdr)
; convenience procedure to reset our accessors
(define (reset-accessors!)
  (set! current car)
  (set! next cdr))

; Map (x y) coordinates to an index in our vector
(define (cell-ref x y)
  (let ((idx (+ x (* y +cols+))))
    (when (> idx (* +rows+ +cols+))
      (error "Cell coordinates out of bounds " x y))
    (vector-ref *world* idx)))

As you can see we will need quite some extensions this time. I have used the loop form for iterating over the cells as well as extensions to scheme's vectors such as the vector-map procedure.

Update: The clojurian-syntax module is part of the clojurian egg and we do need it for the doto macro. This macro has been moved from miscmacros to clojurian-syntax. Thanks Peter for the hint.

So for now we know how big our *world* is and how we can access individual cells. A dead cell's contents will be 0, alive cells will have a 1 in their content slot.

The rules are enforced as such:

; This list is the offset of neighbour cells to consider
; +-+-+-+  for cell x. The offsets in this list are
; | | | |  calculated from x's coordinates, starting
; +-+-+-+  from the upper left corner going down.
; | |x| |
; +-+-+-+  A cell is alive if it has a 1 in it, 0 when
; | | | |  dead.
; +-+-+-+
(define neighbours
  '((-1 . -1)
    (0 . -1)
    (1 . -1)
    (-1 . 0)
    (1 . 0)
    (-1 . 1)
    (0 . 1)
    (1 . 1)))

; returns the number of neighbouring alive cells
(define (neighbour-count x y)
  (fold + 0 (map (lambda (n)
                   (current (cell-ref (modulo (+ x (car n)) +cols+)
                                      (modulo (+ y (cdr n)) +rows+))))
                 neighbours)))

; A cell is alive if stored 1 at its location
(define (alive? x y)
  (= 1 (current (cell-ref x y))))

; This implements the rules according to
; https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life
(define (eval-rule x y)
  (let ((n (neighbour-count x y))
        (alive (alive? x y)))
    (cond
     ((and alive (< n 2)) 0) ; under-population rule #1
     ((and alive (< n 4)) 1) ; enough neighbours rule #2
     ((and alive (> n 3)) 0) ; overcrowded rule #3
     ((and (not alive) (= 3 n)) 1) ; reproduction rule #4
     (else (if alive 1 0)))))

So to evaluate one round we iterate over all cells, store the result of eval-rule into the next part of a cell's pair and after that swap the accessors:

; Does one iteration and mutates the world
(define (iterate! world)
  (loop for y from 0 below +rows+
        do (loop for x from 0 below +cols+
                 do (vector-set! world (+ x (* +rows+ y))
                                 (if (eq? current car)
                                     (cons (current (cell-ref x y)) (eval-rule x y))
                                     (cons (eval-rule x y) (current (cell-ref x y)))))))
  (exchange! current next)
  'ok)

So far so well, now we can start the interesting part of our little adventure, drawing stuff. In the beginning there was a doodle:

; window dimensions
(define w 680)
(define h 420)

; size of one cell in pixels
(define +box-size+ 8)

; drawing offsets to place the world on the screen
(define-constant +x-grid-offset+ 100)
(define-constant +y-grid-offset+ 10)

(new-doodle width: w height: h background: solid-white)

; Draw a cell and take our grid offset into account
(define (draw-cell x y is-alive)
  (let* ((x1 (+ +x-grid-offset+ (* x +box-size+)))
         (y1 (+ +y-grid-offset+ (* y +box-size+))))
    (if is-alive
        (filled-rectangle x1 y1 +box-size+ +box-size+ solid-black)
        (rectangle x1 y1 +box-size+ +box-size+ solid-black))))

(define (graph-generation world)
  (loop for y from 0 below +rows+
        do (loop for x from 0 below +cols+
                 do (draw-cell x y (alive? x y))))
  'ok)

(define (fill-world world num-of-points)
  (reset-accessors!)
  (repeat num-of-points
          (vector-set! world (random (vector-length world)) '(1 . 0)))
  'ok)

Ok this will show us an empty grid, and we will be able to draw the world. fill-world should give us a randomly generated new population of cells. As I wanted to also add some statistics, we will add a legend explaining the drawing:

(define (living-cells world)
  (vector-fold (lambda (i s x) (+ s (current x))) 0 world))

(define (draw-legend world generation)
  (text 550 25 (list
                (sprintf "Generation #~a" generation)
                (sprintf "Living cells: ~a"
                         (living-cells world)))))

So now on to the UI. I wanted the user to be able to Play, pause the iterations, create a new world, clear the world to restart empty, to quit the application and to draw living cells with the mouse.

First some buttons:

(define *buttons* '())
(define-record button label x y width height action)

(define (new-button! label x y width height action)
  (push! (make-button label x y width height action) *buttons*))

(define (draw-buttons!)
  (for-each (lambda (b)
              (rectangle (button-x b)
                         (button-y b)
                         (button-width b)
                         (button-height b)
                         solid-black)
              (text (+ (button-x b) (/ (button-width b) 2))
                    (+ (button-y b) 5 (/ (button-height b) 2))
                    (button-label b) align: #:center))
            *buttons*)
  (show!))

(define (which-buttons x y)
  (filter (lambda (b)
            (and
             (<= (button-x b) x
                 (+ (button-x b)
                    (button-width b)))
             (<= (button-y b) y
                 (+ (button-y b)
                    (button-height b)))
             (button-label b)))
          *buttons*))

(define (handle-buttons btns)
  (for-each (lambda (b)
              ((button-action b)))
            btns))

I have defined buttons to be simple rectangles with their label printed centered on them. The action procedure will get called when a button is pressed. The decision when that happens will be part of our event loop below. Note that this is rather naive as I don't take care whether the label fits the button size, but I wanted it to be as simple as possible to get a feeling for how to make doodle's event format for these kind of things.

(define *running* #f)

(new-button! "Play" 550 50 60 30 (lambda () (set! *running* #t)))
(new-button! "Pause" 550 100 60 30 (lambda () (set! *running* #f)))
(new-button! "New" 550 150 60 30 (lambda () (new-world 200)))
(new-button! "Clear" 550 200 60 30 (lambda () (new-world)))
(new-button! "Quit" 550 250 60 30 (lambda () (exit 0)))

There we go, our buttons with a procedure telling it what to do. *running* tells the event loop to iterate over our cells and let them live or die.

To be able to draw living cells into our world we need a little helper function that maps the mouse coordinates to cells.

(define *painting* #f)
(define *dirty* #f)

; map a coordinate to a world cell
(define (tick-cell x y)
  (when (and (< +x-grid-offset+ x (+ +x-grid-offset+ (* +box-size+ +rows+)))
           (< +y-grid-offset+ y (+ +y-grid-offset+ (* +box-size+ +cols+))))
      (let ((cx (inexact->exact (floor (/ (- x +x-grid-offset+) +box-size+))))
            (cy (inexact->exact (floor (/ (- y +y-grid-offset+) +box-size+)))))
        (set! *painting* #t)
        (vector-set!
         *world*
         (+ cx (* cy +cols+))
         (if (equal? current car)
             (cons 1 0)
             (cons 0 1)))
        (set! *dirty* #t))))

And now we start out with a world of 200 randomly distributed cells and when we start the iteration, we can watch our cells move.

(world-inits (lambda () (new-world 200)))

; React to events and drive the loop
(world-changes
 (lambda (events dt escape)
   (for-each
    (lambda (e)
      (match
       e
       (('mouse 'pressed x y 1)
        (handle-buttons (which-buttons x y))
        (set! *painting* #t)
        (tick-cell x y))
       (('mouse 'released x y 1)
        (set! *painting* #f))
       (('mouse 'moved x y)
        (when *painting* (tick-cell x y)))
       (('key 'pressed key) (handle-key key))
       (else (void))))
    events)
   (when *dirty*
     (graph-generation *world*)
     (set! *dirty* #f))
   (when *running* (run))))

(run-event-loop)

The matchable egg has been a real treat to keep this part of the code really short and readable. As you can see doodle will hand us several types of events for the mouse: pressed, released and moved. And we react on all of them. The globals *dirty* and *painting* are used to keep track of our state. I have omitted a small mapping procedure for handling key strokes that accomplish the same things as pressing the buttons.

The initial setup looks then a bit like this:

You can view the whole source code in all its glory at the bitbucket repository:

git clone https://bitbucket.org/ckeen/game-of-life.git

I hope you have enjoyed the little tour!