(in-package :clim-user)

(define-application-frame mystify () ()
  (:panes
   (main (make-pane 'mystify-pane)))
  (:layouts
   (default main)))

(defclass mystify-pane (basic-pane)
  ((figures :initarg :figures :initform nil :accessor mystify-pane-figures)
   (width :initarg :width :initform 800 :accessor mystify-pane-width)
   (height :initarg :height :initform 600 :accessor mystify-pane-height))
  (:default-initargs
   :background +black+
    :foreground +white+))

(defstruct vertex
  x y vx vy)

(defstruct figure
  queue
  ink)

(defun make-random-vertex (max-x max-y vel)
  (let ((dir (random (* 2 pi))))
    (make-vertex :x (random max-x)
                 :y (random max-y)
                 :vx (* vel (cos dir))
                 :vy (* vel (sin dir)))))

(defun advance-vertex (v w h)
  (setq v (copy-vertex v))
  (incf (vertex-x v) (vertex-vx v))
  (incf (vertex-y v) (vertex-vy v))
  (unless (<= 0 (vertex-x v) w)
    (setf (vertex-vx v) (- (vertex-vx v))))
  (unless (<= 0 (vertex-y v) h)
    (setf (vertex-vy v) (- (vertex-vy v))))
  v)

(defun advance-figure (q w h)
  (setf (figure-queue q)
        (cons (mapcar #'(lambda (v)
                          (advance-vertex v w h))
                      (car (figure-queue q)))
              (subseq (figure-queue q) 0 (min 30 (length (figure-queue q))))))
  q)

(defmethod handle-repaint ((pane mystify-pane) region)
  (declare (ignore region))
  (with-slots (figures) pane
    (unless figures
      (setq figures
            (loop for ink in (list +orange+ +cyan+)
                  collect
                  (make-figure
                   :ink ink
                   :queue (list(loop repeat 4 collect (make-random-vertex 800 600 10)))))))
    (loop for q in figures
          do (with-drawing-options (pane :foreground (figure-ink q))
               (loop for vs in (figure-queue q)
                     for i from 0
                     do (draw-polygon* pane
                                       (loop for v in vs collect (vertex-x v) collect (vertex-y v))
                                       :filled nil :closed t
                                       :ink (make-opacity (- 1 (* 1/30 i)))))))
    (setq figures
          (mapcar (lambda (q) (advance-figure q *W* *h*)) figures))
    (queue-repaint pane +everywhere+)))

(defmethod compose-space ((pane mystify-pane) &key)
  (with-slots (width height) pane
    (make-space-requirement
     :min-width width :width width :max-width width
     :min-height height :height height :max-height height)))