Add client/server shot handling

client/src/arena.lisp

@@ -31,23 +31,23 @@
         (let* ((dude-name (getf dude-state :name)))
           (unless (equal dude-name (name-of player))
             (let ((dude (gethash dude-name dudes)))
-
               (unless dude
                 (setf dude (make-instance 'proxy :name dude-name)
                       (gethash dude-name dudes) dude)
                 (post (make-player-added dude) (events)))
               (update-proxy dude
                             (sequence->vec2 (getf dude-state :position))
-                            (sequence->vec2(getf dude-state :rotation))
+                            (sequence->vec2 (getf dude-state :rotation))
                             timestamp
                             (getf dude-state :movement)))))))))
 
 
 (defun shoot-ball (player)
   (let ((pos (position-of player)))
     (run (>> (assembly-flow 'ball-model
+                            :owner player
                             :position (vec3 (+ (x pos) 1.0) 10.0 (- (y pos)))
-                            :force (mult (gaze-of player) 10000))
+                            :force (mult (gaze-of player) 20000))
              (-> ((mortar-combat)) (ball)
                (let ((group (find-node (root-of (scene-of *system*)) :ball-group)))
                  (adopt group ball)))))))
@@ -68,10 +68,7 @@
            (game-state-updated (ev)
              (update-game-state this (state-from ev) (timestamp-from ev)))
            (shoot (ev)
-             (declare (ignore ev))
-             (shoot-ball player))
-           (update-velocity (ev)
-             (setf (velocity-of player) (velocity-from ev))))
+             (shoot-ball (player-from ev))))
       (register-event-handler 'trigger-pulled #'shoot)
       (register-event-handler 'player-added #'add-player)
       (register-event-handler 'game-state-updated #'game-state-updated))))

client/src/ball.lisp

@@ -1,15 +1,17 @@
 (in-package :mortar-combat)
 
 
-(defclass ball-geom (collidable sphere-geom) ())
+(defclass ball-geom (ownable collidable sphere-geom) ())
 (defclass ball-body (disposable)
   (body geom))
 
 
