layers/screens.lisp: created render and getscreen functions

[rulp/rulp.git] / layers / screens.lisp

diff --git a/layers/screens.lisp b/layers/screens.lisp
index c2ccb27..1cccb83 100644 (file)
--- a/layers/screens.lisp
+++ b/layers/screens.lisp
@@ -14,7 +14,7 @@
 ;;;; 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.
@@ -28,6 +28,9 @@
 (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))
@@ -42,23 +45,23 @@ where the screen should be displayed"))
 ;; 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.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")
@@ -100,11 +103,15 @@ interact directly with this but use screen-destination instead")
   (setf (cdr (slot-value s 'size)) value))
 
 (defmethod initialize-instance :after ((s screen) &rest args)
-  (setf (surface s) (sdl2-image:load-image (slot-value s 'path))))
+  (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)"
-  nil)
+  (slot-value s 's-rect))
 
 ;; FIXME: save and use the make-rect. destroy and create a new one when
 ;; info don't match
@@ -124,6 +131,10 @@ interact directly with this but use screen-destination instead")
 ;;         ))
 ;;   )
 
+(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
@@ -131,7 +142,23 @@ top left of the window"
   (sdl2:make-rect (x s) (y s) (width s) (height 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 :path image)
+                 *screen-list*))))
+