simple lifegame on terminal

life.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#|
exec ros -Q -- $0 "$@"
|#
(ql:quickload :cl-charms :silent t)
(defpackage :ros.script.life.3667932619
  (:use :cl :charms/ll))
(in-package :ros.script.life.3667932619)

(defun make-board (w h)
  (make-array (list w h)
	      :element-type 'fixnum
	      :initial-element 0))

(defun randomize-board (board)
  (dotimes (i (array-total-size board))
    (setf (row-major-aref board i) (random 2)))
  board)

(defun print-board-no-curses (board)
  (destructuring-bind (w h) (array-dimensions board)
    (dotimes (y h)
      (fresh-line)
      (dotimes (x w)
	(princ (if (plusp (aref board x y)) "o" "_")))
      (terpri))))

(defun print-board-curses (board)
  (destructuring-bind (w h) (array-dimensions board)
    (dotimes (y h)
      (move y 0)
      (dotimes (x w)
	(addch (char-code (if (plusp (aref board x y)) #\o #\.)))))))

(defun step-board (board)
  (destructuring-bind (w h) (array-dimensions board)
    (let ((new-board (make-board w h)))
      (labels ((population-at (board x y)
		 (if (and (< -1 x w)
			  (< -1 y h))
		     (aref board x y)
		     0))
	       (count-neighbor (board x y)
		 (+ (population-at board (1- x) (1- y))
		    (population-at board (1- x) y)
		    (population-at board (1- x) (1+ y))
		    (population-at board x      (1- y))
		    (population-at board x      (1+ y))
		    (population-at board (1+ x) (1- y))
		    (population-at board (1+ x) y)
		    (population-at board (1+ x) (1+ y))))
	       (get-next-state (board x y)
		 (if (or (and (= (population-at board x y) 1)
			      (member (count-neighbor board x y) '(2 3)))
			 (and (= (population-at board x y) 0)
			      (= (count-neighbor board x y) 3)))
		     1 0)))
	(dotimes (y h)
	  (dotimes (x w)
	    (setf (aref new-board x y)
		  (get-next-state board x y))))
	new-board))))

(defun main (&rest argv)
  (declare (ignorable argv))
  (initscr)
  (cbreak)
  (noecho)
  (curs-set 0)
  (keypad *stdscr* TRUE)
  (nodelay *stdscr* TRUE)
  (do ((ch (getch) (getch))
       (board (randomize-board (make-board *cols* *lines*))
	      (step-board board)))
      ((= ch (char-code #\q)))
    (clear)
    (print-board-curses board)
    (refresh)
    (sleep 0.1))
  (endwin))