;;;; Ru*** roLeplay Playground virtual tabletop
;;;; Copyright (C) 2022  Zull
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.

(in-package :rulp.graphics)

;; this functions are changed every frame with the mouse position. This
;; is then used everywhere. This assure syncronization between two functions.
;; The values are stored in a cons and can be exported with (x *mouse-position*)
;; and (y *mouse-position*)
(defparameter *mouse-position* '(0 . 0)
  "contains the mouse coordinates in the screen, this is updated by frame")
(defparameter *mouse-previous-position* '(0 . 0)
  "contains the mouse coordinates on the previous frame, this is updated by frame
using *mouse-position*. The usefullness of this value is to create velocity")

(defparameter *is-mouse-hold* nil
  "this variable is modified when a button is hold down. This doesn't specifies
which button is being hold.")
;; (defparameter +mode+ '+normal-mode+)


;; NOTE: this is a frame dependent version, correction is easy when i'll have
;; time deltas.
(defun velocity (actual-point previous-point)
  "calculate the delta between two points. This is absolutely frame dependent"
  (cons (- (car actual-point) (car previous-point))
        (- (cdr actual-point) (cdr previous-point))))

(defun panning (position previous-position viewpoint)
  "destructive function. It update the value with the given delta. Both value
and delta are coordinate cons (like '(x . y)), output is garbage"
  (let ((delta (cons (- (car position) (car previous-position))
                     (- (cdr position) (cdr previous-position)))))
    (setf (car viewpoint) (+ (car viewpoint) (car delta))
          (cdr viewpoint) (+ (cdr viewpoint) (cdr delta)))))

;; (defgeneric select-entry (x y p)
;;   (:documentation "operate with menues, create them, destroy them and apply them"))

;; (defgeneric key-activate (x y pressed p))

;; (defmethod key-activate (x y pressed (p plane))
;;   )

;; (defgeneric activate (x y pressed p)
;;   (:documentation "given x y and the button pressed it do actions"))

;; (defmethod activate (x y pressed (p plane))
;;   (loop :for key :in *mouse-keybinds*
;;         :do
;;            (when (sdl2:mouse-state-p (eval (car key)))
;;              (apply (cadr key) `(,x ,y ,p))
;;                     )))


;; FIXME: this method can be designed non destructively. by just returning the position
;; in the list of the selected entity
(defun select-pointer (coordinates previous viewpoint)
  "given coordinates and a list of entities return the position in the list of the selected
entity or nil if noone is selected"
  (declare (ignore previous viewpoint))           ; mouse-previous is not used in this function
  (let ((grid (plane-grid *plane*))
        (mouse-point (cons (floor (/  (- (car coordinates) (car *viewpoint-offset*)) *viewpoint-zoom*))
                           (floor (/  (- (cdr coordinates) (cdr *viewpoint-offset*)) *viewpoint-zoom*)))))
    ;; FIXME: the this calculation should be made elsewhere
    (setf *pointer* nil)
    (loop :for obj :in (entities-list *plane*)
          :for obj-nth :from 0 :to (length (entities-list *plane*))
          :do
             (let ((obj-position-to-grid (to-grid grid (coordinates obj)))
                   (obj-size-to-grid (to-grid grid (size obj))))
               (when (rulp.render:intersect-point
                      (car obj-position-to-grid)
                      (cdr obj-position-to-grid)
                      (car obj-size-to-grid)
                      (cdr obj-size-to-grid)
                      (car mouse-point)
                      (cdr mouse-point))
                 (setf *pointer* obj-nth)
                 )))))

(defun move-entity (coordinates previous viewpoint)
  "with right button it move the entity around the plane"
  (declare (ignore previous viewpoint))
  (when (numberp *pointer*)
    (let* ((offset (cons (floor (/ (car *viewpoint-offset*) *viewpoint-zoom*))
                         (floor (/ (cdr *viewpoint-offset*) *viewpoint-zoom*))))
           ;; FIXME: create a solution for viewpoints
           (offset-coordinates (cons (- (car coordinates) (car offset))
                                     (- (cdr coordinates) (cdr offset))))
           (discrete-coordinates (from-grid (plane-grid *plane*) offset-coordinates)))
      (setf (coordinates (nth *pointer* (entities-list *plane*))) discrete-coordinates)
      )))

(defun summon-entry (coordinates contents &key (title ""))
  (make-instance 'entry :title title
                        :coordinate coordinates
                        :contents contents
                        ))


(defun mouse-actions (keybinds)
  "given an association list of keybinds it returns the associated element
when the button is pressed"
  (loop :for button :in keybinds
        :collect (when (sdl2:mouse-state-p (eval (car button))) ; NOTE: watch out for this eval
                   (cdr button))))


(defconstant +mouse-button-left+ 1 "this binds the left button")
(defconstant +mouse-button-right+ 3 "this binds the right button")
(defconstant +mouse-button-middle+ 2 "this binds the scroll button")

;; FIXME: replace with apply system and fixed arguments *mouse-position*, *mouse-previous-position* *viewpoint-offset*
;; (defparameter *mouse-keybinds* (list
;;                                 '(+mouse-button-left+ nil (select-pointer *mouse-position* *entities-list*))
;;                                 '(+mouse-button-middle+ (panning *viewpoint-offset* (velocity *mouse-position* *mouse-previous-position*)) nil)
;;                                 '(+mouse-button-right+ nil (move-entity *mouse-position*))
;;                                 ;; '(+mouse-button-right+ nil (push (summon-entry *mouse-position* '(1)) *active-entries*))
;;                                 )
;;   "This is the mouse-keybinds association list. The first value is the button, the second
;; is the action executed on hold and the third is the action executed on release (if any)")

;;             mouse-keybinds    (+button pressed+       drag-event click-event     )
(defparameter *mouse-keybinds* (list
                                '(+mouse-button-left+    nil       select-pointer   )
                                '(+mouse-button-middle+  panning   nil              )
                                '(+mouse-button-right+   nil       move-entity      )
                                ;; '(+mouse-button-right+ nil (push (summon-entry *mouse-position* '(1)) *active-entries*))
                                )
  "This is the mouse-keybinds association list. The first value is the button, the second
is the action executed on hold and the third is the action executed on release (if any)")

(defun mouse-event (coordinates &key (dragp nil))
  "this function is called when the mouse is pressed, it takes the mouse
coordinates and execute the necessary actions. This function depends on
rulp.entries:*entries-list*"
  (flet ((action (x) (if dragp
                         (cadr x)
                         (caddr x))))
    (if rulp.entries:*entries-list*
        (unless (rulp.entries:click-event
                 (first rulp.entries:*entries-list*)
                 *mouse-position*)
          (pop rulp.entries:*entries-list*))
        (loop :for button :in *mouse-keybinds*
              :do (when (and (action button) (sdl2:mouse-state-p (eval (car button))))
                    (apply (action button) (list coordinates
                                                 *mouse-previous-position*
                                                 *viewpoint-offset*)))
              ))))