layers/screens.lisp

   1 ;;;; Ru*** roLeplay Playground virtual tabletop
   2 ;;;; Copyright (C) 2022  Zull
   3 ;;;;
   4 ;;;; This program is free software: you can redistribute it and/or modify
   5 ;;;; it under the terms of the GNU General Public License as published by
   6 ;;;; the Free Software Foundation, either version 3 of the License, or
   7 ;;;; (at your option) any later version.
   8 ;;;;
   9 ;;;; This program is distributed in the hope that it will be useful,
  10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 ;;;; GNU General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU General Public License
  15 ;;;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
  16
  17 (in-package :rulp.layers)
  18 ;; This is the most generic class in the program with model, this class define
  19 ;; objects to be displayed on screen, whenever they are entities, planes text
  20 ;; or icons.
  21
  22 (defgeneric x (s)
  23   (:documentation "returns the x position of the screen, the optional plane provide a grid"))
  24 (defgeneric y (s)
  25   (:documentation "returns the y position of the screen, the optional plane provide a grid"))
  26 (defgeneric width (s)
  27   (:documentation "returns the width of the screen, the optional plane provide a grid"))
  28 (defgeneric height (s)
  29   (:documentation "returns the height of the screen, the optional plane provide a grid"))
  30
  31 (defgeneric render (screen x y width height)
  32   (:documentation "display the screen by using the defined coordinates and size"))
  33
  34 (defgeneric texture (s))
  35 (defgeneric surface (s))
  36 (defgeneric screen-source (s))
  37 (defgeneric screen-destination (s p)
  38   (:documentation "returns a sdl2 rectangle where the surface in real space, it indicates
  39 where the screen should be displayed"))
  40
  41 ;; space dependent means that the thing can change position based on what space is
  42 ;; on. if it is indipendent (under no space) it will be default to real space (therefore
  43 ;; pixel per pixel coordinates and dimensions)
  44 ;; when instead the object is under something it will use it's space, thefore it will be
  45 ;; set into a grid, which will be provided by the something itself.
  46 (defclass screen ()
  47   ((coordinate :accessor coordinate
  48                :initarg :coordinate
  49                :initform '(0 . 0)
  50                :documentation "the position of the object in the space, space dependent"
  51                :type list)
  52    (size :accessor size
  53          :initarg :size
  54          :initform '(50 . 50)
  55          :documentation "the size of the object, by default 50x50, space dependent"
  56          :type list)
  57    (texture :initform nil
  58             :accessor texture)
  59    (rotation :accessor rotation)
  60    (surface :initform nil
  61             :accessor surface)
  62    (path :reader image-path
  63          :initarg :image
  64          :initform (merge-pathnames rulp.parameters:*rulp-share* "test.tga"))
  65    (s-rect :initform nil
  66            :documentation "this value contains the source rectangle to be used, don't
  67 interact directly with this but use screen-source instead")
  68    (d-rect :initform nil
  69            :documentation "this value contains the destination rectangle to be used, don't
  70 interact directly with this but use screen-destination instead")
  71    ))
  72
  73 ;; Real space is the pixel grid of the screen, a position of (6 . 7) means
  74 ;; the 6th pixel horizontally and 7th pixel vertically.
  75 ;;
  76 ;; while this is useful for planes and other screens, this is hurtful for
  77 ;; entities which move in a grid. The optional p can be used for a plane, which
  78 ;; can shift these 4 functions to be inside the grid.
  79 ;;
  80 ;; this is what's called entity or plane space. Here when the grid is
  81 ;; set to 100 the position (6 . 7) means the 6th square horizontally and
  82 ;; 7th square vertically, or 600 pixels horiz. and 700 pixels vert.
  83 (defmethod x ((s screen))
  84   "returns the x position in real space (or in a grid of 1 pixel span)"
  85   (car (slot-value s 'coordinate)))
  86 (defmethod y ((s screen))
  87   "returns the y position in real space (or in a grid of 1 pixel span)"
  88   (cdr (slot-value s 'coordinate)))
  89 (defmethod width ((s screen))
  90   "returns the width in real space (or in a grid of 1 pixel span)"
  91   (car (slot-value s 'size)))
  92 (defmethod height ((s screen))
  93   "returns the height in real space (or in a grid of 1 pixel span)"
  94   (cdr (slot-value s 'size)))
  95
  96 (defmethod (setf x) (value (s screen))
  97   (setf (car (slot-value s 'coordinate)) value))
  98 (defmethod (setf y) (value (s screen))
  99   (setf (cdr (slot-value s 'coordinate)) value))
 100 (defmethod (setf width) (value (s screen))
 101   (setf (car (slot-value s 'size)) value))
 102 (defmethod (setf height) (value (s screen))
 103   (setf (cdr (slot-value s 'size)) value))
 104
 105 (defmethod initialize-instance :after ((s screen) &rest args)
 106   (declare (ignore args))
 107   (setf (slot-value s 'texture) (rulp.render:load-texture (slot-value s 'path)))
 108   (setf (width s) (rulp.render:texture-width (texture s)))
 109   (setf (height s) (rulp.render:texture-height (texture s)))
 110   )
 111
 112 (defmethod screen-source ((s screen))
 113   "return the source rectangle, the portion of texture to display (standard all)"
 114   (slot-value s 's-rect))
 115
 116 ;; FIXME: save and use the make-rect. destroy and create a new one when
 117 ;; info don't match
 118 ;; (defmethod screen-destination ((s screen) (p t))
 119 ;;   "Without a plane of reference screens are printed full size offset of x and y
 120 ;; pixels from the upper left angle of the window"
 121 ;;   (let ((rect (slot-value s 'd-rect)))
 122 ;;     (if (and
 123 ;;          rect
 124 ;;          (equal (x s) (sdl2:rect-x rect))
 125 ;;          (equal (y s) (sdl2:rect-y rect))
 126 ;;          (equal (width s) (sdl2:rect-width rect))
 127 ;;          (equal (height s) (sdl2:rect-height rect)))
 128 ;;         (rect)
 129 ;;         (progn (sdl2:free-rect (slot-value s 'd-rect))
 130 ;;                (sdl2:make-rect (x s) (y s) (width s) (height s)))
 131 ;;         ))
 132 ;;   )
 133
 134 (defmethod render ((screen screen) x y width height)
 135   (rulp.render:render-texture nil (list x y
 136                                         (if (<= width 0)
 137                                             (width screen)
 138                                             width)
 139                                         (if (<= height 0)
 140                                             (height screen)
 141                                             height))
 142                               (texture screen))
 143   )
 144
 145 ;; FIXME: find a way to store rectangles to later use
 146 (defmethod screen-destination ((s screen) (p t))
 147   "without a plane of reference, a screen is just printed full size from the
 148 top left of the window"
 149   (sdl2:make-rect (x s) (y s) (width s) (height s))
 150   )
 151
 152 (defun screen-purge (screen)
 153   "purge screens video data. This data is automatically generated during rendering"
 154   (sdl2:destroy-texture (texture s))
 155   (when (surface s)
 156     (sdl2:free-surface (surface s))))
 157
 158 ;; Flyweight zone, screens should be accessed only from the function get screen
 159 (defparameter *screen-list* nil)
 160
 161 (defun path-equal (value screen)
 162   (equal value (image-path screen)))
 163
 164 (defun get-screen (path)
 165   "A flyweight for screens. Given a path this function return an existing
 166 texture or, if no other exists, create a new one and return it."
 167   (if (member path *screen-list* :test #'path-equal)
 168       (car (member path *screen-list* :test #'path-equal))
 169       (car (push (make-instance 'screen :image path)
 170                  *screen-list*))))
 171
 172 (defun empty-screen-list ()
 173   (loop :for screen in *screen-list*
 174         :do (rulp.render:destroy-texture (slot-value screen 'texture)))
 175   (setf *screen-list* nil))