;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Conways game of life.
;;
;; Drag mouse around canvas
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define row-length 32) ; number of squares to animate
(define nodes (* row-length row-length))
(define size 20) ; square size
; set up graphics including vectors for paths, points, colours, styes etc.
(define canvas (gfx:make-canvas (* size row-length) (* size row-length)))
(gfx:clear-canvas (now) canvas '(0 0 0 1)) ; black background
; setup paths at random coordinates between 100,100 and 200,200
(define paths (make-vector-with-proc nodes
(lambda (i)
(gfx:make-square (* size (fmod i row-length))
(* size (real->integer (/ i row-length)))
size))))
;; styles
(define styles (make-vector nodes *gfx:fill-path*))
;; strokes to 0
(define strokes (make-vector nodes 0))
;; widths to 0
(define widths (make-vector nodes 1))
; setup paths at random coordinates between 100,100 and 200,200
(define fills (make-vector-with-proc (* 4 nodes)
(lambda (i)
0)))
; set all alpha values to 1.0
(math:vector= fills 1.0 (list 3 (- nodes 1) 4))
(define results (make-vector-with-proc (* nodes 4) (lambda (i) 0)))
(define indexes (list->vector (map (lambda (i)
(* i 4))
(list (- nodes (+ row-length 1)) (- nodes row-length) (- nodes (- row-length 1))
(- nodes 1) 1
(- row-length 1) row-length (+ row-length 1)))))
(io:register-mouse-events canvas)
(define io:mouse-down
(lambda (x y)
(let loop ((i (- nodes 1)))
(if (gfx:point-in-path? (vector-ref paths i) x y)
(begin (vector-set! fills (* i 4)
(if (= 1 (vector-ref fills (* i 4))) 0.0 1.0))
(gfx:draw-group (now) canvas paths strokes fills widths styles)))
(if (> i 0) (loop (- i 1))))))
(define io:mouse-drag
(lambda (x y)
(let loop ((i (- nodes 1)))
(if (gfx:point-in-path? (vector-ref paths i) x y)
(begin (vector-set! fills (* i 4) 1)
(gfx:draw-group (now) canvas paths strokes fills widths styles)))
(if (> i 0) (loop (- i 1))))))
(define generation
(lambda ()
(math:vector-sum-and-rotate-i fills indexes results)
(let loop ((i (- nodes 1)))
(case (vector-ref results (* i 4))
((3) (vector-set! fills (* i 4) 1))
((2) 'do-nothing)
(else (vector-set! fills (* i 4) 0)))
(if (> i 0) (loop (- i 1))))))
;; clear the current matrix
(define clear-matrix
(lambda ()
(math:vector= fills 0)
(math:vector= fills 1 (list 3 (- nodes 1) 4))
(gfx:draw-group (now) canvas paths strokes fills widths styles)))
(define animate2
(lambda (time)
(generation)
(gfx:draw-group time canvas paths strokes fills widths styles)
(callback (+ time 1000) 'animate2 (+ time 2000))))
(clear-matrix)
(animate2 (now))