;;;; 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 :core)
+(in-package :rulp.core)
(defparameter *screen-width* 1000)
(defparameter *screen-height* 750)
(let ((mapfile (clingon:getopt cmd :rulp/map))
(initfile (clingon:getopt cmd :rulp/initfile))
(softwarep (clingon:getopt cmd :rulp/softwarep))
- (name (format nil "Ru*** roLeplay Playground v~A" parameters:+rulp-version+)))
+ (name (format nil "Ru*** roLeplay Playground v~A" rulp.parameters:+rulp-version+)))
(test-correctness-required mapfile "json")
(test-correctness-optional initfile "lisp")
(format t "rulp-~A on ~A-~A~%"
- parameters:+rulp-version+
- parameters:+rulp-system+
- parameters:+rulp-type+)
+ rulp.parameters:+rulp-version+
+ rulp.parameters:+rulp-system+
+ rulp.parameters:+rulp-type+)
(if initfile (load initfile) (load "init.lisp" :if-does-not-exist nil))
- (setf graphics:+plane+ (create-plane-from-json mapfile))
- (graphics:playground name)))
+ (multiple-value-bind (json path) (decode-from-json mapfile)
+ (setf rulp.graphics:*map-info* json)
+ (setf rulp.graphics:*map-path* path))
+ (rulp.graphics:playground name)))
(defun rulp/command ()
(clingon:make-command
:version "0.0.1"
:description "Roleplay playground"
:authors '("Giulio 'Zull' De Stasio <giuliodestasio98@gmail.com>")
- :usage "[-i INITFILE] -m MAP | COMMAND"
+ :usage "[-i INITFILE] -m map [COMMAND]"
:license "GPLv3"
:handler #'rulp/handler
:options (rulp/options)
- :examples '(("rulp -m map.json") ("rulp editor -m map.json"))
+ :examples '(("rulp -m map.json") ("rulp -m map.json editor"))
:sub-commands (rulp/sub-commands)))
(defun rulp/options ()
(test-correctness-required mapfile "json")
(test-correctness-optional initfile "lisp")
(format t "rulp-~A on ~A-~A~%"
- parameters:+rulp-version+
- parameters:+rulp-system+
- parameters:+rulp-type+)
+ rulp.parameters:+rulp-version+
+ rulp.parameters:+rulp-system+
+ rulp.parameters:+rulp-type+)
(if initfile (load initfile) (load "init.lisp" :if-does-not-exist nil))
- (setf graphics:+plane+ (create-plane-from-json mapfile))
- (graphics:playground (format nil "RULP over repl"))
+ (multiple-value-bind (json path) (decode-from-json mapfile)
+ (setf rulp.graphics:*map-info* json)
+ (setf rulp.graphics:*map-path* path))
+ ;; (setf graphics:*plane* (create-plane-from-json mapfile))
+ (sb-thread:make-thread (lambda () (rulp.graphics:playground (format nil "RULP over repl"))))
)
-(defun start () (repl-pipe "lab/test.json"))
+(defun start () (repl-pipe "lab/test2.json"))
;;;; 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 :core)
+(in-package :rulp.core)
(defun decode-from-json (json-file)
"take a json file path and decode it"
(with-open-file (json-stream json-file)
- (json:decode-json json-stream)))
+ (values (json:decode-json json-stream)
+ (make-pathname :directory (pathname-directory json-file)))))
;; this definition is hard coded, when planes will change this
;; function needs to be edited alike. Look for a better and
"take a parsed alist and create a plane on those specs"
(let* ((json-position (make-pathname :directory (pathname-directory json-file)))
(alist (decode-from-json json-file))
- (img-path (if (assoc ':image-path alist)
- (merge-pathnames json-position (cdr (assoc ':image-path alist)))
- (error "Image-path missing from \"~A\", exits~%" json-file)))
(img-path (merge-pathnames json-position (cdr (assoc ':image-path alist))))
- (ret (make-instance 'layers:plane :image img-path)))
- (when (assoc ':size alist) (setf (layers:size ret) (cdr (assoc ':size alist))))
- (when (assoc ':grid-dimension alist) (setf (layers:grid-dimension ret) (cdr (assoc ':grid-dimension alist))))
+ (ret (make-instance 'rulp.layers:screen :image img-path)))
+ ;; (when (assoc ':size alist) (setf (layers:size ret) (cdr (assoc ':size alist))))
+ ;; (when (assoc ':grid-dimension alist) (setf (graphics:-dimension ret) (cdr (assoc ':grid-dimension alist))))
ret))
+
;; posso usare le hash piuttosto che interpretarlo sul momento. Infatti creerò un metodo che
;; analizza json e lo traduce in una tabella hash e una funzione che prende la hash e crea
;; l'oggetto tramite i metodi standard.
;;;; 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 :graphics)
+(in-package :rulp.graphics)
(defparameter +grid-span+ 50)
(defparameter +is-grid-letters+ t)
(setf +is-grid-letters+ nil)
(setf +is-grid-letters+ t)))
-(defmacro grid-render (renderer plane &optional (x 0) (y 0) (w 100) (h 100))
+;; FIXME: the function doesn't consider *viewpoint-zoom*
+(defmacro grid-render (renderer &optional (x 0) (y 0) (w 100) (h 100))
"renderize a grid in where required"
`(let ((neg-x (* ,x -1))
(neg-y (* ,y -1))
- (plane-x (x ,plane))
- (plane-y (y ,plane))
- (x-iterations (/ (- ,w ,x) (grid-dimension ,plane)))
- (y-iterations (/ (- ,h ,y) (grid-dimension ,plane)))
- (grid-spacing (grid-dimension ,plane)))
+ (plane-x (x *plane*))
+ (plane-y (y *plane*))
+ (x-iterations (/ (- ,w ,x) *plane-grid*))
+ (y-iterations (/ (- ,h ,y) *plane-grid*)))
(progn
;; (sdl2:set-render-draw-color ,renderer ,red ,green ,blue 255)
- (loop :for i :from (ceiling (/ neg-x grid-spacing)) :to x-iterations
+ (loop :for i :from (ceiling (/ neg-x *plane-grid*)) :to x-iterations
:do
(sdl2:render-draw-line ,renderer
- (+ (* i grid-spacing) plane-x)
+ (+ (* i *plane-grid*) plane-x)
(+ plane-y neg-y)
- (+ (* i grid-spacing) plane-x)
+ (+ (* i *plane-grid*) plane-x)
(+ ,h plane-y neg-y))
)
- (loop :for j :from (ceiling (/ neg-y grid-spacing)) :to y-iterations
+ (loop :for j :from (ceiling (/ neg-y *plane-grid*)) :to y-iterations
:do
(sdl2:render-draw-line ,renderer
(+ plane-x neg-x)
- (+ (* j grid-spacing) plane-y)
+ (+ (* j *plane-grid*) plane-y)
(+ plane-x ,w neg-x)
- (+ (* j grid-spacing) plane-y))
+ (+ (* j *plane-grid*) plane-y))
))
(sdl2:set-render-draw-color ,renderer 0 0 0 255)
))
-(defmacro indexes-render (renderer plane &optional (x 0) (y 0) (w 0) (h 0))
+(defmacro indexes-render (renderer &optional (x 0) (y 0) (w 0) (h 0))
`(let ((neg-x (* ,x -1))
(neg-y (* ,y -1))
- (x-offset (x ,plane))
- (y-offset (y ,plane))
- (x-iterations (/ (- ,w ,x) (grid-dimension ,plane)))
- (y-iterations (/ (- ,h ,y) (grid-dimension ,plane)))
- (grid-spacing (grid-dimension ,plane)))
- (loop :for k :from (floor (/ neg-x grid-spacing)) :to x-iterations
- :do (loop :for l :from (floor (/ neg-y grid-spacing)) :to y-iterations
+ (x-offset (x *plane*))
+ (y-offset (y *plane*))
+ (x-iterations (/ (- ,w ,x) *plane-grid*))
+ (y-iterations (/ (- ,h ,y) *plane-grid*)))
+ (loop :for k :from (floor (/ neg-x *plane-grid*)) :to x-iterations
+ :do (loop :for l :from (floor (/ neg-y *plane-grid*)) :to y-iterations
:do (tr-write (coordinate-to-grid-index (cons l (+ k 1)))
- (+ x-offset (* k grid-spacing))
- (+ y-offset (* l grid-spacing))
- (floor (/ grid-spacing 3))
- (floor (/ grid-spacing 3))
+ (+ x-offset (* k *plane-grid*))
+ (+ y-offset (* l *plane-grid*))
+ (floor (/ *plane-grid* 3))
+ (floor (/ *plane-grid* 3))
,renderer)))
;; (sdl2:set-render-draw-color ,renderer 0 255 0 100) ; remember to uncomment both
;; (sdl2:render-fill-rect ,renderer (sdl2:make-rect ,x ,y ,w ,h)) ; test for x y w and h
;;;; 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 :graphics)
+(in-package :rulp.graphics)
;; this functions are changed every frame with the mouse position. This
;; is then used everywhere. This assure syncronization between two functions.
(defparameter *is-mouse-hold* nil
"this variable is modified when a button is hold down. This doesn't specifies
which button is being hold.")
-(defparameter +mode+ '+normal-mode+)
+;; (defparameter +mode+ '+normal-mode+)
-(defun mouse-actions (keybinds)
- "given an association list of keybinds it returns the associated element
-when the button is pressed"
- (loop :for button :in keybinds
- :collect (when (sdl2:mouse-state-p (eval (car button))) ; BUG: watch out for this eval
- (cdr button))))
;; NOTE: this is a frame dependent version, correction is easy when i'll have
;; time deltas.
(cons (- (car actual-point) (car previous-point))
(- (cdr actual-point) (cdr previous-point))))
-(defun panning (value delta)
+(defun panning (position previous-position viewpoint)
"destructive function. It update the value with the given delta. Both value
-and delta are coordinate cons (like '(x . y))"
- (setf (car value) (+ (car value) (car delta))
- (cdr value) (+ (cdr value) (cdr delta))))
+and delta are coordinate cons (like '(x . y)), output is garbage"
+ (let ((delta (cons (- (car position) (car previous-position))
+ (- (cdr position) (cdr previous-position)))))
+ (setf (car viewpoint) (+ (car viewpoint) (car delta))
+ (cdr viewpoint) (+ (cdr viewpoint) (cdr delta)))))
;; (defgeneric select-entry (x y p)
;; (:documentation "operate with menues, create them, destroy them and apply them"))
;; FIXME: this method can be designed non destructively. by just returning the position
;; in the list of the selected entity
-(defgeneric select-pointer (coordinate p))
-
-(defmethod select-pointer (coordinate (p plane))
- "with left button it select and deselect entities the map-gplane contain"
- (let ((mouse-point (sdl2:make-rect (car coordinate) (cdr coordinate) 10 10))
- (entities (entities-list p)))
+(defun select-pointer (coordinates previous viewpoint)
+ "given coordinates and a list of entities return the position in the list of the selected
+entity or nil if noone is selected"
+ (declare (ignore previous viewpoint)) ; mouse-previous is not used in this function
+ (let ((mouse-point (sdl2:make-rect (floor (/ (- (car coordinates) (car *viewpoint-offset*)) *viewpoint-zoom*))
+ (floor (/ (- (cdr coordinates) (cdr *viewpoint-offset*)) *viewpoint-zoom*)) 10 10)))
(setf *pointer* nil)
- (loop :for obj :in entities
- :for obj-nth :from 0 :to (length entities)
+ (loop :for obj :in *entities-list*
+ :for obj-nth :from 0 :to (length *entities-list*)
:do
- (when (sdl2:has-intersect mouse-point
- (screen-destination obj p))
- (setf *pointer* obj-nth)))
+ (multiple-value-bind (c s) (grid-layout (x obj) (y obj) :size (size obj))
+ (when (sdl2:has-intersect mouse-point
+ (arrange-rect (car c) (cdr c) s s))
+ (setf *pointer* obj-nth))))
))
-(defgeneric move-entity (coordinate p))
-
-(defmethod move-entity (coordinate (p plane))
+(defun move-entity (coordinates previous viewpoint)
"with right button it move the entity around the plane"
+ (declare (ignore previous viewpoint))
(when (numberp *pointer*)
- (let* ((x-offset (x p))
- (y-offset (y p))
- (i-x (floor (/ (- (car coordinate) x-offset) (grid-dimension p))))
- (i-y (floor (/ (- (cdr coordinate) y-offset) (grid-dimension p))))
- (object (nth *pointer* (entities-list p))))
- (setf (coordinate object) (cons i-x i-y))
+ (let* ((x-offset (floor (/ (+ (x *plane*) (car *viewpoint-offset*)) *viewpoint-zoom*)))
+ (y-offset (floor (/ (+ (y *plane*) (cdr *viewpoint-offset*)) *viewpoint-zoom*)))
+ (i-x (floor (/ (- (car coordinates) x-offset) *plane-grid*)))
+ (i-y (floor (/ (- (cdr coordinates) y-offset) *plane-grid*)))
+ (object (nth *pointer* *entities-list*)))
+ ;; (setf (coordinate object) (cons i-x i-y))
+ (setf (coordinate (nth *pointer* *entities-list*)) (cons i-x i-y))
;; (setf (x object) i-x)
;; (setf (y object) i-y)
)))
+
+(defun summon-entry (coordinates contents &key (title ""))
+ (make-instance 'entry :title title
+ :coordinate coordinates
+ :contents contents
+ ))
+
+
+(defun mouse-actions (keybinds)
+ "given an association list of keybinds it returns the associated element
+when the button is pressed"
+ (loop :for button :in keybinds
+ :collect (when (sdl2:mouse-state-p (eval (car button))) ; NOTE: watch out for this eval
+ (cdr button))))
+
+
+(defconstant +mouse-button-left+ 1 "this binds the left button")
+(defconstant +mouse-button-right+ 3 "this binds the right button")
+(defconstant +mouse-button-middle+ 2 "this binds the scroll button")
+
+;; FIXME: replace with apply system and fixed arguments *mouse-position*, *mouse-previous-position* *viewpoint-offset*
+;; (defparameter *mouse-keybinds* (list
+;; '(+mouse-button-left+ nil (select-pointer *mouse-position* *entities-list*))
+;; '(+mouse-button-middle+ (panning *viewpoint-offset* (velocity *mouse-position* *mouse-previous-position*)) nil)
+;; '(+mouse-button-right+ nil (move-entity *mouse-position*))
+;; ;; '(+mouse-button-right+ nil (push (summon-entry *mouse-position* '(1)) *active-entries*))
+;; )
+;; "This is the mouse-keybinds association list. The first value is the button, the second
+;; is the action executed on hold and the third is the action executed on release (if any)")
+
+;; mouse-keybinds (+button pressed+ drag-event click-event )
+(defparameter *mouse-keybinds* (list
+ '(+mouse-button-left+ nil select-pointer )
+ '(+mouse-button-middle+ panning nil )
+ '(+mouse-button-right+ nil move-entity )
+ ;; '(+mouse-button-right+ nil (push (summon-entry *mouse-position* '(1)) *active-entries*))
+ )
+ "This is the mouse-keybinds association list. The first value is the button, the second
+is the action executed on hold and the third is the action executed on release (if any)")
+
+(defun mouse-event (coordinates &key (dragp nil))
+ "this function is called when the mouse is pressed, it takes the mouse
+coordinates and execute the necessary actions. This function depends on
+rulp.entries:*entries-list*"
+ (flet ((action (x) (if dragp
+ (cadr x)
+ (caddr x))))
+ (if rulp.entries:*entries-list*
+ (unless (rulp.entries:click-event
+ (first rulp.entries:*entries-list*)
+ *mouse-position*)
+ (pop rulp.entries:*entries-list*))
+ (loop :for button :in *mouse-keybinds*
+ :do (when (and (action button) (sdl2:mouse-state-p (eval (car button))))
+ (apply (action button) (list coordinates
+ *mouse-previous-position*
+ *viewpoint-offset*)))
+ ))))
;;;; 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 :graphics)
+(defpackage :rulp.entries
+ (:use :cl)
+ (:export *entries-list* push pop entry x y width height rectangle click-event
+ render-entry make-plist))
-(defgeneric entry-width (y))
-(defgeneric entry-height (y))
-(defgeneric entry-rectangle (y))
+(in-package :rulp.entries)
+
+(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 ()
- ((coordinate :accessor coordinate
- :initarg :coordinate
- :initform '(0 . 0)
- :documentation "the starting position of the entry generation"
- :type list)
+ ((coordinates :accessor coordinates
+ :initarg :coordinates
+ :initform '(0 . 0)
+ :documentation "the starting position of the entry generation"
+ :type list)
(title :accessor title
:initarg :title
- :initform ""
+ :initform "custom"
:documentation "title for the entry")
- (text-size :accessor text-size
- :initarg :text-size
- :initform 30
- :type number
- :documentation "the font size in the entry")
+ (margin :accessor margin
+ :initarg :margin
+ :initform 5
+ :type number
+ :documentation "the margin between the content and the borders of the rectangle")
+ (padding :accessor padding
+ :initarg :padding
+ :initform 0
+ :type number
+ :documentation "the padding between the coordinates and the borders")
+ (action :accessor action
+ :initarg :action
+ :initform nil
+ :documentation "action when pressed")
(contents :accessor contents
- :initarg :contents
- :initform nil
- :type list
- :documentation "alist containing entry name and related action")))
+ :initarg :contents
+ :initform nil
+ :type list
+ :documentation "a list of other entries")
+ (text-size :accessor size
+ :initarg :size
+ :initform 20
+ :type number)
+ (content-orientation :accessor orientation
+ :initarg :orientation
+ :initform :v
+ :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 y ((entry entry))
+ (cdr (coordinates entry)))
+
+;; (defmethod width ((entry entry))
+;; 200)
+
+;; (defmethod height ((entry entry))
+;; 200)
+
+(defun width-vertical (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (setf i (max i (length (getf element :title)))) ; FIXME: add padding
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
+
+(defun width-horizontal (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (incf i (length (getf element :title)))
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
+
+(defun height-vertical (plist)
+ (let* ((i 0))
+ (labels ((operation (element)
+ (1+ i)
+ (loop :for x :in (getf element :contents)
+ :do (operation x))
+ ))
+ (operation plist))
+ i
+ ))
-(defmethod entry-width ((y entry))
- "give the length of the longest menu entry, useful for creating a box containing them all"
- (reduce #'max (loop :for content :in (contents y)
- :collect (length (car content)))))
+(defun height-horizontal (plist) 1)
-(defmethod entry-height ((y entry))
- "give the number of entries, useful for creating a box containing them all"
- (length (contents y)))
+;; (defmethod width ((entry entry))
+;; "give the length of the longest menu entry, useful for creating a box containing them all"
+;; (reduce #'max (loop :for content :in (contents entry))))
-(defmethod entry-rectangle ((y entry))
+;; (defmethod height ((entry entry))
+;; "give the number of entries, useful for creating a box containing them all"
+;; (length (contents entry)))
+
+(defmethod rectangle ((entry entry))
(flet ((on-size (a) (* a (text-size y))))
- (sdl2:make-rect (car (coordinate y))
- (cdr (coordinate y))
+ (sdl2:make-rect (x entry)
+ (y entry)
(on-size (entry-width y))
- (on-size (entry-height y)))))
+ )))
+
+;; NOTE: this method makes the entry class totally useless. It is possible
+;; to replace entries with these plists and use them directly with the macro
+(defmethod make-plist ((entry entry))
+ (list ':entry 'entry
+ ':title (title entry)
+ ':coordinates (coordinates entry)
+ ':padding (padding entry)
+ ':margin (margin entry)
+ ':text-size (size entry)
+ ':action (action entry)
+ ':contents (contents entry)
+ ':orientation (orientation entry))
+ )
+;; NOTE: The idea of replacing the whole class idea with the plist system makes
+;; room for special functions that can create rectangles out of the correct size,
+;; can adjust the text and aid the macro in the rendering process.
+
+(defun n-letter-content (pair)
+ "given a list of two elements, one a string and the other a generic symbol, it returns the
+length of the string. This is used in display-entry, where it is used to find
+the maximum size of a list of options to make the correct dimension for the entry"
+ (length (car pair)))
+
+(defun keep-inside (position size limit)
+ (if (> position (- limit size))
+ (- position size)
+ position
+ ))
+
+(defmacro render-entry (renderer plist)
+ `(let* ((entry-margin (if (numberp (getf ,plist :margin)) (getf ,plist :margin) 0))
+ (entry-padding (if (numberp (getf ,plist :padding)) (getf ,plist :padding) 0))
+ (entry-size (getf ,plist :text-size)) ; NOTE: make error checking instead of redefinition
+ (entry-x (+ entry-margin (car (getf ,plist :coordinates))))
+ (entry-y (+ entry-margin (cdr (getf ,plist :coordinates))))
+ (entry-w (if (eq (getf ,plist :orientation) 'v)
+ (width-vertical ,plist)
+ (width-horizontal ,plist)))
+ (entry-h (if (eq (getf ,plist :orientation) 'v)
+ (height-vertical ,plist)
+ (height-horizontal ,plist))))
+ (setf entry-x (keep-inside entry-x entry-w rulp.graphics:*window-width*))
+ (setf entry-y (keep-inside entry-y entry-h rulp.graphics:*window-height*)) ; BUG: doesn't seems to work
+ ;; (when (> entry-x (- rulp.graphics:*window-width* entry-w))
+ ;; (setf entry-x (- entry-x entry-w)))
+ ;; (when (> entry-y (- rulp.graphics:*window-height* entry-h))
+ ;; (setf entry-y (- entry-y entry-h)))
+ (sdl2:set-render-draw-color ,renderer 255 255 255 255)
+ (sdl2:render-fill-rect ,renderer (rulp.graphics:arrange-rect
+ entry-x
+ entry-y
+ (+ (* 2 entry-padding) (* entry-w entry-size))
+ (+ (* 2 entry-padding) (* entry-h entry-size)))) ; FIXME: fixed size font
+ ;; NOTE: temporary solution, to be extended with the content-rendering
+ ;; function into a rendering engine for nested schemas
+ (sdl2:set-render-draw-color ,renderer 0 0 0 255)
+ (rulp.graphics:tr-write (getf ,plist :title)
+ (+ entry-x entry-padding)
+ (+ entry-y entry-padding)
+ entry-size
+ entry-size
+ ,renderer)
+ ;; FIXME: continue with contents
+ ))
+
+(defmacro display-entry (renderer entry)
+ "macro for creating the actual menu given the renderer and the entry"
+ `(let* ((entry-x (+ (car (coordinate ,entry)) (padding ,entry)))
+ (entry-y (+ (cdr (coordinate ,entry)) (padding ,entry)))
+ (maximum-letters (apply #'max (cons (length (title ,entry)) (mapcar #'n-letter-content (contents ,entry)))))
+ (number-of-elements (1+ (length (contents ,entry))))
+ (entry-h (+ (* number-of-elements (text-size ,entry)) (* 2 (margin ,entry))))
+ (entry-w (+ (* maximum-letters (text-size ,entry)) (* (margin ,entry))))
+ )
+ (when (> entry-x (- *window-width* entry-w))
+ (setf entry-x (- entry-x entry-w)))
+ (when (> entry-y (- *window-height* entry-h))
+ (setf entry-y (- entry-y entry-h)))
+ (sdl2:set-render-draw-color ,renderer 255 255 255 255)
+ (sdl2:render-fill-rect ,renderer (arrange-rect entry-x entry-y entry-w entry-h))
+ (tr-write (title ,entry)
+ (+ entry-x (margin ,entry))
+ (+ entry-y (margin ,entry))
+ (text-size ,entry)
+ (text-size ,entry)
+ ,renderer
+ )
+ ;; FIXME: to complete with the actual menu
+ )
+ )
+
+(defun select-entry (renderer entry)
+ "given the renderer and an entry, returns the option pressed or return nil if
+nothing was pressed"
+ nil)
+
+(defgeneric click-event (entry coordinates)
+ (:documentation "this function is activated when the
+mouse/cursor is pressed with a entry active. From here the method can execute
+command and destroy itself by returning nil. The destruction has to be handled
+by whatever call the entry event"))
+
+;; NOTE: test if the mouse-state-p is enought, to get to this method is a long
+;; run and it could be that mouse-state-p has changed from when was triggered
+(defmethod click-event ((entry entry) coordinates)
+ "event for mouse/cursor action. This function applies events on an element of a
+list"
+ 'destroy
+ )
;;;; 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 :graphics
- (:use :cl :layers)
+(defpackage :rulp.graphics
+ (:use :cl :rulp.layers)
(:export
- playground +plane+
+ playground +plane+ *plane* *plane-grid* *map-info* *map-path* *entities-list*
+ arrange-rect *window-width* *window-height* tr-write
))
+;; NOTE: remove +plane+, there is no other occurrence of the parameter on the code
-(in-package :graphics)
+(in-package :rulp.graphics)
-(defparameter +plane+ nil
- "the rendered plane, this variable contain the plane which is gonna be presented
-into the main window")
+;; these variables contain information for the plane and grid systems. The default
+;; grid is a square grid but by changing the grid-layout function it is possible
+;; to modify it
+(defparameter *plane* nil
+ "the plane containing the graphics to be desplayed on the background. This is a
+basic layout:screen")
+
+(defparameter *plane-grid* 10
+ "the grid for the plane. By default the grid is square and this value contain the
+pixels between lines")
+
+(defparameter *entities-list* nil
+ "the list of the entities to be displayed on the plane. these entities are global and
+by default not connected to the *plane* choice. To change planes and entities use the proper
+functions")
(defparameter *renderer* nil
"a variable containing the tool to render textures to screen, this is associated
(defparameter *pointer* nil
"this is a numeric value whose refer to the selected entity in the plane, it is
used combined with input to apply the actions and with view to display a 1x1 over
-grid square of the entity"
- )
+grid square of the entity")
;; tr stands for text-rendering
(defparameter *tr-string* "abcdefghijklmnopqrstuvwxyz 0123456789-"
"This string is used to generate a texture with the alphabet, the software
in the text.lisp file will 'write' on the screen selecting squares and using
-this string again to parse a string variable into coordinate in the texture"
- )
+this string again to parse a string variable into coordinate in the texture")
(defparameter *alphabet* "abcdefghijklmnopqrstuvwxyz-"
"this is used to generate the grid, when the coordinates run out of letters
-they restart from the beginning"
- )
+they restart from the beginning")
(defparameter *tr-texture* nil
"this contains the texture of the characters from *tr-string*. This
(defconstant +mouse-button-right+ 3 "this binds the right button")
(defconstant +mouse-button-middle+ 2 "this binds the scroll button")
+;; FIXME: replace with apply system and fixed arguments *mouse-position*, *mouse-previous-position* *viewpoint-offset*
(defparameter *mouse-keybinds* (list
- '(+mouse-button-left+ nil (select-pointer *mouse-position* +plane+))
- '(+mouse-button-middle+ (panning (coordinate +plane+) (velocity *mouse-position* *mouse-previous-position*)))
- '(+mouse-button-right+ nil (move-entity *mouse-position* +plane+))
+ '(+mouse-button-left+ nil (select-pointer *mouse-position* *entities-list*))
+ '(+mouse-button-middle+ (panning *viewpoint-offset* (velocity *mouse-position* *mouse-previous-position*)) nil)
+ '(+mouse-button-right+ nil (move-entity *mouse-position*))
+ ;; '(+mouse-button-right+ nil (push (summon-entry *mouse-position* '(1)) *active-entries*))
)
"This is the mouse-keybinds association list. The first value is the button, the second
-is the action executed on hold and the third is the action executed on release (if any)"
- )
+is the action executed on hold and the third is the action executed on release (if any)")
(defparameter *is-grid* t
"Parameter for displaying the grid, when nil it does not display a grid, when t
-it display a grid as defined by the +plane+")
+it display a grid as defined by the *plane-grid*")
(defparameter *is-indexes* t
"Parameter for displaying the indexes, when nil it does not display them, when t
it uses the grid to create a chessboard like indexes")
-(defparameter *entries-list* nil
- "List of entries, menues who are generated into the window with options")
-
(defparameter *window-width* 1001)
(defparameter *window-height* 750)
+
+;; NOTE: probably they need to be moved below in layers, for now they can stay here
+(defparameter *map-info* nil
+ "when the json informations are read, the content is dumped into this parameter and then
+used on uninitialized data to bootstrap the data")
+
+(defparameter *map-path* nil
+ "this is the path where the json file lived")
;;;; 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 :graphics)
+(in-package :rulp.graphics)
(defgeneric texture (s))
(defgeneric surface (s))
+(defparameter courtesy-rectangle (sdl2:make-rect 0 0 10 10)
+ "creating and destroying rectangles waste resources and leaving them in ram is even worse. Do not use this
+rectangle directly, but use the arrange-rect")
+
+(defun arrange-rect (x y w h)
+ (progn
+ (setf (sdl2:rect-x courtesy-rectangle) x)
+ (setf (sdl2:rect-y courtesy-rectangle) y)
+ (setf (sdl2:rect-width courtesy-rectangle) w)
+ (setf (sdl2:rect-height courtesy-rectangle) h)
+ courtesy-rectangle)
+ )
+
(defmethod texture ((s screen))
"returns the screen texture, useful for accelerated enviroinments"
(unless (slot-value s 'texture)
- (setf (slot-value s 'texture) (sdl2:create-texture-from-surface *renderer* (surface s))))
+ (setf (slot-value s 'texture) (sdl2:create-texture-from-surface *renderer* (surface s)))
+ (sdl2:free-surface (slot-value s 'surface))
+ (setf (slot-value s 'surface) nil))
(slot-value s 'texture))
(defmethod surface ((s screen))
(screen-destination entity plane))
entity))))
-;; NOTE: this doesn't directly uses +plane+ so it can be easily generalized
-(defmacro render-plane-and-contents (renderer plane)
- "given a PLANE it renders globally the plane images and entities. With
-globally it means that this plane is rendered full on whatever texture is used.
-to render locally use sdl2:set-render-target before calling this macro."
- `(when ,plane
- (sdl2:render-copy ,renderer (texture ,plane)
- :source-rect (screen-source ,plane)
- :dest-rect (screen-destination ,plane t))
- (loop :for entity :in (entities-list ,plane)
- :do (when (displayp entity)
- (sdl2:render-copy ,renderer (texture entity)
- :source-rect (screen-source entity)
- :dest-rect (screen-destination entity ,plane))
- ))))
-
-;; NOTE: test if it is necessary to create render-plane-without-contents
+(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
+ (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
+ )
+ )
+ )
;;;; 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 :graphics)
+(in-package :rulp.graphics)
+
+(defparameter *tr-s-rectangle* (sdl2:make-rect 0 0 60 130)) ; FIXME: hardcoded,
+ ; defparameter over
+ ; font for
+ ; generalization
+(defparameter *tr-d-rectangle* (sdl2:make-rect 0 0 10 10))
(defun coordinate-to-grid-index (value)
"translate a coordinate into the chess coordinate as a string"
`(let ((value-indexes (tr-parse-string ,value)))
(loop :for character :in value-indexes
:for character-position :from 0 :to (length value-indexes)
- :do (let ((source-rectangle (sdl2:make-rect (* character 60) 0 60 130))
- (destination-rectangle (sdl2:make-rect (+ ,x (* character-position ,width)) ,y ,width ,height)))
- (sdl2:render-copy ,renderer *tr-texture*
- :source-rect source-rectangle
- :dest-rect destination-rectangle)
- (sdl2:free-rect source-rectangle)
- (sdl2:free-rect destination-rectangle)))))
+ :do (setf (sdl2:rect-x *tr-s-rectangle*) (* character 60)
+ (sdl2:rect-x *tr-d-rectangle*) (+ ,x (* character-position ,width))
+ (sdl2:rect-y *tr-d-rectangle*) ,y
+ (sdl2:rect-width *tr-d-rectangle*) ,width
+ (sdl2:rect-height *tr-d-rectangle*) ,height)
+ (sdl2:render-copy ,renderer *tr-texture*
+ :source-rect *tr-s-rectangle*
+ :dest-rect *tr-d-rectangle*))))
;;;; 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 :graphics)
+(in-package :rulp.graphics)
#| -------------------------------------------
| This file manipulate the window and the
| sdl initialization.
| -------------------------------------------
|#
+(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:screen
+ :image (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)))
+ :name (assoc :name entity-info)
+ )
+ )
+ )
+ )
+
+(defun grid-layout (x y &key (size 1))
+ "converts natural coordinates and size into pixel positions. This function can be replaced to change
+the actual grid layout"
+ (values (cons (* x *plane-grid*)
+ (* y *plane-grid*))
+ (* size *plane-grid*)))
+
+(defun actors-layout (x y)
+ (cons (floor (/ x *plane-grid*))
+ (floor (/ y *plane-grid*)))
+ )
+
(defmacro with-playground ((window renderer &key (title "RuLP")) &body body)
`(sdl2:with-window (,window :title title :w *window-width* :h *window-height* :flags '(:resizable))
;; NOTE: here is where you should set the window icon, if there's the method to do that
)))
;; FIXME: temporary place
+;; set boundaries so the plane doesn't go away with the panning. fix boundaries to -window width, -window height, plane width, plane height
(defparameter *viewpoint-offset* '(0 . 0))
(defparameter *viewpoint-zoom* 1)
(defparameter *mouse-previous* '(0 . 0))
+(defparameter *framerule* 20
+ "every 20 frames the parameter *changep* is set to t, so it updates informations
+even when away from keyboard")
+
+(defparameter *active-entries* nil
+ "contain the active menu in form of a entry class")
+
+(defparameter *changep* t
+ "set to t when a change on the plane is made, if nil the viewpoint is not updated")
+
;; renderer exists only inside this function, so you cannot create a texture outside
;; (at least for now), more on this later os
(defun playground (title &optional (fps 60) (debug-info nil))
(font-texture (sdl2:create-texture-from-surface *renderer* font-surface)))
(sdl2:free-surface font-surface)
font-texture))
- ;; NOTE: all those variables are binded to +plane+. This should be updated whenever +plane+ is
- ;; no longer the default plane
- (let ((mouse-button-previous nil)
+ (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*))
+ (let (;; (mouse-button-previous nil)
(window-texture (sdl2:get-render-target *renderer*))
(viewpoint-texture (sdl2:create-texture *renderer* (sdl2:get-window-pixel-format window)
- 2 (width +plane+) (height +plane+))))
+ 2 (width *plane*) (height *plane*))) ;camping into the ramhog
+ (viewpoint-rectangle (sdl2:make-rect 0 0 10 10)))
(sdl2:with-event-loop (:method :poll)
(:quit () t)
(:keydown ()
)
(:mousebuttondown ()
(setf *is-mouse-hold* t)
+ ;; this routine seems identical to the one in idle, instead
+ ;; 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*)
)
(:mousebuttonup ()
- ;; this routine seems identical to the one in idle, instead
- ;; 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.
- (setf *is-mouse-hold* nil)
- (loop :for action :in mouse-button-previous
- :do (when (cdr action) (eval (cadr action))))
- (setf mouse-button-previous nil)
;; what about functions that require a single press? just create
;; a keybind (+key+ nil (...)) and it will execute just on
;; release and not on hold
+ ;; (setf mouse-button-previous nil)
+ (setf *changep* t)
+ (setf *is-mouse-hold* nil)
)
(:windowevent ()
;; bug prevention method. SDL2 can look the :mousebuttonup event
(:multigesture ()
;; same as for windowevent
(setf *is-mouse-hold* nil))
+ ;; NOTE: When the user prefear to use only the keyboard or joystick
+ ;; the *cursor-position* is set default, this is set when a key or
+ ;; koystick button is pressed, then menues and actions are chosed with
+ ;; the cursor position. When a mouse motion is detected the
+ ;; mouse-position is set default. the cursor follows the grid on each
+ ;; step and it is an alternative to the mouse movement to do
+ ;; everything.
(:idle ()
(setf *mouse-previous-position* *mouse-position*)
(multiple-value-bind (x y) (sdl2:mouse-state)
(setf *mouse-position* (cons x y)))
;; mouse-holding-event
+ ;; (unless *active-entries*
+ ;; (when *is-mouse-hold*
+ ;; (loop :for action :in (mouse-actions *mouse-keybinds*)
+ ;; :do (when action (eval (car action))) ; FIXME: replace eval with a more safer DSL eval
+ ;; )
+ ;; ;; (setf mouse-button-previous (mouse-actions *mouse-keybinds*))
+ ;; ))
(when *is-mouse-hold*
- (loop :for action :in (mouse-actions *mouse-keybinds*)
- :do (when action (eval (car action))) ; FIXME: replace eval with a more safer DSL eval
- )
- (setf mouse-button-previous (mouse-actions *mouse-keybinds*))
- )
+ (mouse-event *mouse-position* :dragp t))
;; trick to avoid functions to change the global draw-color
(sdl2:set-render-draw-color *renderer* 0 0 0 255)
- ;; clear view
- (sdl2:render-clear *renderer*)
;; local viewpoint
;; NOTE: generalize
- (sdl2:set-render-target *renderer* viewpoint-texture)
- (sdl2:render-clear *renderer*)
- (render-plane-and-contents *renderer* +plane+)
- (when *is-grid*
- (grid-render *renderer* +plane+ (car *viewpoint-offset*) (cdr *viewpoint-offset*)
- (floor (* (width +plane+) *viewpoint-zoom*))
- (floor (* (height +plane+) *viewpoint-zoom*))))
- (when *is-indexes*
- (indexes-render *renderer* +plane+ (car *viewpoint-offset*) (cdr *viewpoint-offset*)
- (floor (* (width +plane+) *viewpoint-zoom*))
- (floor (* (height +plane+) *viewpoint-zoom*))))
- (sdl2:set-render-draw-color *renderer* 0 255 0 155)
- (sdl2:set-render-draw-color *renderer* 0 0 0 255)
+ (when *changep*
+ (sdl2:destroy-texture viewpoint-texture)
+ (setf viewpoint-texture (sdl2:create-texture *renderer*
+ (sdl2:get-window-pixel-format window)
+ 2
+ (width *plane*)
+ (height *plane*)))
+ (sdl2:set-render-target *renderer* viewpoint-texture)
+ (sdl2:render-clear *renderer*)
+ (render-plane-and-entities *renderer*)
+ (when *is-grid*
+ (grid-render *renderer* 0 0 (width *plane*) (height *plane*))
+ )
+ (when *is-indexes*
+ (indexes-render *renderer* 0 0 (width *plane*) (height *plane*)))
+ (sdl2:set-render-draw-color *renderer* 0 0 0 255)
+ (setf *changep* nil)
+ ;; pointer section
+ (when *pointer* ;; NOTE: to test this out
+ (sdl2:set-render-draw-color *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*)))
+ (let ((select-rectangle (sdl2:make-rect (car coordinates) (cdr coordinates) size size)))
+ (sdl2:render-draw-rect *renderer* select-rectangle)
+ (sdl2:free-rect select-rectangle)))
+ (sdl2:set-render-draw-color *renderer* 0 0 0 255)
+ ))
+
+
+
+ ;; display viewpoint on window
(sdl2:set-render-target *renderer* window-texture)
- (let ((viewpoint-rectangle (sdl2:make-rect (car *viewpoint-offset*)
- (cdr *viewpoint-offset*)
- (floor (* (width +plane+) *viewpoint-zoom*)) ; NOTE: hardcoded +plane+ usage
- (floor (* (height +plane+) *viewpoint-zoom*)))))
- (sdl2:render-copy *renderer* viewpoint-texture
- :source-rect nil
- :dest-rect viewpoint-rectangle)
- (sdl2:free-rect viewpoint-rectangle))
-
- ;; pointer section
- (when *pointer*
- (sdl2:set-render-draw-color *renderer* 128 250 33 255)
- (let ((select-rectangle (screen-destination (nth *pointer* (entities-list +plane+)) +plane+)))
- (sdl2:render-draw-rect *renderer* select-rectangle)
- (sdl2:free-rect select-rectangle))
- )
- ;; entries generation
- ;; (loop :for entry :in (reverse *entries-list*)
- ;; :do (sdl2:set-render-draw-color *renderer* 255 255 255 255)
- ;; (sdl2:render-fill-rect *renderer* (entry-rectangle entry))
- ;; (sdl2:set-render-draw-color *renderer* 0 0 0 255)
- ;; (loop :for content :in (contents entry)
- ;; :for content-position :from 0 :to (length (contents entry))
- ;; :do (tr-write (car content)
- ;; (car (coordinate entry))
- ;; (+ (* content-position (text-size entry)) (cdr (coordinate entry)))
- ;; (text-size entry) (text-size entry) *renderer*
- ;; ))
- ;; )
+ (sdl2:render-clear *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*)))
+ (sdl2:render-copy *renderer* viewpoint-texture
+ :source-rect nil
+ :dest-rect viewpoint-rectangle)
+
+ ;; entries visualization
+ (loop :for entry :in rulp.entries:*entries-list*
+ :do (rulp.entries:render-entry
+ *renderer*
+ (rulp.entries:make-plist entry)))
+ ;; (loop :for entry :in *active-entries*
+ ;; :do (display-entry *renderer* entry))
+
;; debug infos
(when debug-info
(tr-write (format nil "~A" debug-info) 0 0 10 15 *renderer*))
;; FIXME: i hate this, find a better way to dinamically change the window dimension
(multiple-value-bind (new-width new-height) (sdl2:get-window-size window)
(setf *window-width* new-width)
- (setf *window-height* new-height)))))))
+ (setf *window-height* new-height))
+ (1- *framerule*)
+ (when (< *framerule* 1)
+ (setf *changep* t)
+ (setf *framerule* 20))))
+ (setf *changep* t) ; useful in the repl where parameters are not reset
+ )))
)
;; polarity direction and it is not possible to check if someone is watching in what
;; direction.
;;
-(in-package :layers)
+(in-package :rulp.layers)
(defun abs- (a b)
"This is a rapid function used for the norm, it can be disappear or be modified in future commits"
(setf i (cons 0 value)))
(setf (cdr i) value)))
-(defmethod norm ((e t)) ; (e) and ((e t)) are identical, this is clearer
+(defmethod (setf width) (value (s entity))
+ nil
+ )
+
+(defmethod (setf height) (value (s entity))
+ nil)
+
+(defmethod norm ((e t)) ; (e) and ((e t)) are identical, this is clearer
"classical norm, it works with everything but classes"
(let ((xe (car e))
(ye (cdr e)))
-(in-package :layers)
+(in-package :rulp.layers)
(defgeneric interact (e p)
(:documentation "check what actions entities can do and return an alist with a lambda
;;;; 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)
(defgeneric create-entity (m))
;;;; 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 :layers
+(defpackage :rulp.layers
(:use :cl)
(:export screen x y width height rotation path texture surface image-path
- screen-source screen-destination coordinate size
+ screen-source screen-destination screen-purge coordinate size
model interactions interact
movep usep pokep ;; temporaries
plane collision-list entities-list span grid-dimension bounce
entity ball grid-span displayp))
-(in-package :layers)
+(in-package :rulp.layers)
;; (defparameter entropy 0
;; "parameter used for the random number generator, this variable is
;;;; 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)
(defgeneric bounce (v p)
(:documentation "Given a point v and a plane p this generic check if
(member v (collision-list p)))
;; doesn't care about the function used
-(defmethod screen-destination ((s screen) (p plane))
- (let ((x (x s))
- (y (y s))
- (w (width s))
- (h (height s))
- (x-offset (x p))
- (y-offset (y p))
- (span (grid-dimension p)))
- (sdl2:make-rect (+ (* x span) x-offset)
- (+ (* y span) y-offset)
- (* w span)
- (* h span))))
+;; (defmethod screen-destination ((s screen) (p plane))
+;; (let ((x (x s))
+;; (y (y s))
+;; (w (width s))
+;; (h (height s))
+;; (x-offset (x p))
+;; (y-offset (y p))
+;; (span (grid-dimension p)))
+;; (sdl2:make-rect (+ (* x span) x-offset)
+;; (+ (* y span) y-offset)
+;; (* w span)
+;; (* h span))))
;; (defmethod width ((s plane))
;; (if (original-dimension s)
;;;; 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.
:accessor surface)
(path :accessor 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")
(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)
- (setf (surface s) (sdl2-image:load-image (slot-value s 'path))))
+ (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))))
(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
(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))))
-(defpackage :core
+(defpackage :rulp.core
(:use :cl :json)
(:export main))
;;;; 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 parameters
+(defpackage :rulp.parameters
(:use :cl)
(:export +rulp-version+ +rulp-type+ +rulp-system+ *rulp-share* *rulp-local*))
-(in-package :parameters)
+(in-package :rulp.parameters)
;; by standard parameters surrounded by asterisks (*) are seen as
;;;; 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 :script
- (:use :cl :graphics :layers))
+(defpackage :rulp.script
+ (:use :cl :rulp.graphics :rulp.layers))
-(in-package :script)
+(in-package :rulp.script)
(defun active-plane ()
- graphics:+plane+)
+ *plane*)
(defun (setf active-plane) (value)
- (setf graphics:+plane+ value))
+ (setf *plane* value))
(defun entities ()
- (entities-list graphics:+plane+))
+ *entities-list*)
(defun (setf entities) (value)
(if (listp value)
- (setf (entities-list graphics:+plane+) value)
- (error "(setf entities) error: given symbol is not a list")))
+ (setf *entities-list* value)
+ (warn "(setf entities) error: symbol ~A is not of type list, operation stopped" value)))
(defun add-entity (entity)
"add an entity into the active plane"
- (push entity graphics:+plane+))
+ (push entity *entities-list*))
(defun remove-entity (number)
"remove the nth entity from the active plane"
- (screen-purge (nth number (entities-list graphics:+plane+)))
- (setf (nth number (entities-list graphics:+plane+)) nil)
- (remove nil (entities-list graphics:+plane+)))
-
-(defparameter *plane-list* nil)
-
-(defun new-plane (image)
- "create a new plane and add it to the plane list"
- (let ((gen-plane (make-instance 'plane :image image)))
- (push gen-plane *plane-list*)
- gen-plane))
-
-(defun remove-plane (number)
- "remove the nth plane from the plane list"
- (screen-purge (nth number *plane-list*))
- (setf (nth number *plane-list*) nil)
- (setf *plane-list* (remove nil *plane-list*)))
-
-(defun list-planes ()
- "list the content in the plane list"
- *plane-list*)
+ (screen-purge (nth number *entities-list*))
+ (setf (nth number *entities-list*) nil)
+ (remove nil *entities-list*))
OSDN Git Service
