一次元セルオートマトンギャラリー

(ql:quickload :lispbuilder-sdl)
(ql:quickload :lispbuilder-sdl-gfx)

(defclass <world> ()
    ((cells :initform () :initarg :cells :accessor cells)
     (rules :initform () :initarg :rules :accessor rules)))

(defun make-world (len)
  (make-instance '<world>
		 :cells (let ((lst (make-list len :initial-element 0)))
			  (setf (nth (/ len 2) lst) 1)  lst)))

(defun neighbors (list idx)
  (cond ((zerop idx)
         `(0 ,(nth idx list) ,(nth 1 list)))
        ((= (1- (length list)) idx)
         `(,(nth (1- idx) list) ,(nth idx list) 0))
        (t
         `(,(nth (mod (1- idx) (length list)) list)
            ,(nth idx list)
            ,(nth (mod (1+ idx) (length list)) list)))))

(defun dispatch-rule (list rules)
  (let ((matched-rule 
          (find list rules :test 'equal :key #'car)))
    (if matched-rule
      (cdr matched-rule)
      0)))

(defmethod update-world ((world <world>))
  (setf (cells world)
        (loop
          for idx from 0 upto (length (cells world))
          collect (dispatch-rule 
                    (neighbors (cells world) idx) 
                    (rules world))))
  world)

(defmethod show-world-cui ((world <world>))
  (format t "~A~%" (cells world)))

(defun fill-list (len list stuff)
  (if (< (length list) len)
    (append (make-list (- len (length list))
                       :initial-element stuff)
            list)
    list))

(defun dec-to-bin-list (num)
  (labels ((%dec-to-bin-list (num acc)
             (if (zerop num)
               acc
               (%dec-to-bin-list 
                 (truncate num 2)
                 (cons (mod num 2) acc)))))
    (if (zerop num) '(0) 
      (%dec-to-bin-list num ()))))

(defun make-random-rule ()
  (loop for x from 0 upto 7
        for pat = (fill-list 3 (dec-to-bin-list x) 0)
        for rule = (random 2)
        collect (cons pat rule)))

(defun make-random-world (len)
  (let ((world (make-world len)))
    (setf (rules world) (make-random-rule))
    world))

(defun create-rule (rule-list)
  (loop for x from 0 upto 7
        for pat = (fill-list 3 (dec-to-bin-list x) 0)
        for rule in rule-list
        collect (cons pat rule)))

(defparameter *cell-size* 20)
(defparameter *max-gen* 30)

(defmacro each-with-idx (list fn)
  (let ((idx (gensym)))
    `(loop for ,idx from 0 upto (1- (length ,list))
           collect (funcall ,fn (nth ,idx ,list) ,idx))))

(defmethod clone-world ((world <world>))
  (make-instance '<world>
                 :cells (cells world)
                 :rules (rules world)))

(defun life-saver (len)
  (let ((world (make-random-world len))
        (alpha 255)
        (width (* len *cell-size*))
        (height (* *cell-size* *max-gen*))
        (state :display))
    (sdl:with-init ()
      (sdl:window width height :title-caption "Life Saver")
      (sdl:clear-display sdl:*blue*)
      (sdl:with-events ()
        (:quit-event () t)
        (:idle
          (cond ((eql state :display)
                 (progn
                   (sdl:clear-display sdl:*blue*)
                   (loop for gen from 0 upto *max-gen*
                         do
                         (progn
                           (show-world-cui world)
                           (each-with-idx (cells world)
                                          (lambda (cell idx) (when (not (zerop cell))
                                                               (sdl-gfx:draw-box-*
                                                                 (* *cell-size* idx)
                                                                 (* *cell-size* gen)
                                                                 *cell-size* *cell-size* 
                                                                 :color (sdl:color :r alpha :g 255 :b 255 :a alpha)))))
                           (update-world world)))
                   (setf state :changing)))
                ((eql state :changing)
                   (if (zerop alpha)
                     (setf world (make-random-world len) state :display alpha 255)
                     (decf alpha 5))))
            (sdl:update-display))))))

ランダムなパターンを生成して表示し、一定時間がたったらまた別のパターンを生成し表示してといやっておいます。
alphaのあたりはとりあえず無視しておいてください。フェードアウトさせようとおもっていた頃の名残りでので。