1 ;;;; Ru*** roLeplay Playground virtual tabletop
2 ;;;; Copyright (C) 2022 Zull
4 ;;;; This program is free software: you can redistribute it and/or modify
5 ;;;; it under the terms of the GNU General Public License as published by
6 ;;;; the Free Software Foundation, either version 3 of the License, or
7 ;;;; (at your option) any later version.
9 ;;;; This program is distributed in the hope that it will be useful,
10 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 ;;;; GNU General Public License for more details.
14 ;;;; You should have received a copy of the GNU General Public License
15 ;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
17 (in-package :graphics)
19 (defparameter +mode+ '+normal-mode+)
21 (defgeneric select-entry (x y p)
22 (:documentation "operate with menues, create them, destroy them and apply them"))
24 ;; (defgeneric key-activate (x y pressed p))
26 ;; (defmethod key-activate (x y pressed (p plane))
29 (defgeneric activate (x y pressed p)
30 (:documentation "given x y and the button pressed it do actions"))
32 (defmethod activate (x y pressed (p plane))
33 (loop :for key :in *mouse-keybinds*
35 (when (sdl2:mouse-state-p (eval (car key)))
36 (apply (cadr key) `(,x ,y ,p))
39 (defmethod select-entry (x y (p t))
40 "generic version, does nothing"
43 (defmethod select-entry (x y (p plane))
44 "starts from plane, it search for entities or entries and then redirect
45 to the correct method"
46 (select-entry (x y (find-on-plane x y p)))
49 (defmethod select-entry (x y (p entity))
50 "an entity is selected"
53 (defmethod select-pointer (x y (p plane))
54 "with left button it select and deselect entities the map-gplane contain"
55 (let ((mouse-point (sdl2:make-rect x y 10 10))
56 (entities (entities-list p)))
58 (loop :for obj :in entities
59 :for obj-nth :from 0 :to (length entities)
61 (when (sdl2:has-intersect mouse-point
62 (screen-destination obj p))
63 (setf *pointer* obj-nth)))
66 (defmethod move-entity (x y (p plane))
67 "with right button it move the entity around the plane"
68 (when (numberp *pointer*)
69 (let* ((x-offset (x p))
71 (i-x (floor (/ (- x x-offset) (grid-dimension p))))
72 (i-y (floor (/ (- y y-offset) (grid-dimension p))))
73 (object (nth *pointer* (entities-list p))))
74 (setf (coordinate object) (cons i-x i-y))
75 ;; (setf (x object) i-x)
76 ;; (setf (y object) i-y)
79 ;;; procedural solution, find a better version without global variables
80 (defmethod mouse-view (x y (p plane))
81 "update teh mouse-movement-delta"
82 (setf *mouse-movement-delta* (list (- x (car *previous-mouse-position*))
83 (- y (cadr *previous-mouse-position*))))
84 (setf *previous-mouse-position* (list x y))
85 (format t "mouse-delta ~A~%" *mouse-movement-delta*)