Skip to content
Browse files

Add keymap

  • Loading branch information
borodust committed Apr 20, 2017
1 parent 750002a commit fc34a5b9c4554cf2dab3fa771d02f2d1b6a84c0d
Showing with 50 additions and 1 deletion.
  1. +46 −0 client/src/keymap.lisp
  2. +3 −1 client/src/main.lisp
  3. +1 −0 mortar-combat.asd
@@ -0,0 +1,46 @@
(in-package :mortar-combat)

;; fixme: don't forget to make thread safe for generalization
(defclass keymap (lockable)
((callbacks :initform nil)
(cursor-action :initform nil)
(key-table :initform (make-hash-table :test 'eq))))

(defun enable-keymap (keymap)
(with-slots (callbacks cursor-action key-table) keymap
(when callbacks
(error "Keymap already enabled"))
(let ((eve (events)))
(flet ((register-callback (class action)
(push (cons class (subscribe-to class action eve)) callbacks))
(process-button-event (ev)
(when-let ((action (gethash (key-from ev) key-table)))
(funcall action (state-from ev))))
(process-cursor-event (ev)
(when cursor-action
(funcall cursor-action (x-from ev) (y-from ev)))))
(register-callback 'keyboard-event #'process-button-event)
(register-callback 'mouse-event #'process-button-event)
(register-callback 'cursor-event #'process-cursor-event)))))

(defun disable-keymap (keymap)
(with-slots (callbacks) keymap
(unless callbacks
(error "Keymap already disabled"))
(loop with eve = (events)
for (class . cb) in callbacks
do (unsubscribe-from class cb eve))
(setf callbacks nil)))

(defun bind-button (keymap button action)
(with-slots (key-table) keymap
(setf (gethash button key-table) action)))

(defun bind-cursor (keymap action)
(with-slots (cursor-action) keymap
(setf cursor-action action)))
@@ -23,7 +23,7 @@
((transform-node :translation (vec3 4.0 0.0 0.0))
((dude-model :color (vec3 0.9 0.4 0.4) :animation-name "animation.Running"))))))))
((dude-model :color (vec3 0.9 0.4 0.4)))))))))

(defmethod initialize-system :after ((this mortar-combat))
@@ -35,6 +35,8 @@
(setf (viewport-size) (vec2 800 600)))
(-> ((physics)) ()
(setf (gravity) (vec3 0.0 -9.81 0.0)))
(-> ((graphics)) ()
(gl:viewport 0 0 800 600))
(instantly (scenegraph-root)
(setf scene (make-scene (make-pass-chain (make-simulation-pass)
@@ -28,6 +28,7 @@
:pathname "client/src/"
:components ((:file "packages")
(:file "utils")
(:file "keymap")
(:file "camera")
(:file "room")
(:file "ball")

0 comments on commit fc34a5b

Please sign in to comment.
You can’t perform that action at this time.