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 ;; this functions are changed every frame with the mouse position. This
  20 ;; is then used everywhere. This assure syncronization between two functions.
  21 ;; The values are stored in a cons and can be exported with (x *mouse-position*)
  22 ;; and (y *mouse-position*)
  23 (defparameter *mouse-position* '(0 . 0)
  24   "contains the mouse coordinates in the screen, this is updated by frame")
  25 (defparameter *mouse-previous-position* '(0 . 0)
  26   "contains the mouse coordinates on the previous frame, this is updated by frame
  27 using *mouse-position*. The usefullness of this value is to create velocity")
  28
  29 (defparameter *is-mouse-hold* nil
  30   "this variable is modified when a button is hold down. This doesn't specifies
  31 which button is being hold.")
  32 (defparameter +mode+ '+normal-mode+)
  33
  34 (defun mouse-actions (keybinds)
  35   "given an association list of keybinds it returns the associated element
  36 when the button is pressed"
  37   (loop :for button :in keybinds
  38         :collect (when (sdl2:mouse-state-p (eval (car button))) ; BUG: watch out for this eval
  39                    (cdr button))))
  40
  41 ;; NOTE: this is a frame dependent version, correction is easy when i'll have
  42 ;; time deltas.
  43 (defun velocity (actual-point previous-point)
  44   "calculate the delta between two points. This is absolutely frame dependent"
  45   (cons (- (car actual-point) (car previous-point))
  46         (- (cdr actual-point) (cdr previous-point))))
  47
  48 (defun panning (value delta)
  49   "destructive function. It update the value with the given delta. Both value
  50 and delta are coordinate cons (like '(x . y))"
  51   (setf (car value) (+ (car value) (car delta))
  52         (cdr value) (+ (cdr value) (cdr delta))))
  53
  54 ;; (defgeneric select-entry (x y p)
  55 ;;   (:documentation "operate with menues, create them, destroy them and apply them"))
  56
  57 ;; (defgeneric key-activate (x y pressed p))
  58
  59 ;; (defmethod key-activate (x y pressed (p plane))
  60 ;;   )
  61
  62 ;; (defgeneric activate (x y pressed p)
  63 ;;   (:documentation "given x y and the button pressed it do actions"))
  64
  65 ;; (defmethod activate (x y pressed (p plane))
  66 ;;   (loop :for key :in *mouse-keybinds*
  67 ;;         :do
  68 ;;            (when (sdl2:mouse-state-p (eval (car key)))
  69 ;;              (apply (cadr key) `(,x ,y ,p))
  70 ;;                     )))
  71
  72
  73 ;; FIXME: this method can be designed non destructively. by just returning the position
  74 ;; in the list of the selected entity
  75 (defgeneric select-pointer (coordinate p))
  76
  77 (defmethod select-pointer (coordinate (p plane))
  78   "with left button it select and deselect entities the map-gplane contain"
  79   (let ((mouse-point (sdl2:make-rect (car coordinate) (cdr coordinate) 10 10))
  80         (entities (entities-list p)))
  81     (setf *pointer* nil)
  82     (loop :for obj :in entities
  83           :for obj-nth :from 0 :to (length entities)
  84           :do
  85              (when (sdl2:has-intersect mouse-point
  86                                        (screen-destination obj p))
  87                (setf *pointer* obj-nth)))
  88     ))
  89
  90 (defgeneric move-entity (coordinate p))
  91
  92 (defmethod move-entity (coordinate (p plane))
  93   "with right button it move the entity around the plane"
  94   (when (numberp *pointer*)
  95     (let* ((x-offset (x p))
  96            (y-offset (y p))
  97            (i-x (floor (/ (- (car coordinate) x-offset) (grid-dimension p))))
  98            (i-y (floor (/ (- (cdr coordinate) y-offset) (grid-dimension p))))
  99            (object (nth *pointer* (entities-list p))))
 100       (setf (coordinate object) (cons i-x i-y))
 101       ;; (setf (x object) i-x)
 102       ;; (setf (y object) i-y)
 103       )))