som.ros

#!/bin/sh
#|-*- mode:lisp -*-|#
#| <Put a one-line description here>
exec ros -Q -- $0 "$@"
|#
(progn ;;init forms
  (ros:ensure-asdf)
  #+quicklisp (ql:quickload '(:lispbuilder-sdl :lispbuilder-sdl-gfx :alexandria) :silent t)
  )

(defpackage :ros.script.som.3724738124
  (:use :cl))
(in-package :ros.script.som.3724738124)

(defparameter *rectx* 50)
(defparameter *recty* 50)

(defparameter *hidden-field* (make-array 128 :adjustable nil))
(defparameter *presentation-field* (make-array '(128 128) :adjustable nil))

(defun torus-x (x)
  (declare (fixnum x))
  (mod (+ x 128) 128))

(defun dist (x y)
  (sqrt
   (loop for xi fixnum across x
         for yi fixnum across y
         sum (* (- xi yi) (- xi yi)))))

(defun avgvec-into-left (x y)
  (loop for i fixnum from 0 below (length x)
        for xi fixnum across x
        for yi fixnum across y
        do (setf (elt x i) (floor (/ (+ xi yi) 2))))
  x)

(defun replace-and-enforce (vec)
  (let ((mindist 255)
        (min-i 0)
        (min-j 0))
    (loop for i from 0 below 128
          do (loop for j from 0 below 128
                   do (when (> mindist (dist vec (aref *presentation-field* i j)))
                        (setf mindist (dist vec (aref *presentation-field* i j)))
                        (setf min-i i)
                        (setf min-j j))))
    (loop for i fixnum from (- min-i 2) to (+ min-i 2)
          do (loop for j fixnum from (- min-j 2) to (+ min-j 2)
                   do (unless (and (eq i min-i) (eq j min-j))
                        (avgvec-into-left (aref *presentation-field*
                                                (torus-x i)
                                                (torus-x j))
                                          vec)
                        )))))

(defun main (&rest argv)
  (declare (ignorable argv))
  (sdl:with-init ()
    (sdl:window 512 512)
    (setf (sdl:frame-rate) 60)
    (loop for i from 0 below 128
          do (setf (aref *hidden-field* i) (vector (random 256) (random 256) (random 256))))
    (loop for i from 0 below 128
          do (loop for j from 0 below 128
                   do (setf (aref *presentation-field* i j)
                            (vector (random 256) (random 256) (random 256)))))
      (format t "~S" *presentation-field*)
    (sdl:with-events ()
      (:quit-event () t)
      (:idle ()
             (sdl-gfx:draw-box (sdl:rectangle :x 0 :y 0 :w 500 :h 500) :color sdl:*black*)
             (dotimes (i 100)
               (replace-and-enforce (alexandria:random-elt *hidden-field*)))
             (loop for i from 0 below 128
                   do (loop for j from 0 below 128
                            do (sdl-gfx:draw-box
                                (sdl:rectangle :x (* 4 i) :y (* 4 j) :w 4 :h 4)
                                :color (sdl:color :r (elt (aref *presentation-field* i j) 0)
                                                  :g (elt (aref *presentation-field* i j) 1)
                                                  :b (elt (aref *presentation-field* i j) 2)
                                                  :a 255))))
             (sdl:update-display)))))
;;; vim: set ft=lisp lisp: