floss/stoe
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add an input system inspired by emacs' keymaps

Browse source 
Use glop to poll the events each frame and pass any input event to the
input system.
Provide functions like `global-set-key' or `global-set-motion' to setup
function to be triggered when a key is pressed or when the mouse is moved.
This commit is contained in:
Renaud Casenave-Péré 2014-11-10 16:48:25 +09:00
parent 764baddb3c
commit f51bb6d4cf
3 changed files with 253 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

235
src/game/input.lisp Normal file
View file

@ -0,0 +1,235 @@
#|
This file is a part of stoe project.
Copyright (c) 2014 Renaud Casenave-Péré (renaud@casenave-pere.fr)
|#
(in-package :cl-user)
(defpackage stoe.game.input
(:nicknames :input)
(:use :cl :alexandria
:utils :containers)
(:export :initialize :finalize :update
:on-key-event :on-button-event :on-motion-event
:make-keymap :set-global-keymap
:define-key :global-set-key
:define-motion :global-set-motion))
(in-package :stoe.game.input)
(define-constant +keyevent-classes+ '(:press :release :repeat :continuous)
:test #'equal :documentation "List of the available key event classes.")
(define-constant +repeat-delay+ 200
:documentation "Delay to wait before triggering the first repeat event.")
(define-constant +repeat-rate+ 30
:documentation "Rate of the repeat event.")
(defstruct (keymap (:constructor %make-keymap))
name
(table (make-hash-table))
(modifiers :none))
(defun make-keymap (name)
"Create a new keymap."
(%make-keymap :name name))
(defvar *default-global-keymap* (make-keymap "Global")
"Default global key bindings.")
(defvar *current-global-keymap* nil
"The keymap currently in use.")
(defvar *event-queue* (make-queue)
"The event queue.")
(defvar *active-keys* nil
"List containing the currently active (pressed) keys.
Only those will trigger the release event.")
(defun initialize (&optional argv)
"Initialize the input module."
(declare (ignore argv))
(format t "Initialize Input module~%"))
(defun finalize ()
"Finalize the input module."
(format t "Finalize Input module~%")
(set-global-keymap nil))
(defun update (delta-time)
"Update the input module.
trigger key events that occured this frame."
(loop for event = (dequeue *event-queue*)
until (null event)
do (process-event event))
(mapc (lambda (key) (process-active-key key delta-time)) *active-keys*))
(defun set-global-keymap (keymap)
"Set the current global keymap."
(setf *current-global-keymap* keymap))
(defun current-global-keymap ()
"Return the current global keymap."
(or *current-global-keymap* *default-global-keymap*))
(defstruct active-key
keysym
(pressed t)
(next-repeat-time +repeat-delay+)
event)
(defun activep (keysym)
"Is `keyname' active?"
(member keysym *active-keys* :test (lambda (keysym key) (eq keysym (active-key-keysym key)))))
(defun add-active-key (keysym event)
(push (make-active-key :keysym keysym :event event) *active-keys*))
(defun remove-active-key (keysym)
(setf *active-keys* (delete keysym *active-keys* :test (lambda (keysym key) (eq keysym (active-key-keysym key))))))
(defclass input-event () ()
(:documentation "Base class for input events"))
(defclass key-event (input-event)
((keycode :initarg :keycode :reader keycode)
(keysym :initarg :keysym :reader keysym)
(text :initarg :text :reader text)
(pressed :initarg :pressed :reader pressed))
(:documentation "Keyboard key event"))
(defclass button-event (input-event)
((button :initarg :button :reader button)
(pressed :initarg :pressed :reader pressed))
(:documentation "Mouse button event"))
(defclass motion-event (input-event)
((x :initarg :x :reader x)
(y :initarg :y :reader y)
(dx :initarg :dx :reader dx)
(dy :initarg :dy :reader dy))
(:documentation "Mouse motion event"))
(defun on-key-event (pressed keycode keysym string)
"A key has been pressed or released."
(enqueue *event-queue* (make-instance 'key-event :pressed pressed :keycode keycode :keysym keysym :text string)))
(defun on-button-event (pressed button)
"A mouse button has been pressed or released."
(enqueue *event-queue* (make-instance 'button-event :pressed pressed :button button)))
(defun on-motion-event (x y dx dy)
"The mouse has been moved."
(enqueue *event-queue* (make-instance 'motion-event :x x :y y :dx dx :dy dy)))
(defgeneric process-event (input-event)
(:documentation "Process each event according to its class."))
(defmethod process-event ((evt key-event))
(let ((keysym (keysym evt)))
(when (xor (pressed evt) (activep keysym))
(if (pressed evt)
(progn
(add-active-key keysym evt)
(run-binding evt (current-global-keymap) keysym :press))
(progn
(run-binding evt (current-global-keymap) keysym :release)
(remove-active-key keysym))))))
(defmethod process-event ((evt button-event))
(let ((keysym (button evt)))
(when (xor (pressed evt) (activep keysym))
(if (pressed evt)
(progn
(add-active-key keysym evt)
(run-binding evt (current-global-keymap) keysym :press))
(progn
(run-binding evt (current-global-keymap) keysym :release)
(remove-active-key keysym))))))
(defmethod process-event ((evt motion-event))
(run-motion evt (current-global-keymap) :mouse-axis))
(defun process-active-key (key delta-time)
(if (active-key-pressed key)
(setf (active-key-pressed key) nil)
(run-binding (active-key-event key) (current-global-keymap) (active-key-keysym key) :continuous))
(decf (active-key-next-repeat-time key) delta-time)
(when (<= (active-key-next-repeat-time key) 0)
(run-binding (active-key-event key) (current-global-keymap) (active-key-keysym key) :repeat)
(setf (active-key-next-repeat-time key) +repeat-rate+)))
(defun find-binding (keymap keysym class)
(let ((binding (gethash keysym (keymap-table keymap))))
(when binding
(cdr (assoc class (gethash (keymap-modifiers keymap) binding))))))
(defun run-binding (event keymap keysym class)
(let ((binding (find-binding keymap keysym class)))
(when binding
(let ((fun (first binding))
(args (rest binding)))
(if args
(apply fun (mapcar (lambda (arg)
(if (and (keywordp arg) (slot-exists-p event (intern (symbol-name arg))))
(slot-value event event)
arg))
args))
(funcall fun))))))
(defun find-motion (keymap axis)
(gethash axis (keymap-table keymap)))
(defun run-motion (event keymap axis)
(let ((motion (find-motion keymap axis)))
(when motion
(let ((fun (first motion))
(args (rest motion)))
(if args
(apply fun (mapcar (lambda (arg)
(if (and (keywordp arg) (slot-exists-p event (intern (symbol-name arg) :input)))
(slot-value event (intern (symbol-name arg) :input))
arg))
args))
(funcall fun))))))
(defun insert-keybinding (keymap key fun args)
"Define a key to trigger `fun' within `keymap'."
(let ((keysym (first key))
(modifiers (second key))
(classes (third key)))
(let ((binding (gethash keysym (keymap-table keymap))))
(unless binding
(setf binding (setf (gethash keysym (keymap-table keymap)) (make-hash-table))))
(mapc (lambda (class)
(pushnew (cons class (cons fun args)) (gethash modifiers binding))) (safe-list classes)))
fun))
(defmacro define-key (keymap key fun &rest args)
`(let* ((keydef (safe-list ',key))
(modifiers-and-classes (rest keydef))
(modifiers (remove-if (lambda (sym) (member sym +keyevent-classes+)) modifiers-and-classes))
(classes (remove-if-not (lambda (sym) (member sym +keyevent-classes+)) modifiers-and-classes)))
(insert-keybinding ,keymap (list (first keydef)
(case (length modifiers)
(0 :none)
(1 (first modifiers))
(t modifiers))
(case (length classes)
(0 :press)
(1 (first classes))
(t classes)))
,fun ',args)))
(defmacro global-set-key (key fun &rest args)
"Set a key for the global keymap."
`(define-key (current-global-keymap) ,key ,fun ,@args))
(defun insert-motionbinding (keymap axis fun args)
(setf (gethash axis (keymap-table keymap)) (cons fun args)))
(defmacro define-motion (keymap fun &rest args)
`(insert-motionbinding ,keymap :mouse-axis ,fun ',args))
(defmacro global-set-motion (fun &rest args)
`(define-motion (current-global-keymap) ,fun ,@args))

18
src/render/render.lisp
View file

@ -71,7 +71,23 @@ This needs to be called once per frame, at the beginning of the loop."
(glop:dispatch-events *window* :blocking nil :on-foo nil)))
(defmethod glop:on-event (window event)
(declare (ignore window event)))
(declare (ignore window event))
(typecase event
(glop:key-press-event (input:on-key-event t (glop:keycode event) (glop:keysym event) (glop:text event)))
(glop:key-release-event (input:on-key-event nil (glop:keycode event) (glop:keysym event) (glop:text event)))
(glop:button-press-event (input:on-button-event t (glop:button event)))
(glop:button-release-event (input:on-button-event nil (glop:button event)))
(glop:mouse-motion-event (input:on-motion-event (glop:x event) (glop:y event) (glop:dx event) (glop:dy event)))
(glop:resize-event (on-resize-event (glop:width event) (glop:height event)))))
(defvar *width* 0)
(defvar *height* 0)
(defun on-resize-event (width height)
(setf (go::projection (game:get-current-camera)) (geom:make-persp-matrix 30 (/ width height) 1.0 1000.0))
(setf *width* width)
(setf *height* height)
(gl:viewport 0 0 width height))
(defun render-mesh (node mesh)
"Render a single mesh."

1
stoe.asd
View file

@ -52,6 +52,7 @@
(:module "game"
:components
((:file "game-object")
(:file "input")
(:file "game")))
(:module "render"
:components