Add movement state

client/src/events.lisp

@@ -37,8 +37,8 @@
   (ax ay))
 
 
-(defevent velocity-changed ()
-  (velocity))
+(defevent movement-changed ()
+  (direction))
 
 
 (defevent trigger-pulled () ())

client/src/main.lisp

@@ -111,7 +111,7 @@
                             'player-added
                             'game-state-updated
                             'camera-rotated
-                            'velocity-changed
+                            'movement-changed
                             'trigger-pulled)
     (setf keymap (make-instance 'keymap)
           task-queue (make-task-queue))
@@ -126,23 +126,31 @@
                      (post (make-camera-rotated ax (- ay)) eve)))
                  (setf prev-x x
                        prev-y y))
-               (key-velocity (key)
-                 (case key
-                   (:w (vec2 0.0 +player-speed+))
-                   (:s (vec2 0.0 (- +player-speed+)))
-                   (:a (vec2 (- +player-speed+) 0.0))
-                   (:d (vec2 +player-speed+ 0.0))))
-               (update-velocity ()
-                 (post (make-velocity-changed (reduce #'add movement-keys
-                                                      :key #'key-velocity
-                                                      :initial-value (vec2)))
-                       eve))
+               (update-movement ()
+                 (flet ((set-equal (this that)
+                          (null (set-difference this that))))
+                   (let* ((first (first movement-keys))
+                          (second (second movement-keys))
+                          (both (list first second))
+                          (direction (cond
+                                       ((null first) nil)
+                                       ((null second) (case first
+                                                        (:w :north)
+                                                        (:a :west)
+                                                        (:s :south)
+                                                        (:d :east)))
+                                       (second (switch (both :test #'set-equal)
+                                                 ('(:w :a) :north-west)
+                                                 ('(:w :d) :north-east)
+                                                 ('(:s :a) :south-west)
+                                                 ('(:s :d) :south-east))))))
+                     (post (make-movement-changed direction) eve))))
                (update-buttons (button)
                  (lambda (state)
                    (case state
                      (:pressed (push button movement-keys))
                      (:released (deletef movement-keys button)))
-                   (update-velocity)))
+                   (update-movement)))
                (shoot (state)
                  (when (eq :pressed state)
                    (post (make-trigger-pulled) eve))))

client/src/player.lisp

@@ -11,6 +11,7 @@
 
 (defclass player (subscriber)
   ((name :initarg :name :initform (error ":name missing") :reader name-of)
+   (movement :initform nil :reader movement-of)
    (position :initform (vec2)) ; f(x,y) field space = f(x,-z) global space
    (rotation :initform (vec2) :accessor rotation-of)
 
@@ -33,6 +34,21 @@
     position))
 
 
+(defmethod (setf movement-of) (direction (this player))
+  (with-slots (movement) this
+    (setf movement direction))
+  (setf (velocity-of this) (case direction
+                             (:north (vec2 0.0 +player-speed+))
+                             (:west (vec2 (- +player-speed+) 0.0))
+                             (:south (vec2 0.0 (- +player-speed+)))
+                             (:east (vec2 +player-speed+ 0.0))
+                             (:north-west (vec2 (- +player-speed+) +player-speed+))
+                             (:south-west (vec2 (- +player-speed+) (- +player-speed+)))
+                             (:south-east (vec2 +player-speed+ (- +player-speed+)))
+                             (:north-east (vec2 +player-speed+ +player-speed+))
+                             (t (vec2 0.0 0.0)))))
+
+
 (defun gaze-of (player)
   "In global coords"
   (with-slots (rotation) player
@@ -52,9 +68,9 @@
 
 
 (defmethod initialize-instance :after ((this player) &key)
-  (flet ((update-velocity (ev)
-           (setf (velocity-of this) (velocity-from ev)))
+  (flet ((update-movement (ev)
+           (setf (movement-of this) (direction-from ev)))
          (update-rotation (ev)
            (look-at this (ax-from ev) (ay-from ev))))
     (register-event-handler 'camera-rotated #'update-rotation)
-    (register-event-handler 'velocity-changed #'update-velocity)))
+    (register-event-handler 'movement-changed #'update-movement)))

client/src/proxy.lisp

@@ -3,6 +3,7 @@
 
 (defclass proxy ()
   ((name :initarg :name :initform (error ":name missing") :reader name-of)
+   (movement :initform nil)
    (position :initform (vec2)) ; f(x,y) field space = f(x,-z) global space
    (rotation :initform (vec2) :reader rotation-of)
    (updated-at :initform (real-time-seconds))