fixed inputs on new entity management

diff --git a/geometry/grid.lisp b/geometry/grid.lisp
index 8351b7c..52e312c 100644 (file)
--- a/geometry/grid.lisp
+++ b/geometry/grid.lisp
@@ -91,3 +91,13 @@ when the grid is t the method will become an identity map, returing the input 'a
             (car adj-size)
             (cdr adj-size)
             )))
+
+(defmethod rectangle ((object entity) (grid squaregrid))
+  (let ((adj-coos (spr (span grid) (coordinates object)))
+        (adj-size (spr (span grid) (size object))))
+    (rulp.render:rectangle
+     (car adj-coos)
+     (cdr adj-coos)
+     (car adj-size)
+     (cdr adj-size)
+     )))

diff --git a/geometry/package.lisp b/geometry/package.lisp
index a77f9aa..e698393 100644 (file)
--- a/geometry/package.lisp
+++ b/geometry/package.lisp
@@ -16,4 +16,5 @@
 
 (defpackage :rulp.geometry
   (:use :cl :rulp.layers)
-  (:export grid-closure squaregrid span))
+  (:export grid-closure squaregrid span
+           to-grid from-grid rectangle))

diff --git a/graphics/inputs.lisp b/graphics/inputs.lisp
index 7fcbead..f68fffb 100644 (file)
--- a/graphics/inputs.lisp
+++ b/graphics/inputs.lisp
@@ -72,31 +72,37 @@ and delta are coordinate cons (like '(x . y)), output is garbage"
   "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)))
+  (let ((grid (plane-grid *plane*))
+        (mouse-point (cons (floor (/  (- (car coordinates) (car *viewpoint-offset*)) *viewpoint-zoom*))
+                           (floor (/  (- (cdr coordinates) (cdr *viewpoint-offset*)) *viewpoint-zoom*)))))
+    ;; FIXME: the this calculation should be made elsewhere
     (setf *pointer* nil)
-    (loop :for obj :in *entities-list*
-          :for obj-nth :from 0 :to (length *entities-list*)
+    (loop :for obj :in (entities-list *plane*)
+          :for obj-nth :from 0 :to (length (entities-list *plane*))
           :do
-             (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))))
-    ))
+             (let ((obj-position-to-grid (to-grid grid (coordinates obj)))
+                   (obj-size-to-grid (to-grid grid (size obj))))
+               (when (rulp.render:intersect-point
+                      (car obj-position-to-grid)
+                      (cdr obj-position-to-grid)
+                      (car obj-size-to-grid)
+                      (cdr obj-size-to-grid)
+                      (car mouse-point)
+                      (cdr mouse-point))
+                 (setf *pointer* obj-nth)
+                 )))))
 
 (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 (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)
+    (let* ((offset (cons (floor (/ (car *viewpoint-offset*) *viewpoint-zoom*))
+                         (floor (/ (cdr *viewpoint-offset*) *viewpoint-zoom*))))
+           ;; FIXME: create a solution for viewpoints
+           (offset-coordinates (cons (- (car coordinates) (car offset))
+                                     (- (cdr coordinates) (cdr offset))))
+           (discrete-coordinates (from-grid (plane-grid *plane*) offset-coordinates)))
+      (setf (coordinates (nth *pointer* (entities-list *plane*))) discrete-coordinates)
       )))
 
 (defun summon-entry (coordinates contents &key (title ""))

diff --git a/graphics/package.lisp b/graphics/package.lisp
index 06fee4c..e5093d9 100644 (file)
--- a/graphics/package.lisp
+++ b/graphics/package.lisp
@@ -115,3 +115,17 @@ used on uninitialized data to bootstrap the data")
     )
   `(defun ,chain-name ()
      ,@body))
+
+
+(defchain render-plane-and-entities :viewpoint
+;;   "using *plane* and *entities-list* the macro display on the current rendering texture
+;; the plane 'as is' and the entities with the grid-layout function"
+  (when *plane*
+    ;; NOTE: add error for non-screen planes
+    (display *plane* t)
+    (loop :for entity :in (entities-list *plane*)
+          :do
+             (when (displayp entity)
+               (display entity (plane-grid *plane*))
+               )))                                        ; FIXME: create a grid-layout function
+  )

diff --git a/graphics/render.lisp b/graphics/render.lisp
index 1b53e3b..f038718 100644 (file)
--- a/graphics/render.lisp
+++ b/graphics/render.lisp
@@ -72,15 +72,3 @@ rectangle directly, but use the arrange-rect")
 
 ;; BUG: when the system loads it doesn't fill the variable
 ;; *execute-in-viewpoint* therefore this function is never executed
-(defchain render-plane-and-entities :viewpoint
-;;   "using *plane* and *entities-list* the macro display on the current rendering texture
-;; the plane 'as is' and the entities with the grid-layout function"
-  (when *plane*
-    ;; NOTE: add error for non-screen planes
-    (display *plane* t)
-    (loop :for entity :in (entities-list *plane*)
-          :do
-             (when (displayp entity)
-               (display entity (plane-grid *plane*))
-               )))                                        ; FIXME: create a grid-layout function
-  )

diff --git a/graphics/view.lisp b/graphics/view.lisp
index 616ae03..400d594 100644 (file)
--- a/graphics/view.lisp
+++ b/graphics/view.lisp
@@ -121,12 +121,12 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo
           (: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)
@@ -134,7 +134,7 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo
                             ;; of calling the second element of the keybind list it calls
                             ;; the third element. If there is something there it would
                             ;; execute a special function for when the mouse is released.
-                            ;; (mouse-event *mouse-position*)
+                            (mouse-event *mouse-position*)
                             )
           (:mousebuttonup ()
                           ;; what about functions that require a single press? just create
@@ -209,13 +209,14 @@ DEBUG-INFO can be used to display the content on screen for test and debug purpo
                    ;; 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)))
+                     (let* ((object (nth *pointer* (entities-list *plane*)))
+                            (grid (plane-grid *plane*))
+                            (obj-position (to-grid grid (coordinates object)))
+                            (obj-size (to-grid grid (size object))))
+                       (rulp.render:render-square (car obj-position)
+                                                  (cdr obj-position)
+                                                  (car obj-size)
+                                                  (cdr obj-size)))
                      (sdl2:set-render-draw-color rulp.render:*renderer* 0 0 0 255)
                      ))
 

diff --git a/layers/entities.lisp b/layers/entities.lisp
index ec6fe02..ca6c7b5 100644 (file)
--- a/layers/entities.lisp
+++ b/layers/entities.lisp
@@ -72,11 +72,11 @@
       nil))
 
 (defmethod w ((obj entity))
-  (size obj)
+  (slot-value obj 'size)
   )
 
 (defmethod h ((obj entity))
-  (size obj)
+  (slot-value obj 'size)
   )
 
 (defmethod size ((obj entity))

diff --git a/render/package.lisp b/render/package.lisp
index 5208c2a..109e785 100644 (file)
--- a/render/package.lisp
+++ b/render/package.lisp
@@ -21,5 +21,4 @@
            render-line render-text render-texture
            load-texture texture-width texture-height
            intersect-point intersect-square destroy-texture
-           make-rectangle))
-
+           make-rectangle rectangle render-square))