| -------------------------------------------
|#
-(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)))
))
OSDN Git Service
