Game server and client

client/src/connector.lisp

@@ -3,7 +3,8 @@
 
 (define-constant +supported-server-version+ 1)
 
-(declaim (special *message*))
+(declaim (special *message*
+                  *connector*))
 
 (defstruct (server-identity
              (:constructor make-server-identity (id name)))
@@ -17,39 +18,36 @@
 
 (defclass connector (lockable disposable dispatcher)
   ((enabled-p :initform t)
-   (connection :initarg :connection :reader connection-of)
+   (connection :initform nil :reader connection-of)
    (message-counter :initform 0)
    (message-table :initform (make-hash-table :test 'eql))))
 
 
-(defmethod initialize-instance :after ((this connector) &key)
+(defmethod initialize-instance :after ((this connector) &key host port)
   (with-slots (connection message-table enabled-p) this
+    (setf connection  (usocket:socket-connect host port
+                                              :element-type '(unsigned-byte 8)
+                                              :timeout 30))
     (in-new-thread "connector-thread"
       (loop while enabled-p
          do (log-errors
               (usocket:wait-for-input connection)
               (let* ((stream (connection-stream-of this))
-                     (message (decode-message stream)))
+                     (message (decode-message stream))
+                     (*connector* this))
                 (if-let ((reply-id (getf message :reply-for)))
                   (with-instance-lock-held (this)
                     (if-let ((handler (gethash reply-id message-table)))
                       (progn
                         (remhash reply-id message-table)
                         (funcall handler message))
                       (log:error "Handler not found for message with id ~A" reply-id)))
-                  (progn
-                    (encode-message (process-command (getf message :command) message) stream)
+                  (when-let ((reply (process-command (getf message :command) message)))
+                    (encode-message reply stream)
                     (force-output stream)))))
          finally (usocket:socket-close connection)))))
 
 
-(defun connect-to-server (host port)
-  (make-instance 'connector
-                 :connection (usocket:socket-connect host port
-                                                     :element-type '(unsigned-byte 8)
-                                                     :timeout 30)))
-
-
 (defun disconnect-from-server (connector)
   (with-slots (enabled-p) connector
     (setf enabled-p nil)))
@@ -70,9 +68,14 @@
     (finish-output stream)))
 
 
-(defmacro with-response (command-name (&rest properties) response &body body)
-  `(destructuring-bind (&key ,@properties &allow-other-keys) ,response
-     (check-response ,response ,command-name)
+(defmacro with-message ((&rest properties) message &body body)
+  `(destructuring-bind (&key ,@properties &allow-other-keys) ,message
+     ,@body))
+
+
+(defmacro with-response ((&rest properties) command-name &body body)
+  `(with-message (,@properties) *message*
+     (check-response *message* ,command-name)
      ,@body))
 
 
@@ -84,46 +87,47 @@
         (flet ((response-callback (message)
                  (let ((*message* message))
                    (funcall task))))
-          (setf (gethash next-id message-table) #'response-callback)
+          (unless (getf keys :no-reply)
+            (setf (gethash next-id message-table) #'response-callback))
           (apply #'send-command this :message-id next-id keys))))))
 
 
 (defun server-version (connector)
   (-> (connector :command :version) ()
-    (with-response :version (version) *message*
+    (with-response (version) :version
       version)))
 
 
 (defun identify (connector name)
   (-> (connector :command :identify :name name) ()
-    (with-response :identified (id name) *message*
+    (with-response (id name) :identified
       (make-server-identity id name))))
 
 
 (defun create-arena (connector name)
   (-> (connector :command :create-arena :name name) ()
-    (with-response :ok () *message*)))
+    (with-response () :ok)))
 
 
 (defun join-arena (connector name)
   (-> (connector :command :join-arena :name name) ()
-    (with-response :ok () *message*)))
+    (with-response () :ok)))
 
 
 (defun get-arena-list (connector)
   (-> (connector :command :get-arena-list) ()
-    (with-response :arena-list (list) *message*
+    (with-response (list) :arena-list
       list)))
 
 
 (defun register-game-stream (connector peer-id)
   (-> (connector :command :register-game-stream :peer-id peer-id) ()
-    (with-response :ok () *message*)))
+    (with-response () :ok)))
 
 
 (defun ping-peer (connector)
   (-> (connector :command :ping) ()
-    (with-response :ok () *message*)))
+    (with-response () :ok)))
 
 
 (defmethod process-command ((command (eql :ping)) message)

client/src/dude.lisp

@@ -78,6 +78,7 @@
 (defclass dude-model (model)
   ((mesh :initform nil)
    (body :initform nil)
+   (player :initarg :player)
    (program :initform nil)
    (run-animation :initform nil)
    (rest-animation :initform nil)
@@ -118,9 +119,11 @@
 (defmethod model-graph-assembly-flow ((this dude-model))
   (with-slots (skeleton mesh program color rest-animation) this
     (scenegraph
-     ((animation-node :initial-animation rest-animation :name :dude-animation)
-      ((animated-skeleton-node :root-bone skeleton)
-       ((dude-mesh :mesh mesh :program program :color color)))))))
+     (scene-node
+      ((animation-node :initial-animation rest-animation :name :dude-animation)
+       ((animated-skeleton-node :root-bone skeleton)
+        ((dude-mesh :mesh mesh :program program :color color))))
+      (mortar-model)))))
 
 
 (defmethod scene-pass ((this dude-model) (pass simulation-pass) input)
@@ -135,5 +138,11 @@
     (call-next-method))
 
 
-(defmethod scene-pass ((this dude-model) (pass rendering-pass) input)
-  (call-next-method))
+(defmethod scene-pass ((this dude-model) pass input)
+  (with-slots (player) this
+    (let* ((pos (position-of player))
+           (rot (rotation-of player))
+           (*model-matrix* (mult *model-matrix*
+                                 (translation-mat4 (x pos) 0.0 (- (y pos)))
+                                 (euler-angles->mat4 (vec3 0.0 (y rot) 0.0)))))
+      (call-next-method))))

client/src/events.lisp

@@ -0,0 +1,5 @@
+(in-package :mortar-combat)
+
+
+(defevent player-added-event ()
+  (player))

client/src/game-client.lisp

@@ -0,0 +1,25 @@
+(in-package :mortar-combat)
+
+
+(defclass game-client (connector) ()
+  (:default-initargs :host "localhost" :port 8222))
+
+
+(defun make-game-client ()
+  (make-instance 'game-client))
+
+
+(defun register-player (client name)
+  (run (-> (client :command :register-player
+                   :name name)
+           ())))
+
+
+(defun send-player-info (client name player)
+  (let ((pos (position-of player))
+        (rot (rotation-of player)))
+    (run (-> (client :command :player-info
+                     :name name
+                     :position (list (x pos) (y pos))
+                     :rotation (list (x rot) (y rot)))
+             ()))))

client/src/game-server.lisp

@@ -0,0 +1,30 @@
+(in-package :mortar-combat)
+
+
+(defclass game-server (connector)
+  ((players :initform (make-hash-table :test 'equal)))
+  (:default-initargs :host "localhost" :port 8222))
+
+
+(defun make-game-server ()
+  (make-instance 'game-server))
+
+
+(defmethod process-command ((command (eql :register-player)) message)
+  (with-slots (players) *connector*
+    (with-message (name) message
+      (with-instance-lock-held (*connector*)
+        (let ((player (make-instance 'player)))
+          (setf (gethash name players) player)
+          (post (make-player-added-event player) (events))))))
+  nil)
+
+
+(defmethod process-command ((command (eql :player-info)) message)
+  (with-slots (players) *connector*
+    (with-message (name position rotation) message
+      (with-instance-lock-held (*connector*)
+        (when-let ((player (gethash name players)))
+          (setf (position-of player) (sequence->vec2 position)
+                (rotation-of player) (sequence->vec2 rotation))))))
+  nil)