;;;; units/container.lisp

(in-package #:wheelwork)


(defclass/std container (unit)
  ((units :with :a)
   (cached-rect :with)
   (left right top bottom :with :std 0 :doc "container's box coordinates."))
  (:documentation "Just a list of units. Made into a class so that
  transformation affine transformations methods can be specialzied on
  whole groups of units"))

(defmethod (setf closer-mop:slot-value-using-class)
    (newval class (container container) slot)
  (case (closer-mop:slot-definition-name slot)
    ((left right top bottom)
     (setf (container-cached-rect container) nil))))

(defmethod get-rect ((container container))
  (with-slots (cached-rect left right top bottom) container
    (or cached-rect
        (setf cached-rect 
              (list (vec:vec left bottom 0 1.0)
                     (vec:vec left top 0 1.0)
                     (vec:vec right top 0 1.0)
                     (vec:vec right bottom 0 1.0)
                     (vec:vec left bottom 0 1.0))))))


(defun point-in-contanier-box-p (c x y)
  "Returns T if the ponit X Y is inside the bounds of the container."
  (and (<= (container-left c) x (container-right c))
       (<= (container-bottom c) y (container-top c))))

(defun visible-in-container-p (unit)
  "Returns T if UNIT is VISIBLEP, if it is inside a CONTAINER, if any
  of the corners of its bounding rectangle are inside that CONTAINER.

  UNIT must implement the affine protocol."
  (when (unit-visiblep unit) 
    (when-let ((container
                (unit-container unit)))
      (loop for pt in (get-rect unit)
            thereis (point-in-contanier-box-p container (vec:vx pt) (vec:vy pt))))))

(defmethod drop-unit ((unit unit))
  "Removes a unit from its container. Returns T if the unit actually was removed."
  (when-let (container (unit-container unit))
    (setf
     (container-units container) (delete unit (container-units container))
     (unit-container unit) nil)
    t))

(defmethod add-unit ((container container) (unit unit))
  "Adds a unit to the end of a container (thus affecting render
order). Also removes the unit from its current container if
necessary."
  (when (unit-container unit)
    (drop-unit unit))
  (push unit  (container-units container))
  (setf (unit-container unit) container)
  unit)

(defmethod cleanup ((container container))
  (dolist (u (container-units container))
    (cleanup u)))

(defmethod render ((container container))
  (let ((current
          (gl:get* :scissor-box))
        (scale
          (application-scale
           (app-of-unit container)))) 
    (with-slots (left right top bottom) container 
      (gl:scissor (* left scale) (* scale bottom) (* scale (- right left)) (* scale (- top bottom)))
      (unwind-protect  
           (dolist (u (container-units container))
             (if (visible-in-container-p u)
               (render u)))
        (gl:scissor (aref current 0) (aref current 1) (aref current 2) (aref current 3))))))