(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))
;; 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 rulp.parameters:*rulp-share* "test.png"))
(s-rect :initform nil
(defmethod (setf height) (value (s screen))
(setf (cdr (slot-value s 'size)) value))
-;; FIXME: entities use size as a simple integer, change to make it work better
(defmethod initialize-instance :after ((s screen) &rest args)
(declare (ignore args))
- (setf (surface s) (sdl2-image:load-image (slot-value s 'path)))
- (setf (width s) (sdl2:surface-width (surface s))
- (height s) (sdl2:surface-height (surface s)))
- (setf (slot-value s 's-rect) (sdl2:make-rect 0 0 (width s) (height s))))
+ (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)"
;; ))
;; )
+(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
(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*))))
+
(defpackage :rulp.render
(:use :cl)
- (:export *renderer* render-line render-text color))
+ (:export *renderer* ;; TODO: remove when api is done
+ color
+ render-line render-text render-texture
+ load-texture texture-width texture-height
+ intersect-point intersect-square
+ make-rectangle))
necessary without creating and destroying rectangles. Use this with
the rectangle function.")
+(defun make-rectangle (x y width height)
+ (sdl2:make-rect x y width height))
+
(defun move-rectangle (x y width height rectangle)
"setup a rectangle and return it"
(setf (sdl2:rect-x rectangle) x)
"These rectangles are cache used by render-texture to renderize without
creating and destroying them every time")
-(defun render-texture (source-x source-y source-width source-height
- dest-x dest-y dest-width dest-height
+(defun render-texture (source-list
+ destination-list
texture)
- (move-rectangle source-x source-y source-width source-height (car *texture-cache-rectangles*))
- (move-rectangle dest-x dest-y dest-width dest-height (cdr *texture-cache-rectangles*))
- (sdl2:render-copy *renderer* texture
- (car *texture-cache-rectangles*)
+ "Given two list of four numbers (x y width height) or empty lists it render
+them on screen. When given an empty list it uses the whole source or destination
+to print the result. If source-list is nil then the whole texture is displayed,
+if destination-list is nil then the selected texture is displayed on the whole
+window or destination screen buffer."
+ (when source-list
+ (move-rectangle (nth 0 source-list) (nth 1 source-list)
+ (nth 2 source-list) (nth 3 source-list)
+ (car *texture-cache-rectangles*)))
+ (when destination-list
+ (move-rectangle (nth 0 destination-list) (nth 1 destination-list)
+ (nth 2 destination-list) (nth 3 destination-list)
(cdr *texture-cache-rectangles*)))
+ (sdl2:render-copy *renderer* texture
+ :source-rect (if source-list
+ (car *texture-cache-rectangles*)
+ nil)
+ :dest-rect (if destination-list
+ (cdr *texture-cache-rectangles*)
+ nil)))
;; collision detection
(defun intersect-square (source-x source-y source-width source-height
(defun intersect-point (source-x source-y source-width source-height
point-x point-y)
(intersect-square source-x source-y source-width source-height point-x point-y 10 10))
+
+(defun load-texture (path)
+ (let* ((temporary-surface nil))
+ (setf temporary-surface (sdl2-image:load-image path))
+ (prog1
+ (sdl2:create-texture-from-surface *renderer* temporary-surface)
+ (sdl2:free-surface temporary-surface))
+ )
+ )
+
+(defun texture-width (texture)
+ (sdl2:texture-width texture))
+
+(defun texture-height (texture)
+ (sdl2:texture-height texture))
:entry-point "rulp.core:main"
:depends-on ("sdl2" "sdl2-image" "sdl2-ttf" "alexandria" "clingon" "cl-json")
:components ((:file "parameters")
+ (:module "render"
+ :serial t
+ :components ((:file "package")
+ (:file "render")
+ (:file "text-rendering")))
(:module "layers"
:serial t
:depends-on ("parameters")
(:file "inputs")
(:file "grid")
(:file "view")))
-; (:module "gui"
-; :serial t
-; :depends-on ("parameters")
-; :components ((:file "package")
-; (:file "skeleton")))
(:file "package" :depends-on ("graphics"))
(:file "script" :depends-on ("graphics"))
(:file "data" :depends-on ("package" "parameters"))
OSDN Git Service
