#lang scheme/gui

;; ca.ss
;; Lee Spector, lspector@hampshire.edu, 20091203

;;;; Stuff from better-draw.ss

(define width 800)
(define height 800)

(define frame (new frame% (label "Drawing Window")
                   (width width)
                   (height height)))

(define bm (make-object bitmap% width height))

(define canvas
  (new canvas% [parent frame]
       [paint-callback (lambda (canvas dc)
                         (send dc draw-bitmap bm 0 0))]))

(define dc (make-object bitmap-dc% bm))
(send dc clear)
(send dc set-pen (make-object pen% "BLACK" 1 'transparent)) ;; No pen
(send dc set-smoothing 'smoothed)

(define show-window
  (lambda ()
    (send frame show #t)))

(define rectangle
  (lambda (x y width height r g b a)
    (send dc set-brush (make-object brush% (make-object color% r g b) 'opaque))
    (send dc set-alpha a)
    (send dc draw-rectangle x y width height)
    (send canvas refresh)))

(define clear
  (lambda ()
    (rectangle 0 0 width height 255 255 255 1.0)))


;;;; CA-specific stuff

(define rule 30)
(define cells 200)
(define cell-size 4)

;; initially one on, in middle
(define initial-state (build-list cells (lambda (n) (if (= n (/ cells 2)) 1 0)))) 

(define display-state
  (lambda (state time)
    (let ((y (* time cell-size))
          (x 0))
      (for ((cell state))
        (when (= cell 1)
          (rectangle x y cell-size cell-size 0 0 0 1.0))
        (set! x (+ x cell-size))))))

(define binary-expansion
  (lambda (n bits)
    (reverse
     (for/list ((i (in-range 0 bits)))
       (let ((bit (modulo n 2)))
         (set! n (truncate (/ n 2)))
         bit)))))

(define make-rule
  (lambda (n)
    (let ((bin (binary-expansion n 8))
          (patterns (reverse (for/list ((i (in-range 0 8))) (binary-expansion i 3)))))
      (map list patterns bin))))

(define neighborhood
  (lambda (index state)
    (let ((left (- index 1))
          (right (+ index 1)))
      (when (< left 0)
        (set! left (- (length state) 1)))
      (when (= right (length state))
        (set! right 0))
      (list (list-ref state left)
            (list-ref state index)
            (list-ref state right)))))

(define apply-rule
  (lambda (rule state)
    (for/list ((i (in-range 0 (length state))))
      (cadr (assoc (neighborhood i state) rule)))))

;;; show the window and run/display

(show-window)

(let ((state initial-state))
  (for ((i (in-range 0 cells)))
    (display-state state i)
    (set! state (apply-rule (make-rule rule) state))))