Permalink
Browse files

Game server and client

  • Loading branch information...
borodust committed Apr 21, 2017
1 parent d0cfc8f commit 29a4b8f2a4d79ec79913499432d1c66cc492f54a

Large diffs are not rendered by default.

Oops, something went wrong.
@@ -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)
@@ -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))))
@@ -0,0 +1,5 @@
(in-package :mortar-combat)
(defevent player-added-event ()
(player))
@@ -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)))
()))))
@@ -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)
Oops, something went wrong.

0 comments on commit 29a4b8f

Please sign in to comment.