;;;; 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.layers)
;; This is the most generic class in the program with model, this class define
;; objects to be displayed on screen, whenever they are entities, planes text
;; or icons.

(defgeneric x (s)
  (:documentation "returns the x position of the screen, the optional plane provide a grid"))
(defgeneric y (s)
  (:documentation "returns the y position of the screen, the optional plane provide a grid"))
(defgeneric width (s)
  (:documentation "returns the width of the screen, the optional plane provide a grid"))
(defgeneric height (s)
  (:documentation "returns the height of the screen, the optional plane provide a grid"))

(defgeneric display (s)
  (:documentation "display the screen by using the defined coordinates and size"))

(defgeneric texture (s))
(defgeneric surface (s))
(defgeneric screen-source (s))
(defgeneric screen-destination (s p)
  (:documentation "returns a sdl2 rectangle where the surface in real space, it indicates
where the screen should be displayed"))

;; space dependent means that the thing can change position based on what space is
;; on. if it is indipendent (under no space) it will be default to real space (therefore
;; pixel per pixel coordinates and dimensions)
;; when instead the object is under something it will use it's space, thefore it will be
;; set into a grid, which will be provided by the something itself.
(defclass screen ()
  ((coordinate :accessor coordinate
               :initarg :coordinate
               :initform '(0 . 0)
               :documentation "the position of the object in the space, space dependent"
               :type list)
   (size :accessor size
         :initarg :size
         :initform '(50 . 50)
         :documentation "the size of the object, by default 50x50, space dependent"
         :type list)
   (texture :initform nil
            :accessor texture)
   (rotation :accessor rotation)
   (surface :initform nil
            :accessor surface)
   (path :reader image-path
         :initarg :image
         :initform (merge-pathnames rulp.parameters:*rulp-share* "test.png"))
   (s-rect :initform nil
           :documentation "this value contains the source rectangle to be used, don't
interact directly with this but use screen-source instead")
   (d-rect :initform nil
           :documentation "this value contains the destination rectangle to be used, don't
interact directly with this but use screen-destination instead")
   ))

;; Real space is the pixel grid of the screen, a position of (6 . 7) means
;; the 6th pixel horizontally and 7th pixel vertically.
;;
;; while this is useful for planes and other screens, this is hurtful for
;; entities which move in a grid. The optional p can be used for a plane, which
;; can shift these 4 functions to be inside the grid.
;;
;; this is what's called entity or plane space. Here when the grid is
;; set to 100 the position (6 . 7) means the 6th square horizontally and
;; 7th square vertically, or 600 pixels horiz. and 700 pixels vert.
(defmethod x ((s screen))
  "returns the x position in real space (or in a grid of 1 pixel span)"
  (car (slot-value s 'coordinate)))
(defmethod y ((s screen))
  "returns the y position in real space (or in a grid of 1 pixel span)"
  (cdr (slot-value s 'coordinate)))
(defmethod width ((s screen))
  "returns the width in real space (or in a grid of 1 pixel span)"
  (car (slot-value s 'size)))
(defmethod height ((s screen))
  "returns the height in real space (or in a grid of 1 pixel span)"
  (cdr (slot-value s 'size)))

(defmethod (setf x) (value (s screen))
  (setf (car (slot-value s 'coordinate)) value))
(defmethod (setf y) (value (s screen))
  (setf (cdr (slot-value s 'coordinate)) value))
(defmethod (setf width) (value (s screen))
  (setf (car (slot-value s 'size)) value))
(defmethod (setf height) (value (s screen))
  (setf (cdr (slot-value s 'size)) value))

(defmethod initialize-instance :after ((s screen) &rest args)
  (declare (ignore args))
  (setf (slot-value s 'texture) (rulp.render:load-texture (slot-value s 'path)))
  (setf (width s) (rulp.render:texture-width (texture s)))
  (setf (height s) (rulp.render:texture-height (texture s)))
  )

(defmethod screen-source ((s screen))
  "return the source rectangle, the portion of texture to display (standard all)"
  (slot-value s 's-rect))

;; FIXME: save and use the make-rect. destroy and create a new one when
;; info don't match
;; (defmethod screen-destination ((s screen) (p t))
;;   "Without a plane of reference screens are printed full size offset of x and y
;; pixels from the upper left angle of the window"
;;   (let ((rect (slot-value s 'd-rect)))
;;     (if (and
;;          rect
;;          (equal (x s) (sdl2:rect-x rect))
;;          (equal (y s) (sdl2:rect-y rect))
;;          (equal (width s) (sdl2:rect-width rect))
;;          (equal (height s) (sdl2:rect-height rect)))
;;         (rect)
;;         (progn (sdl2:free-rect (slot-value s 'd-rect))
;;                (sdl2:make-rect (x s) (y s) (width s) (height s)))
;;         ))
;;   )

(defmethod render ((s screen) x y width height)
  (render-texture nil `(,x ,y ,width ,height) (texture s))
  )

;; FIXME: find a way to store rectangles to later use
(defmethod screen-destination ((s screen) (p t))
  "without a plane of reference, a screen is just printed full size from the
top left of the window"
  (sdl2:make-rect (x s) (y s) (width s) (height s))
  )

(defun screen-purge (screen)
  "purge screens video data. This data is automatically generated during rendering"
  (sdl2:destroy-texture (texture s))
  (when (surface s)
    (sdl2:free-surface (surface s))))

;; Flyweight zone, screens should be accessed only from the function get screen
(defparameter *screen-list* nil)

(defun path-equal (value screen)
  (equal value (image-path screen)))

(defun get-screen (path)
  "A flyweight for screens. Given a path this function return an existing
texture or, if no other exists, create a new one and return it."
  (if (member path *screen-list* :test #'path-equal)
      (car (member path *screen-list* :test #'path-equal))
      (car (push (make-instance 'screen :path image)
                 *screen-list*))))