--- /dev/null
+;;;; 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 <https://www.gnu.org/licenses/>.
+
+(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)
+ )))
--- /dev/null
+;;;; 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 <https://www.gnu.org/licenses/>.
+
+(defpackage :rulp.geometry
+ (:use :cl :rulp.layers)
+ (:export grid-closure squaregrid span))
(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 ()
: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)
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(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
(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))
(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
)
| -------------------------------------------
|#
-(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
)
)
"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
(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)
;; 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
(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)))
(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))
(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)))
))
--- /dev/null
+;;;; 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 <https://www.gnu.org/licenses/>.
+(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))
+ )
(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")
)
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
(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"))
(< (cdr a) (cdr b))
(< (car a) (car B))))
-(defclass plane ()
+(defclass plane (displayable)
((collision-list :accessor collision-list
:initarg :collision-list
:initform nil
: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"
(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)
;; 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"))
;; 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))
(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))
)
(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)
: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")
OSDN Git Service