-(defmethod initialize-instance :after ((this ball-body) &key position force)
+(defmethod initialize-instance :after ((this ball-body) &key position force owner)
   (with-slots (body geom) this
     (setf body (make-rigid-body)
-          geom (make-instance 'ball-geom :radius (/ 1.025 2)))
+          geom (make-instance 'ball-geom
+                              :owner owner
+                              :radius (/ 1.025 2)))
     (when force
       (apply-force body force))
     (when position
@@ -62,14 +64,17 @@
   (body mesh program))
 
 
-(defmethod initialization-flow ((this ball-model) &key position force)
+(defmethod initialization-flow ((this ball-model) &key position force owner)
   (with-slots (body mesh program) this
     (>> (resource-flow "mesh.Ball" (shading-program-resource-name "passthru-program"))
         (instantly (m p)
           (setf mesh m
                 program p))
         (-> ((physics)) ()
-          (setf body (make-instance 'ball-body :position position :force force)))
+          (setf body (make-instance 'ball-body
+                                    :owner owner
+                                    :position position
+                                    :force force)))
         (call-next-method))))
 
 

client/src/dude.lisp

@@ -6,16 +6,19 @@
 (defvar *dude-bounds-initial-position* (vec4 0.0 7.5 0.0 1.0))
 (defvar *dude-bounds-initial-rotation* (euler-angles->mat4 (vec4 (/ pi 2) 0.0 0.0)))
 
-(defclass dude-bounds (collidable cylinder-geom) ())
+
+;;
+(defclass dude-bounds (ownable collidable cylinder-geom) ())
 
 
 (defclass dude-body (disposable)
   (bounds))
 
 
-(defmethod initialize-instance :after ((this dude-body) &key)
+(defmethod initialize-instance :after ((this dude-body) &key owner)
   (with-slots (bounds) this
     (setf bounds (make-instance 'dude-bounds
+                                :owner owner
                                 :radius 2.0
                                 :length 13.0))
     (setf (position-of bounds) (vec3 (x *dude-bounds-initial-position*)
@@ -111,7 +114,7 @@
                 rest-animation rest
                 program p))
         (-> ((physics)) ()
-          (setf body (make-instance 'dude-body)))
+          (setf body (make-instance 'dude-body :owner dude)))
         (call-next-method)
         (instantly ()
           (let* ((ani-player (find-node (model-root-of this) :dude-animation))
@@ -181,8 +184,10 @@
 
 
 (defmethod scene-pass ((this dude-model) (pass simulation-pass) input)
-  (with-slots (body) this
-    (let* ((pos (mult *model-matrix* *dude-bounds-initial-position*))
+  (with-slots (body player) this
+    (let* ((p-pos (position-of player))
+           (pos (mult *model-matrix* (add *dude-bounds-initial-position*
+                                          (vec4 (x p-pos) 0.0 (- (y p-pos))))))
            (w (w pos)))
       (flet ((w/ (v)
                (/ v w)))

client/src/events.lisp

@@ -41,4 +41,5 @@
   (player direction))
 
 
-(defevent trigger-pulled () ())
+(defevent trigger-pulled ()
+  (player))

client/src/game-client.lisp

@@ -30,6 +30,22 @@
              ()))))
 
 
+(defun send-shot-info (client player)
+  (run (-> (client :command :shot-info
+                   :no-reply t
+                   :name (name-of player)
+                   :timestamp (real-time-seconds))
+           ())))
+
+
 (defmethod process-command ((command (eql :game-state)) message)
   (post (make-game-state-updated (getf message :state) (getf message :timestamp)) (events))
   nil)
+
+
+(defmethod process-command ((command (eql :server-shot-info)) message)
+  (with-slots (arena) *connector*
+    (with-message (player-name) message
+      (when-let ((dude (find-dude arena player-name)))
+        (post (make-trigger-pulled dude) (events)))))
+  nil)

client/src/game-server.lisp

@@ -1,7 +1,7 @@
 (in-package :mortar-combat)
 
 
-(defclass game-server (connector)
+(defclass game-server (subscriber connector)
   ((arena :initarg :arena))
   (:default-initargs :host (property :server-address "127.0.0.1")
     :port (property :proxy-server-port 8222)))
@@ -11,6 +11,19 @@
   (make-instance 'game-server :arena arena))
 
 
+(defun broadcast-shot-info (server player)
+  (run (-> (server :command :server-shot-info
+                   :no-reply t
+                   :player-name (name-of player))
+           ())))
+
+
+(defmethod initialize-instance :after ((this game-server) &key)
+  (flet ((broadcast-shot (ev)
+           (broadcast-shot-info this (player-from ev))))
+  (register-event-handler 'trigger-pulled #'broadcast-shot)))
+
+
 (defmethod process-command ((command (eql :register-player)) message)
   (with-slots (arena) *connector*
     (with-message (name) message
@@ -32,6 +45,14 @@
   nil)
 
 
+(defmethod process-command ((command (eql :shot-info)) message)
+  (with-slots (arena) *connector*
+    (with-message (name) message
+      (when-let ((player (find-dude arena name)))
+        (post (make-trigger-pulled player) (events)))))
+  nil)
+
+
 (defun broadcast-game-state (server)
   (with-slots (arena) server
     (flet ((player-info (p)

client/src/main.lisp

@@ -153,11 +153,12 @@
                      (:released (deletef movement-keys button)))
                    (update-movement)))
                (shoot (state)
-                 (when (eq :pressed state)
-                   (post (make-trigger-pulled) eve))))
-
+                 (when (and (eq :pressed state) arena)
+                   (let ((player (player-of arena)))
+                     (when game-client
+                       (send-shot-info game-client player))
+                     (post (make-trigger-pulled player) eve)))))
         (bind-cursor keymap #'rotate-camera)
-
         (bind-button keymap :w (update-buttons :w))
         (bind-button keymap :s (update-buttons :s))
         (bind-button keymap :a (update-buttons :a))

client/src/player.lisp

@@ -5,9 +5,20 @@
 (defvar *forward-gaze* (vec3 0.0 0.0 -1.0))
 
 
+;;
+(defclass ownable ()
+  ((owner :initarg :owner :initform (error ":owner missing") :reader owner-of)))
+
+
+(defmethod collide ((this ownable) (that ownable))
+  (when (eq (owner-of this) (owner-of that))
+    t))
+
+
 (defgeneric position-of (player))
 (defgeneric rotation-of (player))
 (defgeneric name-of (player))
+(defgeneric gaze-of (player))
 
 (defclass player (subscriber)
   ((name :initarg :name :initform (error ":name missing") :reader name-of)
@@ -49,10 +60,14 @@
                              (t (vec2 0.0 0.0)))))
 
 
-(defun gaze-of (player)
+(defun calc-gaze (rotation)
+  (normalize (rotate *forward-gaze* (euler-angles->quat (x rotation) (y rotation) 0.0))))
+
+
+(defmethod gaze-of ((this player))
   "In global coords"
-  (with-slots (rotation) player
-    (normalize (rotate *forward-gaze* (euler-angles->quat (x rotation) (y rotation) 0.0)))))
+  (with-slots (rotation) this
+    (calc-gaze rotation)))
 
 
 (defun (setf velocity-of) (vec2 player)

client/src/proxy.lisp

@@ -32,6 +32,11 @@
     (lerp rotation next-rotation (proxy-lerp-factor this))))
 
 
+(defmethod gaze-of ((this proxy))
+  (with-slots (next-rotation) this
+    (calc-gaze next-rotation)))
+
+
 (defun update-proxy (proxy pos rot timestamp movement)
   (with-slots (next-position
                next-at position updated-at