;;;; 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 :layers)
+(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 render (screen x y width height)
+ (:documentation "display the screen by using the defined coordinates and size"))
(defgeneric texture (s))
(defgeneric surface (s))
;; 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)
+ :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)
+ :initarg :size
+ :initform '(50 . 50)
+ :documentation "the size of the object, by default 50x50, space dependent"
+ :type list)
(texture :initform nil
- :accessor texture)
+ :accessor texture)
(rotation :accessor rotation)
(surface :initform nil
- :accessor surface)
- (path :accessor image-path
+ :accessor surface)
+ (path :reader image-path
:initarg :image
- :initform (merge-pathnames parameters:*rulp-share* "test.png"))
+ :initform (merge-pathnames rulp.parameters:*rulp-share* "test.tga"))
+ (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
;; 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) &optional (p t))
-; "returns the x position in real space (or in a grid of 1 pixel span)"
-; (car (slot-value s 'coordinate)))
-;(defmethod y ((s screen) &optional (p t))
-; "returns the y position in real space (or in a grid of 1 pixel span)"
-; (cdr (slot-value s 'coordinate)))
-;(defmethod width ((s screen) &optional (p t))
-; "returns the width in real space (or in a grid of 1 pixel span)"
-; (car (slot-value s 'size)))
-;(defmethod height ((s screen) &optional (p t))
-; "returns the height in real space (or in a grid of 1 pixel span)"
-; (cdr (slot-value s 'size)))
-(defmethod x ((s screen))
+(defmethod x ((obj 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))
+ (car (slot-value obj 'coordinate)))
+(defmethod y ((obj 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))
+ (cdr (slot-value obj 'coordinate)))
+(defmethod w ((obj screen))
"returns the width in real space (or in a grid of 1 pixel span)"
- (car (slot-value s 'size)))
-(defmethod height ((s screen))
+ (rulp.render:texture-width (texture obj)))
+(defmethod h ((obj screen))
"returns the height in real space (or in a grid of 1 pixel span)"
- (cdr (slot-value s 'size)))
+ (rulp.render:texture-height (texture obj))
+ ;; (cdr (slot-value obj '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 (setf x) (value (obj screen))
+ (setf (car (slot-value obj 'coordinate)) value))
+(defmethod (setf y) (value (obj screen))
+ (setf (cdr (slot-value obj 'coordinate)) value))
+(defmethod (setf w) (value (obj screen))
+ (setf (car (slot-value obj 'size)) value))
+(defmethod (setf h) (value (obj screen))
+ (setf (cdr (slot-value obj 'size)) value))
(defmethod initialize-instance :after ((s screen) &rest args)
- (setf (surface s) (sdl2-image:load-image (slot-value s 'path))))
-
-;(defmethod source ((s screen))
-; "return the source rectangle, the portion of texture to display (standard all)"
-; nil)
+ (declare (ignore args))
+ (setf (slot-value s 'texture) (rulp.render:load-texture (slot-value s 'path)))
+ )
(defmethod screen-source ((s screen))
"return the source rectangle, the portion of texture to display (standard all)"
- nil)
+ (slot-value s 's-rect))
-;; the functions x, y, w and h are meant to be tampered with, in the entity this
-;; function will be redifined to account for size and grid size, while planes will
-;; use the surface width and height
-;(defmethod destination ((s screen) &optional (p nil))
-; "returns the destination rectangle, or where the screen should be displayed"
-; (sdl2:make-rect (x s p) (y s p) (width s p) (height s p)))
+;; 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 ((screen screen) x y width height)
+ (rulp.render:render-texture nil (list x y
+ (if (<= width 0)
+ (rulp.render:texture-width (texture screen))
+ width)
+ (if (<= height 0)
+ (rulp.render:texture-height (texture screen))
+ height)
+ )
+ (texture screen))
+ )
+;; FIXME: find a way to store rectangles to later use
(defmethod screen-destination ((s screen) (p t))
- (sdl2:make-rect (x s) (y s) (width s) (height s))
+ "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) (w s) (h s))
)
-(defmethod screen-purge ((s screen))
+(defun screen-purge (screen)
"purge screens video data. This data is automatically generated during rendering"
(sdl2:destroy-texture (texture s))
- (sdl2:free-surface (surface 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 :image path)
+ *screen-list*))))
+
+(defun empty-screen-list ()
+ (loop :for screen in *screen-list*
+ :do (rulp.render:destroy-texture (slot-value screen 'texture)))
+ (setf *screen-list* nil))
OSDN Git Service
