Add keymap

Author: borodust

client/src/keymap.lisp

@@ -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)))

client/src/main.lisp

@@ -23,7 +23,7 @@
       (room-model)
       ((transform-node :translation (vec3 4.0 0.0 0.0))
        (mortar-model)
-       ((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))
              (scenegraph-flow)
              (instantly (scenegraph-root)
                (setf scene (make-scene (make-pass-chain (make-simulation-pass)

mortar-combat.asd

@@ -28,6 +28,7 @@
   :pathname "client/src/"
   :components ((:file "packages")
                (:file "utils")
+               (:file "keymap")
                (:file "camera")
                (:file "room")
                (:file "ball")