;;;; 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.
| -------------------------------------------
|#
+;; 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)))
+ :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
+ )
+ )
+
+(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
(sdl2:with-renderer (,renderer ,window :index -1 :flags '(:accelerated :presentvsync)) ;later add delta
(sdl2-image:init '(:png :jpg))
(sdl2-ttf:init)
)))
;; 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
"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 *renderer* :title title)
- (setf *tr-texture* (let* ((font (sdl2-ttf:open-font "media/IBMPlex.ttf" 100)) ;; FIXME: this line throw fault, works anyway
- (font-surface (sdl2-ttf:render-text-solid font *tr-string* 0 0 0 0))
- (font-texture (sdl2:create-texture-from-surface *renderer* font-surface)))
+ (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-surface (sdl2-ttf:render-utf8-solid font *tr-string* 0 0 0 0))
+ (font-texture (sdl2:create-texture-from-surface rulp.render:*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 ((window-texture (sdl2:get-render-target *renderer*))
- (viewpoint-texture (sdl2:create-texture *renderer* (sdl2:get-window-pixel-format window)
- 2 (width +plane+) (height +plane+))))
+ (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 (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 (:keysym keysym)
- (declare (ignore keysym))
+ (: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 (:x x :y y :state state)
-;; BUG: incorporate into input.lisp. This event handler activate once, while i need it to activate when the button is pressed
- (loop :for key :in *mouse-keybinds*
- :do (when (sdl2:mouse-state-p (eval (car key)))
- (apply (cadr key) `(,x ,y ,+plane+))))
- (when +plane+
- (activate x y state +plane+)))
+ (: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 ()
+ ;; 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
+ ;; only when the mouse is on the window. This makes press,
+ ;; alt+tab and release a way to keep the value to t. This
+ ;; event is a prevention method designed to release the hold
+ ;; when alt+tab or other window shortcuts are used.
+ (setf *is-mouse-hold* nil))
+ (: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*
+ (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*)
+ (sdl2:set-render-draw-color rulp.render:*renderer* 0 0 0 255)
;; local viewpoint
- (sdl2:set-render-target *renderer* viewpoint-texture)
- (sdl2:render-clear *renderer*)
- (render-plane-and-contents *renderer* +plane+)
- (sdl2:set-render-target *renderer* window-texture)
- ;; BUG: this system creates sickness. the viewpoint-texture is updated with some
- ;; lag, making it wobbly
- (sdl2:render-copy *renderer* viewpoint-texture
+ ;; NOTE: generalize
+ (when *changep*
+ (sdl2:destroy-texture viewpoint-texture)
+ (setf viewpoint-texture (sdl2:create-texture rulp.render:*renderer*
+ (sdl2:get-window-pixel-format window)
+ 2
+ (w *plane*)
+ (h *plane*)))
+ (sdl2:set-render-target rulp.render:*renderer* viewpoint-texture)
+ (sdl2:render-clear 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 (w *plane*) (h *plane*))
+ ;; FIXME: change to use the plane directly
+ )
+ (when *is-indexes*
+ (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 *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:set-render-draw-color rulp.render:*renderer* 0 0 0 255)
+ ))
+
+
+
+ ;; display viewpoint on window
+ (sdl2:set-render-target rulp.render:*renderer* window-texture)
+ (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 (* (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 (sdl2:make-rect (car *viewpoint-offset*)
- (cdr *viewpoint-offset*)
- (floor (* (width +plane+) *viewpoint-zoom*)) ; NOTE: hardcoded to +plane+, change to dynamic
- (floor (* (height +plane+) *viewpoint-zoom*)))
- )
- ;; (when +plane+
- ;; (sdl2:render-copy *renderer* (texture +plane+)
- ;; :source-rect (screen-source +plane+)
- ;; :dest-rect (screen-destination +plane+ t))
- ;; (loop :for entities :in (entities-list +plane+)
- ;; :do
- ;; (when (displayp entities)
- ;; (sdl2:render-copy *renderer* (texture entities)
- ;; :source-rect (screen-source entities)
- ;; :dest-rect (screen-destination entities +plane+))))
- ;; ;; Grid creation
- ;; (when *is-grid*
- ;; (grid-render *renderer* +plane+))
- ;; ;; Indexes creation
- ;; (when *is-indexes*
- ;; (indexes-render *renderer* +plane+))
- ;; )
- ;; 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))
- )
- ;; 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*
- ;; ))
- ;; )
+ :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))
+ ;; (loop :for entry :in *active-entries*
+ ;; :do (display-entry rulp.render:*renderer* entry))
+
;; debug infos
(when debug-info
- (tr-write (format nil "~A" debug-info) 0 0 10 15 *renderer*))
- (sdl2:render-present *renderer*)
+ (tr-write (format nil "~A" debug-info) 0 0 10 15 rulp.render:*renderer*))
+ (sdl2:render-present rulp.render:*renderer*)
;; updating grids and dimension
;; 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
+ ))
+ ;; 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.
+ (empty-screen-list)
+ (loop :for i :in *execute-after*
+ :do (eval `(,i)))
+ ))
OSDN Git Service
