#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)