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 select-entry (x y p)
  22   (:documentation "operate with menues, create them, destroy them and apply them"))
  23
  24 ;; (defgeneric key-activate (x y pressed p))
  25
  26 ;; (defmethod key-activate (x y pressed (p plane))
  27 ;;   )
  28
  29 (defgeneric activate (x y pressed p)
  30   (:documentation "given x y and the button pressed it do actions"))
  31
  32 (defmethod activate (x y pressed (p plane))
  33   (loop :for key :in *mouse-keybinds*
  34         :do
  35            (when (sdl2:mouse-state-p (eval (car key)))
  36              (apply (cadr key) `(,x ,y ,p))
  37                     )))
  38
  39 (defmethod select-entry (x y (p t))
  40   "generic version, does nothing"
  41   nil)
  42
  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)))
  47   )
  48
  49 (defmethod select-entry (x y (p entity))
  50   "an entity is selected"
  51   )
  52
  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)))
  57     (setf *pointer* nil)
  58     (loop :for obj :in entities
  59           :for obj-nth :from 0 :to (length entities)
  60           :do
  61              (when (sdl2:has-intersect mouse-point
  62                                        (screen-destination obj p))
  63                (setf *pointer* obj-nth)))
  64     ))
  65
  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))
  70            (y-offset (y 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)
  77       )))
  78
  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*)
  86   )