From: Giulio De Stasio Date: Sun, 9 Jul 2023 11:41:30 +0000 (+0200) Subject: FIX: entities under flyweight X-Git-Url: http://git.osdn.net/view?a=commitdiff_plain;ds=sidebyside;h=ca25f48867d005428d359ffc4834029b378c7abb;p=rulp%2Frulp.git FIX: entities under flyweight --- diff --git a/geometry/grid.lisp b/geometry/grid.lisp new file mode 100644 index 0000000..8351b7c --- /dev/null +++ b/geometry/grid.lisp @@ -0,0 +1,93 @@ +;;;; Ru*** roLeplay Playground virtual tabletop +;;;; Copyright (C) 2022 Zull +;;;; +;;;; This program is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see . + +(in-package :rulp.geometry) + +(defparameter *span* 70) + +(defun simple-grid (coordinates) + "this calculate a simple grid" + (cons (* *span* (car coordinates)) + (* *span* (cdr coordinates)))) + +;; NOTE: on SLY parameters that contain a function symbol will actually contain +;; the whole function, try edit the function the *grid-function* parameter links +;; to and you will see the lambda defined with grid-closure would not change. But +;; if you recompile this parameter the lambda would update. +(defparameter *grid-function* #'simple-grid) + +(defun grid-closure () + "this function create a lambda to be used for calculation on lower levels of the code +(pretty much on the layer package, used for correcting placement of entities)" + (lambda (coordinates) (apply *grid-function* (list coordinates)))) + +(defgeneric to-grid (grid par) + (:documentation "this converts a par (a pair of number into a cons) in the pixel values that +would set fit the par into the grid. + +(to-grid grid par) -> par + +for example a square grid with span 40 would transform the par (4 . 2) into (160 +. 80). When the given grid is t the method will apply the identity +transformation therefore the method will return the input + +(to-grid t par) = par")) + +(defmethod to-grid ((grid t) par) + (declare (ignore grid)) + par) + +(defgeneric from-grid (grid par) + (:documentation "this converts a par from the pixel format into the discrete values of ℤ². This +is the inverse of to-grid and it is meant for creating discrete coordinates from +human input. + +(from-grid grid par) -> par + +when the grid is t the method will become an identity map, returing the input 'as is'. + +(from-grid t par) = par")) + +(defmethod from-grid ((grid t) par) + (declare (ignore grid)) + par) + +(defclass squaregrid () + ((span :accessor span + :initarg :span + :initform 70 + :type integer + :documentation "the length of the squares that compose the square grid") + )) + +(defmethod to-grid ((grid squaregrid) par) + (cons (* (span grid) (car par)) + (* (span grid) (cdr par)))) + +(defmethod from-grid ((grid squaregrid) par) + (cons (floor (/ (car par) (span grid))) + (floor (/ (cdr par) (span grid)))) + ) + +(defmethod display ((object entity) (grid squaregrid)) + (let ((adj-coos (spr (span grid) (coordinates object))) + (adj-size (spr (span grid) (size object)))) + (render (get-screen (background object)) + (car adj-coos) + (cdr adj-coos) + (car adj-size) + (cdr adj-size) + ))) diff --git a/geometry/package.lisp b/geometry/package.lisp new file mode 100644 index 0000000..a77f9aa --- /dev/null +++ b/geometry/package.lisp @@ -0,0 +1,19 @@ +;;;; Ru*** roLeplay Playground virtual tabletop +;;;; Copyright (C) 2022 Zull +;;;; +;;;; This program is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see . + +(defpackage :rulp.geometry + (:use :cl :rulp.layers) + (:export grid-closure squaregrid span)) diff --git a/graphics/menu.lisp b/graphics/menu.lisp index 3519ae8..ce5c132 100644 --- a/graphics/menu.lisp +++ b/graphics/menu.lisp @@ -24,10 +24,6 @@ (defparameter *entries-list* nil "List of entries, menues who are generated into the window with options") -(defgeneric x (entry)) -(defgeneric y (entry)) -(defgeneric width (entry)) -(defgeneric height (entry)) (defgeneric rectangle (entry)) (defclass entry () @@ -69,11 +65,11 @@ :documentation "when :v the contents and title are displaced vertically, when :h the contents are horizontally displayed"))) -(defmethod x ((entry entry)) - (car (coordinates entry))) +(defmethod x ((obj entry)) + (car (coordinates obj))) -(defmethod y ((entry entry)) - (cdr (coordinates entry))) +(defmethod y ((obj entry)) + (cdr (coordinates obj))) ;; (defmethod width ((entry entry)) ;; 200) diff --git a/graphics/package.lisp b/graphics/package.lisp index 61ee8e7..06fee4c 100644 --- a/graphics/package.lisp +++ b/graphics/package.lisp @@ -15,7 +15,7 @@ ;;;; along with this program. If not, see . (defpackage :rulp.graphics - (:use :cl :rulp.layers) + (:use :cl :rulp.layers :rulp.geometry) (:export playground +plane+ *plane* *plane-grid* *map-info* *map-path* *entities-list* arrange-rect *window-width* *window-height* tr-write @@ -97,3 +97,21 @@ used on uninitialized data to bootstrap the data") (defparameter *map-path* nil "this is the path where the json file lived") + +(defparameter *execute-before* '()) +(defparameter *execute-in-viewpoint* '()) +(defparameter *execute-in-window* '()) +(defparameter *execute-after* '()) + + +;; FIXME: define push-once to avoid loading many times the same function from +;; slime/sly +(defmacro defchain (chain-name where &body body) + (cond + ((eq where :before) (push chain-name *execute-before*)) + ((eq where :viewpoint) (push chain-name *execute-in-viewpoint*)) + ((eq where :window) (push chain-name *execute-in-window*)) + ((eq where :after) (push chain-name *execute-after*)) + ) + `(defun ,chain-name () + ,@body)) diff --git a/graphics/render.lisp b/graphics/render.lisp index 5b14ece..1b53e3b 100644 --- a/graphics/render.lisp +++ b/graphics/render.lisp @@ -70,24 +70,17 @@ rectangle directly, but use the arrange-rect") (screen-destination entity plane)) entity)))) -(defmacro render-plane-and-entities (renderer) - "using *plane* and *entities-list* the macro display on the current rendering texture -the plane 'as is' and the entities with the grid-layout function" - `(when *plane* - ;; NOTE: add error for non-screen planes - (display *plane*) - ;; (sdl2:render-copy ,renderer (texture *plane*) - ;; :source-rect nil - ;; :dest-rect (screen-destination *plane* t)) - (loop :for entity :in *entities-list* - :do - (when (displayp entity) - (multiple-value-bind (coordinates size) (grid-layout (car (coordinate entity)) - (cdr (coordinate entity)) - :size (size entity)) - (sdl2:render-copy ,renderer (texture entity) - :source-rect nil ; NOTE: not general - :dest-rect (arrange-rect (car coordinates) (cdr coordinates) size size)))) ; FIXME: create a grid-layout function - ) - ) +;; BUG: when the system loads it doesn't fill the variable +;; *execute-in-viewpoint* therefore this function is never executed +(defchain render-plane-and-entities :viewpoint +;; "using *plane* and *entities-list* the macro display on the current rendering texture +;; the plane 'as is' and the entities with the grid-layout function" + (when *plane* + ;; NOTE: add error for non-screen planes + (display *plane* t) + (loop :for entity :in (entities-list *plane*) + :do + (when (displayp entity) + (display entity (plane-grid *plane*)) + ))) ; FIXME: create a grid-layout function ) diff --git a/graphics/view.lisp b/graphics/view.lisp index 5f10a21..616ae03 100644 --- a/graphics/view.lisp +++ b/graphics/view.lisp @@ -21,30 +21,29 @@ | ------------------------------------------- |# -(defun create-plane (map-info map-path &key (number 0)) - "convert the map informations into a functioning plane, without number it convert the -first element" - (let ((plane-info (nth number (cdr (assoc :planes map-info))))) - (values - (make-instance 'rulp.layers:plane - :background (merge-pathnames map-path (cdr (assoc :image-path plane-info)))) - (cdr (assoc :grid-dimension plane-info)) - ) - ;; FIXME: generalize... somehow - ) - ) - ;; FIXME: search alternative (defun create-entities (map-info map-path) (let ((entities-info (cdr (assoc :entities map-info)))) (loop :for entity-info :in entities-info :collect (make-instance 'entity - :image (merge-pathnames map-path (cdr (assoc :image-path entity-info))) + ;; :image (merge-pathnames map-path (cdr (assoc :image-path entity-info))) + :background (merge-pathnames map-path (cdr (assoc :image-path entity-info))) :size (if (assoc :size entity-info) (cdr (assoc :size entity-info)) 1) :name (assoc :name entity-info) - ) - ) + )))) + +(defun create-plane (map-info map-path &key (number 0)) + "convert the map informations into a functioning plane, without number it convert the +first element" + (let ((plane-info (nth number (cdr (assoc :planes map-info))))) + (make-instance 'rulp.layers:plane + :background (merge-pathnames map-path (cdr (assoc :image-path plane-info))) + :entities-list (create-entities map-info map-path) + :grid (make-instance 'squaregrid + :span (cdr (assoc :grid-dimension plane-info))) + ) + ;; FIXME: generalize... somehow ) ) @@ -93,6 +92,10 @@ even when away from keyboard") "initialize and run the game loop. it takes a TITLE to display and FPS for framerate. DEBUG-INFO can be used to display the content on screen for test and debug purposes." (declare (ignore fps)) + (empty-screen-list) ;; NOTE: This clean the screen list, + ;; useful for slime/sly sessions where + ;; variables are kept after the program + ;; ends but textures are closed with sdl. (sdl2:with-init (:video) (with-playground (window rulp.render:*renderer* :title title) (setf *tr-texture* (let* ((font (sdl2-ttf:open-font "media/IBMPlex.ttf" 100)) ;; FIXME: this crashes the program under windows, throws error on linux but works anyway @@ -100,25 +103,30 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo (font-texture (sdl2:create-texture-from-surface rulp.render:*renderer* font-surface))) (sdl2:free-surface font-surface) font-texture)) - (multiple-value-bind (p g) (create-plane *map-info* *map-path*) - (setf *plane* p) - (setf *plane-grid* g)) - (setf *entities-list* (create-entities *map-info* *map-path*)) + (setf *plane* (create-plane *map-info* *map-path*)) + (setf *plane-grid* (span (rulp.layers:plane-grid *plane*))) + ;; FIXME: to remove + + (setf *entities-list* (entities-list *plane*)) + (loop :for i :in *execute-before* + :do (eval `(,i))) + ;; FIXME: to remove + ;; (setf *entities-list* (create-entities *map-info* *map-path*)) (let (;; (mouse-button-previous nil) (window-texture (sdl2:get-render-target rulp.render:*renderer*)) (viewpoint-texture (sdl2:create-texture rulp.render:*renderer* (sdl2:get-window-pixel-format window) - 2 (width *plane*) (height *plane*))) ;camping into the ramhog + 2 (w *plane*) (h *plane*))) ;camping into the ramhog (viewpoint-rectangle (sdl2:make-rect 0 0 10 10))) (sdl2:with-event-loop (:method :poll) (:quit () t) (:keydown () ;; FIXME: incorporate into input.lisp. check for input every now and then outside keydown - (when (sdl2:keyboard-state-p :scancode-up) (setf (cdr *viewpoint-offset*) (+ (cdr *viewpoint-offset*) 10))) - (when (sdl2:keyboard-state-p :scancode-down) (setf (cdr *viewpoint-offset*) (+ (cdr *viewpoint-offset*) -10))) - (when (sdl2:keyboard-state-p :scancode-left) (setf (car *viewpoint-offset*) (+ (car *viewpoint-offset*) 10))) - (when (sdl2:keyboard-state-p :scancode-right) (setf (car *viewpoint-offset*) (+ (car *viewpoint-offset*) -10))) - (when (sdl2:keyboard-state-p :scancode-p) (setf *viewpoint-zoom* (+ *viewpoint-zoom* 0.2))) ; FIXME: find the scancode for the plus sign - (when (sdl2:keyboard-state-p :scancode-m) (setf *viewpoint-zoom* (+ *viewpoint-zoom* -0.2))) + ;; (when (sdl2:keyboard-state-p :scancode-up) (setf (cdr *viewpoint-offset*) (+ (cdr *viewpoint-offset*) 10))) + ;; (when (sdl2:keyboard-state-p :scancode-down) (setf (cdr *viewpoint-offset*) (+ (cdr *viewpoint-offset*) -10))) + ;; (when (sdl2:keyboard-state-p :scancode-left) (setf (car *viewpoint-offset*) (+ (car *viewpoint-offset*) 10))) + ;; (when (sdl2:keyboard-state-p :scancode-right) (setf (car *viewpoint-offset*) (+ (car *viewpoint-offset*) -10))) + ;; (when (sdl2:keyboard-state-p :scancode-p) (setf *viewpoint-zoom* (+ *viewpoint-zoom* 0.2))) ; FIXME: find the scancode for the plus sign + ;; (when (sdl2:keyboard-state-p :scancode-m) (setf *viewpoint-zoom* (+ *viewpoint-zoom* -0.2))) ) (:mousebuttondown () (setf *is-mouse-hold* t) @@ -126,7 +134,7 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo ;; of calling the second element of the keybind list it calls ;; the third element. If there is something there it would ;; execute a special function for when the mouse is released. - (mouse-event *mouse-position*) + ;; (mouse-event *mouse-position*) ) (:mousebuttonup () ;; what about functions that require a single press? just create @@ -178,24 +186,33 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo (setf viewpoint-texture (sdl2:create-texture rulp.render:*renderer* (sdl2:get-window-pixel-format window) 2 - (width *plane*) - (height *plane*))) + (w *plane*) + (h *plane*))) (sdl2:set-render-target rulp.render:*renderer* viewpoint-texture) (sdl2:render-clear rulp.render:*renderer*) - (render-plane-and-entities rulp.render:*renderer*) + (loop :for i :in *execute-in-viewpoint* + :do (eval `(,i))) + ;; the chain executes the render-plane-and-entities + + ;; FIXME: grind-render and indexes-render use the renderer + ;; directly. Update the facade with line methods and update + ;; the functions into chains (when *is-grid* - (grid-render rulp.render:*renderer* 0 0 (width *plane*) (height *plane*)) + (grid-render rulp.render:*renderer* 0 0 (w *plane*) (h *plane*)) + ;; FIXME: change to use the plane directly ) (when *is-indexes* - (indexes-render rulp.render:*renderer* 0 0 (width *plane*) (height *plane*))) + (indexes-render rulp.render:*renderer* 0 0 (w *plane*) (h *plane*))) + ;; FIXME: same as above for grids (sdl2:set-render-draw-color rulp.render:*renderer* 0 0 0 255) (setf *changep* nil) ;; pointer section (when *pointer* ;; NOTE: to test this out (sdl2:set-render-draw-color rulp.render:*renderer* 128 250 33 255) - (multiple-value-bind (coordinates size) (grid-layout (car (coordinate (nth *pointer* *entities-list*))) - (cdr (coordinate (nth *pointer* *entities-list*))) - :size (size (nth *pointer* *entities-list*))) + (multiple-value-bind (coordinates size) (grid-layout (car (coordinate (nth *pointer* (entities-list *plane*)))) + (cdr (coordinate (nth *pointer* (entities-list *plane*)))) + :size (car (size (nth *pointer* (entities-list *plane*))))) + ;; FIXME: bodged the size here, check this piece and repair (let ((select-rectangle (sdl2:make-rect (car coordinates) (cdr coordinates) size size))) (sdl2:render-draw-rect rulp.render:*renderer* select-rectangle) (sdl2:free-rect select-rectangle))) @@ -209,12 +226,15 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo (sdl2:render-clear rulp.render:*renderer*) (setf (sdl2:rect-x viewpoint-rectangle) (car *viewpoint-offset*)) (setf (sdl2:rect-y viewpoint-rectangle) (cdr *viewpoint-offset*)) - (setf (sdl2:rect-width viewpoint-rectangle) (floor (* (width *plane*) *viewpoint-zoom*))) - (setf (sdl2:rect-height viewpoint-rectangle) (floor (* (height *plane*) *viewpoint-zoom*))) + (setf (sdl2:rect-width viewpoint-rectangle) (floor (* (w *plane*) *viewpoint-zoom*))) + (setf (sdl2:rect-height viewpoint-rectangle) (floor (* (h *plane*) *viewpoint-zoom*))) (sdl2:render-copy rulp.render:*renderer* viewpoint-texture :source-rect nil :dest-rect viewpoint-rectangle) + (loop :for i :in *execute-in-window* + :do (eval `(,i))) + ;; entries visualization (loop :for entry :in rulp.entries:*entries-list* :do (rulp.entries:render-entry rulp.render:*renderer* entry)) @@ -234,11 +254,13 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo (when (< *framerule* 1) (setf *changep* t) (setf *framerule* 20)))) - (setf *changep* t) ; useful in the repl where parameters are not reset + (setf *changep* t) ; useful in the repl where parameters are not reset )) ;; sdl2 kills all textures when the session ends. on normal execution this ;; is not a problem but on emacs because the editor will not delete its ;; variables. Therefore the flyweight would be filled with screens with no ;; textures that will fail the second execution. - (rulp.layers:empty-screen-list) + (empty-screen-list) + (loop :for i :in *execute-after* + :do (eval `(,i))) )) diff --git a/layers/displayable.lisp b/layers/displayable.lisp new file mode 100644 index 0000000..1ffd51b --- /dev/null +++ b/layers/displayable.lisp @@ -0,0 +1,87 @@ +;;;; Ru*** roLeplay Playground virtual tabletop +;;;; Copyright (C) 2022 Zull +;;;; +;;;; This program is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; This program is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with this program. If not, see . +(in-package :rulp.layers) + +(defgeneric display (object over) + (:documentation "This function displays an object (generally a displayable but it can be +implemented elsewhere over a certain class. When the object is displayed over a +grid it obeys the grid structure, treating its coordinates and size as discrete +positions of the object into the grid. The over reprhesent over what structure +the object should be displayed + +When the over is t or something else it display without a structure. The object +is displayed on the window directly and coordinates and size are pixel positions +and dimensions.")) + +(defun parp (par) + "predicate for the par type, used for coordinates" + (or (null par) (and (consp par) (integerp (car par)) (integerp (cdr par))))) + +(deftype par () + `(satisfies parp)) + +(declaim (ftype (function (par par) par) add)) +(defun add (par1 par2) + "addition between two pars" + (cons (+ (car par1) (car par2)) + (+ (cdr par1) (cdr par2)))) + +(declaim (ftype (function (integer par) par) spr)) +(defun spr (value par) + "scalar multiplication between a par and a integer" + (cons (* (car par) value) + (* (cdr par) value))) + +(defclass displayable () + ((coordinates :initarg :coordinates + :accessor coordinates + :initform '(0 . 0) + :type par + :documentation "the position of the displayable on the screen, when a grid is given this defines a discrete position rather than a pixel position.") + (size :initarg :size + :accessor size + :initform '(0 . 0) + :type par + :documentation "this is the width of the displayable, when given a grid it defines a discrete position") + (background :initarg :background + :accessor background + :documentation "the image the displayable will display on screen given coordinates and size"))) + +(defmethod x ((dya displayable)) + (car (coordinates dya))) +(defmethod y ((dya displayable)) + (cdr (coordinates dya))) +(defmethod w ((dya displayable)) + (car (size dya))) +(defmethod h ((dya displayable)) + (cdr (size dya))) +(defmethod (setf x) (value (dya displayable)) + (setf (car (coordinates dya)) value)) +(defmethod (setf y) (value (dya displayable)) + (setf (cdr (coordinates dya)) value)) +(defmethod (setf w) (value (dya displayable)) + (setf (car (size dya)) value)) +(defmethod (setf h) (value (dya displayable)) + (setf (cdr (size dya)) value)) + +(defmethod display ((object displayable) (grid t)) + (declare (ignore grid)) + (render (get-screen (background object)) + (x object) + (y object) + (w object) + (h object)) + ) diff --git a/layers/entities.lisp b/layers/entities.lisp index dae061d..ec6fe02 100644 --- a/layers/entities.lisp +++ b/layers/entities.lisp @@ -49,14 +49,18 @@ (defgeneric collidep (a b)) (defgeneric ball (v e)) -(defclass entity (screen model) +(defclass entity (displayable) ((coordinate :initarg :coordinate :accessor coordinate :documentation "the entity coordinate on screen, if null it is not displayed" :initform '(0 . 0) :type list) + (name :initarg :name + :accessor name + :documentation "the name of the entity" + :initform "noname" + :type string) (size :initarg :size - :accessor size :initform 1 :documentation "integer containing the dimension in grid of the entity") ) @@ -67,35 +71,39 @@ t nil)) -(defmethod width ((s entity)) - (size s) +(defmethod w ((obj entity)) + (size obj) ) -(defmethod height ((s entity)) - (size s) +(defmethod h ((obj entity)) + (size obj) ) -(defmethod (setf x) (value (s entity)) +(defmethod size ((obj entity)) + (let ((val (slot-value obj 'size))) + (cons val val))) + +(defmethod (setf x) (value (obj entity)) "set the x coordinate in the grid, when set on a hidden entity it will be shown" (declare (integer value)) - (let ((i (slot-value s 'coordinate))) + (let ((i (slot-value obj 'coordinate))) (unless i (setf i (cons value 0))) (setf (car i) value))) -(defmethod (setf y) (value (s entity)) +(defmethod (setf y) (value (obj entity)) "set the y coordinate in the grid, when set on a hidden entity it will be shown" (declare (integer value)) - (let ((i (slot-value s 'coordinate))) + (let ((i (slot-value obj 'coordinate))) (unless i (setf i (cons 0 value))) (setf (cdr i) value))) -(defmethod (setf width) (value (s entity)) +(defmethod (setf width) (value (obj entity)) nil ) -(defmethod (setf height) (value (s entity)) +(defmethod (setf height) (value (obj entity)) nil) (defmethod norm ((e t)) ; (e) and ((e t)) are identical, this is clearer diff --git a/layers/package.lisp b/layers/package.lisp index b631637..e79b814 100644 --- a/layers/package.lisp +++ b/layers/package.lisp @@ -16,16 +16,32 @@ (defpackage :rulp.layers (:use :cl) - (:export screen x y width height rotation path texture surface image-path + (:export screen x y w h rotation path texture surface image-path screen-source screen-destination screen-purge coordinate size model interactions interact movep usep pokep ;; temporaries + render get-screen background plane-grid + add spr + coordinates display plane collision-list entities-list span grid-dimension bounce entity ball grid-span displayp empty-screen-list)) (in-package :rulp.layers) -;; (defparameter entropy 0 -;; "parameter used for the random number generator, this variable is -;; edited every time one of the dX function is used") +(defgeneric x (obj) + (:documentation "get the first coordinate of the object")) +(defgeneric y (obj) + (:documentation "get the second coordinate of the object")) +(defgeneric w (obj) + (:documentation "get the width of the object")) +(defgeneric h (obj) + (:documentation "get the height of the dispalyable object")) +(defgeneric (setf x) (value obj) + (:documentation "set the first coordinate of the object")) +(defgeneric (setf y) (value obj) + (:documentation "set the second coordinate of the object")) +(defgeneric (setf w) (value obj) + (:documentation "set the width of the object")) +(defgeneric (setf h) (value obj) + (:documentation "set the height of the object")) diff --git a/layers/planes.lisp b/layers/planes.lisp index 6d3aa66..dc0e26b 100644 --- a/layers/planes.lisp +++ b/layers/planes.lisp @@ -29,7 +29,7 @@ when it is, nil otherwise")) (< (cdr a) (cdr b)) (< (car a) (car B)))) -(defclass plane () +(defclass plane (displayable) ((collision-list :accessor collision-list :initarg :collision-list :initform nil @@ -40,21 +40,23 @@ when it is, nil otherwise")) :initform nil :type list :documentation "the entities contained into the plane") - (width :accessor width - :initarg :width - :initform 0 - :type number - :documentation "the width of the plane, when 0 or negative it uses the texture width") - (height :accessor height - :initarg :height - :initform 0 - :type number - :documentation "the height of the plane, when 0 or negative it uses the texture height") + ;; (width :accessor width + ;; :initarg :width + ;; :initform 0 + ;; :type number + ;; :documentation "the width of the plane, when 0 or negative it uses the texture width") + ;; (height :accessor height + ;; :initarg :height + ;; :initform 0 + ;; :type number + ;; :documentation "the height of the plane, when 0 or negative it uses the texture height") (background :accessor background :initarg :background :initform "" :type string :documentation "the path for the construction, that can be a image or something else") + (grid :accessor plane-grid + :initarg :grid) (span :accessor grid-dimension :initarg :grid-dimension :documentation "the dimension of the standard grid, this will be replaced with a function" @@ -66,23 +68,25 @@ when it is, nil otherwise")) (member v (collision-list p))) ;; the name is intended to be temporary -(defmethod display ((p plane)) - (render (get-screen (background p)) 0 0 (width p) (height p))) +;; BUG: this method is (somehow) being replaced by the entity version. +(defmethod display ((p plane) (grid t)) + (declare (ignore grid)) + (render (get-screen (background p)) 0 0 (w p) (h p))) -(defmethod width ((s plane)) - (if (= (slot-value s 'width) 0) - (width (get-screen (background s))) - (slot-value s 'width))) +(defmethod w ((obj plane)) + (if (= (car (slot-value obj 'size)) 0) + (w (get-screen (background obj))) + (car (slot-value obj 'size)))) -(defmethod height ((s plane)) - (if (= (slot-value s 'height) 0) - (height (get-screen (background s))) - (slot-value s 'height))) +(defmethod h ((obj plane)) + (if (= (cdr (slot-value obj 'size)) 0) + (h (get-screen (background obj))) + (car (slot-value obj 'size)))) ;; temporary, they are used somewhere on view for the evenience the ;; plane was moved (now the plane doesn't consider coordinates) -(defmethod x ((s plane)) +(defmethod x ((obj plane)) 0) -(defmethod y ((s plane)) +(defmethod y ((obj plane)) 0) diff --git a/layers/screens.lisp b/layers/screens.lisp index cc6c5be..ba0a85c 100644 --- a/layers/screens.lisp +++ b/layers/screens.lisp @@ -19,15 +19,6 @@ ;; 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")) @@ -80,33 +71,33 @@ interact directly with this but use screen-destination instead") ;; 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)) +(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) (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)) @@ -134,11 +125,12 @@ interact directly with this but use screen-destination instead") (defmethod render ((screen screen) x y width height) (rulp.render:render-texture nil (list x y (if (<= width 0) - (width screen) + (rulp.render:texture-width (texture screen)) width) (if (<= height 0) - (height screen) - height)) + (rulp.render:texture-height (texture screen)) + height) + ) (texture screen)) ) @@ -146,7 +138,7 @@ interact directly with this but use screen-destination instead") (defmethod screen-destination ((s screen) (p t)) "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) (width s) (height s)) + (sdl2:make-rect (x s) (y s) (w s) (h s)) ) (defun screen-purge (screen) diff --git a/rulp.asd b/rulp.asd index 682262b..27dcc77 100644 --- a/rulp.asd +++ b/rulp.asd @@ -34,13 +34,19 @@ :depends-on ("parameters") :components ((:file "package") (:file "screens") + (:file "displayable") (:file "planes") (:file "models") (:file "entities"))) - (:module "graphics" + (:module "geometry" :serial t :depends-on ("parameters" "layers") :components ((:file "package") + (:file "grid"))) + (:module "graphics" + :serial t + :depends-on ("parameters" "layers" "geometry") + :components ((:file "package") (:file "text-rendering") (:file "render") (:file "menu")