Game of Life

;;;; sdl2_test.lisp

(in-package #:sdl2_test)
(require :sdl2)

(defparameter *size* 50)
(defparameter *frame* '((-1 . -1) (0 . -1) (1 . -1) (-1 . 0) (1 . 0) (-1 . 1) (0 . 1) (1 . 1)))
(defparameter *max-worlds* 2)
(defparameter *current-world* 0)
(defparameter *worlds* nil)
(defparameter *tile-size* 10)

(defparameter *init-fields* '((3 . 3) (3 . 4) (3 . 5) (7 . 1) (8 . 2) (6 . 3) (7 . 3) (8 . 3)))

(defun init ()
  (create-empty-worlds))

(defun create-empty-worlds ()
  (progn
    (setf *worlds* (make-array *max-worlds*))
    (dotimes (n *max-worlds*)
      (setf (aref *worlds* n) (create-empty-world)))))

(defun create-empty-world ()
  (make-array (* *size* *size*) :initial-element nil))

(defun get-next-world-idx ()
  (mod (1+ *current-world*) *max-worlds*))

(defun set-next-world-idx ()
  (setf *current-world* (get-next-world-idx)))

(defun coord2idx (x y)
  (+ (* y *size*) x))

(defun is-in-field (position)
  (let ((x (car position))
    (y (cdr position)))
    (and (>= x 0) (>= y 0) (< x *size*) (< y *size*))))

(defun get-frame (position)
  (let* ((x (car position))
    (y (cdr position))
    (frame (mapcar #'(lambda (delta-coord)
               (let ((dx (car delta-coord))
                 (dy (cdr delta-coord)))
                 (cons (+ x dx) (+ y dy))))
               *frame*)))
    (remove-if-not #'is-in-field frame)))

(defun get-neighbor-idcs (position)
  (mapcar #'(lambda (coord)
          (let ((x-coord (car coord))
            (y-coord (cdr coord)))
        (coord2idx x-coord y-coord)))
      (get-frame position)))

(defun count-neighbors (position world)
  (let ((idcs (get-neighbor-idcs position)))
    (list-length (remove-if-not #'(lambda (idx) (aref world idx)) idcs))))

(defun count-current-neighbors (position)
  (count-neighbors position (aref *worlds* *current-world*)))

(defun get-self (position)
  (aref (aref *worlds* *current-world*) (coord2idx (car position) (cdr position))))

(defun set-field (worlds-idx idx)
  (setf (aref (aref *worlds* worlds-idx) idx) t))

(defun set-on-current (position)
  (set-field *current-world* (coord2idx (car position) (cdr position))))

(defun clear-field (worlds-idx idx)
  (setf (aref (aref *worlds* worlds-idx) idx) nil))

(defun set-value-on-field (worlds-idx idx value)
  (setf (aref (aref *worlds* worlds-idx) idx) value))

(defun give-birth (num-neighbors)
  (equal num-neighbors 3))

(defun die (num-neighbors)
  (or (< num-neighbors 2) (> num-neighbors 3)))

(defun should-live (position)
  (let ((neighbors (count-current-neighbors position))
    (lives (get-self position)))
    (or (give-birth neighbors) (and (not (die neighbors)) lives))))

(defun initialize-current-world-values ()
  (mapcar #'set-on-current *init-fields*))

(defun world-step ()
  (progn
    (dotimes (x *size*)
      (dotimes (y *size*)
    (let* ((position (cons x y))
           (idx (coord2idx x y))
           (next-world (get-next-world-idx))
           (value (should-live position)))
      (set-value-on-field next-world idx value))))
    (set-next-world-idx)))

(defun render-current-world (surface)
  (dotimes (x *size*)
    (dotimes (y *size*)
      (let* ((value (get-self (cons x y)))
         (color (if value
            (sdl2:map-rgb (sdl2:surface-format surface) #xaa #x00 #xcc)
            (sdl2:map-rgb (sdl2:surface-format surface) #x00 #x00 #xbb))))
    (progn

      (sdl2:fill-rect surface (sdl2:make-rect (* x *tile-size*) (* y *tile-size*) *tile-size* *tile-size*) color))))))

(defun main ()
  (sdl2:with-init (:everything)
    (sdl2:with-window (win :title "Game of Life" :flags '(:shown))
      (let ((surf (sdl2:get-window-surface win)))
    (progn
      (init)
      (initialize-current-world-values)
      (sdl2:with-event-loop (:method :poll)
        (:quit () t)
        (:idle ()
           (sdl2:fill-rect surf nil (sdl2:map-rgb (sdl2:surface-format surf) #xff #xff #xff))
           (render-current-world surf)
           (world-step)
           (sdl2:update-window win)
           (sdl2:delay 200))))))))