OSDN Git Service

graphics: sdl2:rects freed after use
[rulp/rulp.git] / 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 :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 texture (s))
32 (defgeneric surface (s))
33 (defgeneric screen-source (s))
34 (defgeneric screen-destination (s p)
35   (:documentation "returns a sdl2 rectangle where the surface in real space, it indicates
36 where the screen should be displayed"))
37
38 ;; space dependent means that the thing can change position based on what space is
39 ;; on. if it is indipendent (under no space) it will be default to real space (therefore
40 ;; pixel per pixel coordinates and dimensions)
41 ;; when instead the object is under something it will use it's space, thefore it will be
42 ;; set into a grid, which will be provided by the something itself.
43 (defclass screen ()
44   ((coordinate :accessor coordinate
45                :initarg :coordinate
46                :initform '(0 . 0)
47                :documentation "the position of the object in the space, space dependent"
48                :type list)
49    (size :accessor size
50          :initarg :size
51          :initform '(50 . 50)
52          :documentation "the size of the object, by default 50x50, space dependent"
53          :type list)
54    (texture :initform nil
55             :accessor texture)
56    (rotation :accessor rotation)
57    (surface :initform nil
58             :accessor surface)
59    (path :accessor image-path
60          :initarg :image
61          :initform (merge-pathnames parameters:*rulp-share* "test.png"))
62    (s-rect :initform nil
63            :documentation "this value contains the source rectangle to be used, don't
64 interact directly with this but use screen-source instead")
65    (d-rect :initform nil
66            :documentation "this value contains the destination rectangle to be used, don't
67 interact directly with this but use screen-destination instead")
68    ))
69
70 ;; Real space is the pixel grid of the screen, a position of (6 . 7) means
71 ;; the 6th pixel horizontally and 7th pixel vertically.
72 ;;
73 ;; while this is useful for planes and other screens, this is hurtful for
74 ;; entities which move in a grid. The optional p can be used for a plane, which
75 ;; can shift these 4 functions to be inside the grid.
76 ;;
77 ;; this is what's called entity or plane space. Here when the grid is
78 ;; set to 100 the position (6 . 7) means the 6th square horizontally and
79 ;; 7th square vertically, or 600 pixels horiz. and 700 pixels vert.
80 (defmethod x ((s screen))
81   "returns the x position in real space (or in a grid of 1 pixel span)"
82   (car (slot-value s 'coordinate)))
83 (defmethod y ((s screen))
84   "returns the y position in real space (or in a grid of 1 pixel span)"
85   (cdr (slot-value s 'coordinate)))
86 (defmethod width ((s screen))
87   "returns the width in real space (or in a grid of 1 pixel span)"
88   (car (slot-value s 'size)))
89 (defmethod height ((s screen))
90   "returns the height in real space (or in a grid of 1 pixel span)"
91   (cdr (slot-value s 'size)))
92
93 (defmethod (setf x) (value (s screen))
94   (setf (car (slot-value s 'coordinate)) value))
95 (defmethod (setf y) (value (s screen))
96   (setf (cdr (slot-value s 'coordinate)) value))
97 (defmethod (setf width) (value (s screen))
98   (setf (car (slot-value s 'size)) value))
99 (defmethod (setf height) (value (s screen))
100   (setf (cdr (slot-value s 'size)) value))
101
102 (defmethod initialize-instance :after ((s screen) &rest args)
103   (setf (surface s) (sdl2-image:load-image (slot-value s 'path))))
104
105 (defmethod screen-source ((s screen))
106   "return the source rectangle, the portion of texture to display (standard all)"
107   nil)
108
109 ;; FIXME: save and use the make-rect. destroy and create a new one when
110 ;; info don't match
111 ;; (defmethod screen-destination ((s screen) (p t))
112 ;;   "Without a plane of reference screens are printed full size offset of x and y
113 ;; pixels from the upper left angle of the window"
114 ;;   (let ((rect (slot-value s 'd-rect)))
115 ;;     (if (and
116 ;;          rect
117 ;;          (equal (x s) (sdl2:rect-x rect))
118 ;;          (equal (y s) (sdl2:rect-y rect))
119 ;;          (equal (width s) (sdl2:rect-width rect))
120 ;;          (equal (height s) (sdl2:rect-height rect)))
121 ;;         (rect)
122 ;;         (progn (sdl2:free-rect (slot-value s 'd-rect))
123 ;;                (sdl2:make-rect (x s) (y s) (width s) (height s)))
124 ;;         ))
125 ;;   )
126
127 ;; FIXME: find a way to store rectangles to later use
128 (defmethod screen-destination ((s screen) (p t))
129   "without a plane of reference, a screen is just printed full size from the
130 top left of the window"
131   (sdl2:make-rect (x s) (y s) (width s) (height s))
132   )
133
134 (defmethod screen-purge ((s screen))
135   "purge screens video data. This data is automatically generated during rendering"
136   (sdl2:destroy-texture (texture s))
137   (sdl2:free-surface (surface s)))