#!/usr/bin/env emacs -script
;; -*- lexical-binding: t -*-
;; run: ./conways-life conways-life.config
(require 'cl-lib)

(defconst blinker '("***"))
(defconst toad '(".***" "***."))
(defconst pentomino-p '(".**" ".**" ".*."))
(defconst pi-heptomino '("***" "*.*" "*.*"))
(defconst glider '(".*." "..*" "***"))
(defconst pre-pulsar '("***...***" "*.*...*.*" "***...***"))
(defconst ship '("**." "*.*" ".**"))
(defconst pentadecathalon '("**********"))
(defconst clock '("..*." "*.*." ".*.*" ".*.."))

(defmacro swap (a b)
  `(setq ,b (prog1 ,a (setq ,a ,b))))

(cl-defstruct world rows cols data)

(defun new-world (rows cols)
  (make-world :rows rows :cols cols :data (make-vector (* rows cols) nil)))

(defmacro world-pt (w r c)
  `(+ (* (mod ,r (world-rows ,w)) (world-cols ,w))
      (mod ,c (world-cols ,w))))

(defmacro world-ref (w r c)
  `(aref (world-data ,w) (world-pt ,w ,r ,c)))

(defun print-world (world)
  (dotimes (r (world-rows world))
    (dotimes (c (world-cols world))
      (princ (format "%c" (if (world-ref world r c) ?* ?.))))
    (terpri)))

(defun insert-pattern (world row col shape)
  (let ((r row)
        (c col))
    (unless (listp shape)
      (setq shape (symbol-value shape)))
    (dolist (row-data shape)
      (dolist (col-data (mapcar 'identity row-data))
        (setf (world-ref world r c) (not (or (eq col-data ?.))))
        (setq c (1+ c)))
      (setq r (1+ r))
      (setq c col))))

(defun neighbors (world row col)
  (let ((n 0))
    (dolist (offset '((1 . 1) (1 . 0) (1 . -1) (0 . 1) (0 . -1) (-1 . 1) (-1 . 0) (-1 . -1)))
      (when (world-ref world (+ row (car offset)) (+ col (cdr offset)))
        (setq n (1+ n))))
    n))

(defun advance-generation (old new)
  (dotimes (r (world-rows old))
    (dotimes (c (world-cols old))
      (let ((n (neighbors old r c)))
        (setf (world-ref new r c)
              (if (world-ref old r c)
                  (or (= n 2) (= n 3))
                (= n 3)))))))

(defun read-config (file-name)
  (with-temp-buffer
    (insert-file-contents-literally file-name)
    (read (current-buffer))))

(defun get-config (key config)
  (let ((val (assoc key config)))
    (if (null val)
        (error (format "missing value for %s" key))
      (cdr val))))

(defun insert-patterns (world patterns)
  (dolist (p patterns)
    (apply 'insert-pattern (cons world p))))

(defun simulate-life (file-name)
  (let* ((config (read-config file-name))
         (rows (get-config 'rows config))
         (cols (get-config 'cols config))
         (generations (get-config 'generations config))
         (a (new-world rows cols))
         (b (new-world rows cols)))
    (insert-patterns a (get-config 'patterns config))
    (dotimes (g generations)
      (princ (format "generation %d\n" g))
      (print-world a)
      (advance-generation a b)
      (swap a b))))

(simulate-life (elt command-line-args-left 0))