graphics/inputs.lisp

   1 ;;;; Ru*** roLeplay Playground virtual tabletop
   2 ;;;; Copyright (C) 2022  Zull
   3 ;;;;
   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.
   8 ;;;;
   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.
  13 ;;;;
  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/>.
  16
  17 (in-package :graphics)
  18
  19 (defparameter +mode+ '+normal-mode+)
  20
  21 (defgeneric activate (x y pressed p)
  22   (:documentation "given x y and the button pressed it do actions"))
  23
  24 (defmethod activate (x y pressed (p plane))
  25   (loop :for key :in *mouse-keybinds*
  26         :do
  27            (when (sdl2:mouse-state-p (eval (car key)))
  28              (apply (cadr key) `(,x ,y ,p))
  29                     )))
  30
  31
  32 (defmethod select-pointer (x y (p plane))
  33   "with left button it select and deselect entities the map-gplane contain"
  34   (let ((mouse-point (sdl2:make-rect x y 10 10))
  35         (entities (entities-list p)))
  36     (setf *pointer* nil)
  37     (loop :for obj :in entities
  38           :for obj-nth :from 0 :to (length entities)
  39           :do
  40              (when (sdl2:has-intersect mouse-point
  41                                        (screen-destination obj p))
  42                (setf *pointer* obj-nth)))
  43           ))
  44
  45 (defmethod move-entity (x y (p plane))
  46   "with right button it move the entity around the plane"
  47   (when (numberp *pointer*)
  48     (let* ((x-offset (x p))
  49            (y-offset (y p))
  50            (i-x (floor (/ (- x x-offset) (grid-dimension p))))
  51            (i-y (floor (/ (- y y-offset) (grid-dimension p))))
  52            (object (nth *pointer* (entities-list p))))
  53       (setf (coordinate object) (cons i-x i-y))
  54       (setf (x object) i-x)
  55       (setf (y object) i-y)
  56       )))