;;;; life.scm


(use rfb srfi-25)

(use matchable miscmacros)


(define-values (width height cellsize)
  (let-optionals (command-line-arguments)
      ((w "100")
       (h "100")
       (cellsize "3"))
    (values (string->number w)
	    (string->number h)
	    (string->number cellsize))))

(define world (make-array (shape 0 width 0 height) #f))
(define next-world (make-array (shape 0 width 0 height) #f))
(define added '())
(define removed '())

(define (add-cell x y)
  (array-set! world x y #t)
  (array-set! next-world x y #t)
  (push! (cons x y) added))

; R-pentomino
(let ((x (quotient width 2))
      (y (quotient height 2)))
  (add-cell x y) ;  **
  (add-cell (add1 x) y) ; **
  (add-cell (sub1 x) (add1 y)) ;  *
  (add-cell x (add1 y)) 
  (add-cell x (+ y 2)))

(define (tick)
  (let ((live 0))
    (do ((x 0 (fx+ x 1)))
	((fx>= x width))
      (do ((y 0 (fx+ y 1)))
	  ((fx>= y height))
	(let ((now (array-ref world x y))
	      (n 0))
	  (when now (inc! live))
	  (do ((i -1 (fx+ i 1)))
	      ((fx>= i 2))
	    (do ((j -1 (fx+ j 1)))
		((fx>= j 2))
	      (when (and (or (not (zero? i)) (not (zero? j)))
			 (array-ref world (modulo (fx+ x i) width) (modulo (fx+ y j) height)))
		(set! n (fx+ n 1)))))
	  (cond (now
		 (when (or (fx< n 2) (fx> n 3))
		   (array-set! next-world x y #f)
		   (push! (cons x y) removed)))
		((eq? n 3)
		 (array-set! next-world x y #t)
		 (push! (cons x y) added))))))
    (exchange! world next-world)
    (for-each
     (match-lambda
       ((x . y) (array-set! next-world x y #t)))
     added)
    (for-each
     (match-lambda
       ((x . y) (array-set! next-world x y #f)))
     removed)
    live))

(define cell (make-u32vector (* cellsize cellsize) #xffffff))
(define empty (make-u32vector (* cellsize cellsize) 0))

(define (test)
  (let ((rs ((rfb-server) (* cellsize width) (* cellsize height))))
    (let loop ()
      (let ((m (read-client-message rs)))
	;(pp m)
	(match m
	  (('FramebufferUpdateRequest #f x y w h)
	   (framebuffer-update-rectangle
	    rs
	    (rectangle 0 0 (* width cellsize) (* height cellsize) (make-u32vector (* w h) 0))))
	  (('FramebufferUpdateRequest #t x y w h)
	   (tick)
	   (framebuffer-update-rectangles
	    rs
	    (map (match-lambda 
		   ((x . y)
		    (rectangle (fx* x cellsize) (fx* y cellsize) cellsize cellsize cell)))
		 added))
	   (framebuffer-update-rectangles
	    rs
	    (map (match-lambda 
		   ((x . y)
		    (rectangle (fx* x cellsize) (fx* y cellsize) cellsize cellsize empty)))
		 removed))
	   (set! added '())
	   (set! removed '()))
	  ((? eof-object?) (exit))
	  (('KeyEvent . _) (exit))
	  (_ #f))
	(loop)))))

(test)