;;;; objects.lisp
(in-package :break)

(defgeneric update (entity))
(defgeneric kill (entity))
(defgeneric bounding-box (entity))
(defgeneric overlap-p (entity1 entity2))

;;; Base class for everything that needs to be drawn.
(defclass entity ()
  ((e-stream :initform nil :initarg :e-stream :accessor e-stream)
   (position :initform (v! 0 0 0) :initarg :pos :accessor pos)
   (scale :initform (v! 1 1 1) :initarg :scale :accessor scale)
   (size :initform (v! 1 1) :initarg :size :accessor size)))

(defun make-entity (x y color position)
  (make-instance 'entity
		 :e-stream (make-square-e-stream x y color)
		 :pos position))

(defmethod update ((entity entity))
  (setf (pos entity)
	(make-array
	 3
	 :element-type 'single-float
	 :initial-contents (map 'vector (lambda (scalar) (- (/ scalar 2)))
				(concatenate 'vector
					     (viewport-internal-size (current-viewport))
					     '(-0.0))))))

(defmethod  kill ((entity entity))
  (map nil (lambda (arr) (if (consp arr)
			     (free (car arr))
			     (free arr)))
       (buffer-stream-gpu-arrays (e-stream entity)))
  (free-buffer-stream (e-stream entity)))

(defun draw-entity (entity projection-matrix)
  (let ((to-world (m4:* (m4:translation (pos entity))
			(m4:scale (scale entity))))
	(to-view projection-matrix
	  ;;(rtg-math.projection:orthographic 320.0 240.0 1.0 100.0)
	  ))
    (map-g #'render (e-stream entity) :to-view to-view :to-world to-world)))

;;; Background images
(defclass bg-image (entity)
  ((alignment :initform :center :initarg :alignment :accessor alignment)
   (index :initform 1 :initarg :index :accessor index)))

(defun make-bg-image (alignment index color)
  (make-instance 'bg-image
		 :alignment alignment
		 :index index
		 :e-stream (make-square-e-stream 320.0 240.0 color)
		 :pos (v! 0 0 0)))

(defmethod update ((bg-image bg-image))
  (let ((internal-size (viewport-internal-size (current-viewport))))
    (setf (pos bg-image)
	  (case (alignment bg-image)
	    (:center (v! (rtg-math.vector2:*s (rtg-math.vector2:/s *internal-size* 2.0) -1.0)
			 (index bg-image)))
	    (:topright (v!
		       (rtg-math.vector2:-
			(rtg-math.vector2:/s internal-size 2.0)
			*internal-size*)	      
		       (index bg-image)))
	    (:bottomleft (v!
			  (rtg-math.vector2:-
			   (rtg-math.vector2:/s internal-size 2.0)
			   internal-size)
			  (index bg-image)))
	    ))))

;;; paddle
(defclass pad (entity)
  ((size :initform (v! 100 5) :initarg :size :accessor size)))

(defun make-pad ()
  (make-instance 'pad
		 :e-stream (make-square-e-stream 100.0 5.0 (v! 0 0 1 1))
		 :pos (v! 0 -100 0)
		 :size (v! 100.0 5.0)))

(defmethod (setf size) (new-size (pad pad))
  (setf (slot-value pad 'size) new-size)
  (setf (slot-value pad 'scale) (v! (v2:/ (size pad) (v! 100 5)))))

(defmethod update ((pad pad))
  (setf (aref (pos pad) 0) ; position should be in pixels, not SDL2 coords
	(- (aref (mouse-pos (mouse)) 0) (/ 320 2))))

;;; balls
(defclass ball (entity) 
  ((direction :initform (v! 1 1 0) :initarg :direction :accessor dir)
   (speed     :initform 1.0        :initarg :speed :accessor spd)
   (radius    :initform 2.5        :initarg :rad :accessor rad)))

(defun make-ball (pos dir)
  (make-instance 'ball
		 :e-stream (make-square-e-stream 5 5 (v! 1 1 0 1))
		 :pos (or pos (v! 0 0 0))
		 :rad 2.5
		 :direction (or dir (v! 0.5 0.5 0))))

(defun turn-ball (ball &key direction)
  "Returns the new direction the ball should move to.
   Setf elsewhere."
  (if (equal direction :v)
      (v3:* (v! -1 1 1) (dir ball))
      (v3:* (v! 1 -1 1) (dir ball))))

(defun turn-ball-at-edge (ball)
  "Stickiness is not accounted for. 
   Bounding boxes are not accounted for."
  (if (< (/ (aref *internal-size* 0) 2) (abs (aref (pos ball) 0)))
      (setf (dir ball) (turn-ball ball :direction :v)))
  (if (< (/ (aref *internal-size* 1) 2) (abs (aref (pos ball) 1)))
      (setf (dir ball) (turn-ball ball :direction :h)))
  (dir ball))

(defun split-ball (ball &key way)
  (let ((new-ball (make-ball (pos ball) (v! 1 1 0))))
    (setf (dir new-ball) (turn-ball ball :direction way))
    (setf *balls* (cons new-ball *balls*))))

(defun kick-balls ()
  (map nil (lambda (ball)
	      (setf (dir ball)
		    (normalize-v3 (v! (- (random 100) 50)
				      (- (random 100) 50)
				      0))))
       *balls*))

(defmethod update ((ball ball))
  (let ((overlap (overlap-p *pad* ball)))
    (if overlap
	(progn
	  (setf (dir ball) (normalize-v3
			    (v! (v2:* (v! 2 1)
				      (v2:/ overlap (v2:/S (size *pad*) 2.0)))
				0)))
	  (setf (aref (dir ball) 1) (abs (aref (dir ball) 1))))))
  (setf (pos ball) (v3:+ (pos ball) (v3:*s (turn-ball-at-edge ball)
					   (spd ball)))))

;;; tiles
(defclass tile (entity)
  ((life :initform 1 :initarg :life :accessor life)
   (size :initform (v! 20 10) :initarg :size :accessor size)))

(defun make-tile (pos &optional life)
  (make-instance 'tile
		 :e-stream (make-square-e-stream 20 10 (v! 0 0.5 0.5 1))
		 :pos pos
		 :size (v! 20 10)
		 :life (or life 1)))

(defmethod update ((tile tile))
  (map nil (lambda (ball)
	     (let ((overlap (overlap-p tile ball)))
	       (if overlap
		   (progn
		     (setf (dir ball)
			   (if (= (abs (aref (v2:/ overlap (v2:/S (size tile) 2.0)) 1))
				  1.0)
			       (turn-ball ball :direction :h)
			       (turn-ball ball :direction :v)))
		     (decf (life tile))
		     (if (= (life tile) 0)
			 (progn
			   (setf *tiles* (remove tile *tiles*))
			   (kill tile)))))))
       *balls*))

;;; Collision magic
(defmethod  bounding-box ((entity entity))
  (let ((y (v! (aref (pos entity) 0)
	       (+ (aref (size entity) 0)
		  (aref (pos entity) 0))))
	(x (v! (aref (pos entity) 1)
	       (+ (aref (size entity) 1)
		  (aref (pos entity) 1)))))
    (v! y x)))

(defmethod  overlap-p ((ent1 entity) (ent2 entity))
  "AABB bounding box checking. Currently unused."
  (labels ((test-y (entity1 entity2)
	     (or (in-range (aref (bounding-box entity1) 0)
			   (subseq (bounding-box entity2) 0 2))
		 (in-range (aref (bounding-box entity1) 1)
			   (subseq (bounding-box entity2) 0 2))))
	   (test-x (entity1 entity2)
	     (or (in-range (aref (bounding-box entity1) 2)
			   (subseq (bounding-box entity2) 2))
		 (in-range (aref (bounding-box entity1) 3)
			   (subseq (bounding-box entity2) 2)))))
    (and (test-y ent1 ent2)
	 (test-x ent1 ent2))))

(defmethod  overlap-p ((ent1 entity) (ball ball))
  (let* ((ball-center (v2:+S (subseq (pos ball) 0 2) (rad ball)))
	 (ent-center  (v2:+ (subseq (pos ent1) 0 2) (v2:/S (size ent1) 2.0)))
	 (point (clamp-v2 (v2:*S (v2:/S (size ent1) 2.0) -1.0)
			  (v2:/S (size ent1) 2.0)
			  (v2:- ball-center ent-center)))
	 (diff (v2:- ball-center (v2:+ ent-center point))))
    ;; (format t "~a, ~a, ~a, ~a, ~a" (sqrt (+ (expt (aref diff 0) 2)
    ;;  					(expt (aref diff 1) 2)))
    ;; 	    point ball-center ent-center (rad ball))
    (if (> (rad ball) (sqrt (+ (expt (aref diff 0) 2)
			       (expt (aref diff 1) 2))))
	point
	nil)))