Created
November 26, 2018 20:14
-
-
Save veddox/d0df0d6ea685a348d5674c30b2cdfe6d to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
;;; WORLD THREADS | |
(let ((uptime 0) (world-thread NIL) (server-thread NIL) | |
(player-threads NIL) (running NIL)) | |
(defun start-server (&optional (force NIL)) | |
"Start the game server" | |
;;TODO cannot restart -> ADDRESS-IN-USE ERROR | |
(when force | |
(reset-server-threads) | |
(reset-world-age)) | |
(unless (or world-thread server-thread) | |
(init-world) | |
(setf running T) | |
(setf world-thread | |
(bt:make-thread #'update-loop :name "world-thread")) | |
(setf server-thread | |
(bt:make-thread #'run-server :name "server-thread")))) | |
(defun terminate () | |
(notify "Terminating the world.") | |
(setf running NIL) | |
;;XXX have to use destroy-thread because the server mostly idles, | |
;; waiting for connections - only checks 'running' when connecting | |
(bt:destroy-thread server-thread) | |
(bt:join-thread world-thread) | |
(dolist (pt player-threads) | |
(bt:join-thread pt)) | |
(save-world)) ;XXX not yet implemented | |
(defun age-of-the-world () uptime) | |
(defun reset-world-age () (setf uptime 0)) | |
(defun runningp () running) | |
(defun reset-server-threads () | |
(set-list NIL server-thread world-thread player-threads)) | |
(defun update-loop () | |
"The main loop, updating the world in the background" | |
;;XXX split this up into two or more functions, to be run by | |
;; different threads? | |
(logging "UPDATE ~S" uptime) | |
;;Update all items | |
;;TODO | |
;;Save the world and start over | |
(save-world) ;XXX not yet implemented | |
(incf uptime) | |
(sleep (/ *framerate* 1000)) | |
(when running (update-loop))) ;;requires Tail-Call Optimization | |
(defun run-server () | |
"Start a server, listening for connections" | |
(with-socket-listener (socket "127.0.0.1" *port*) | |
(while running | |
(wait-for-input socket) | |
(let ((thread (bt:make-thread | |
#'(lambda () (handle-connection socket)) | |
:name (string-from-list (list "player-thread" | |
(length player-threads)) "-")))) | |
(setf player-threads (cons thread player-threads)))))) | |
(defun handle-connection (socket) | |
"Answer requests until the player disconnects" | |
(with-connected-socket (connection (socket-accept socket)) | |
(logging "~&SERVER: received a connection.") ; cf. `get-peer-name' | |
(do* ((sockstr (socket-stream connection)) | |
(request (read-line sockstr NIL) (read-line sockstr NIL))) | |
((or (not running) (null request))) | |
(format sockstr "~S" (to-string (answer request))) | |
(finish-output sockstr)))) | |
(defun answer (request) | |
(logging "SERVER: received request ~S" request) | |
(let* ((reqelts (extract-elements request)) | |
(player-name (first reqelts)) | |
(cmd (second reqelts)) | |
(args (cddr reqelts))) | |
(cond ((eq player-name 'ACK) "ACK ACK") ;debug | |
;;TODO | |
))) | |
(let ((naledi-server NIL)) | |
(defun connect-server (&optional (ip "127.0.0.1") (port *port*)) | |
"Connect to the specified server" | |
;;FIXME I need to catch some exceptions here... | |
(setf naledi-server (socket-connect ip port)) | |
(if naledi-server | |
(notify "Connected to server ~A:~A" ip port) | |
(notify "Connection to server ~A:~A failed." ip port))) | |
(defun current-server () naledi-server) ;TODO remove after development | |
(defun query-server (request) | |
"Send a request string to the server and return the answer" | |
(unless naledi-server ;XXX do this with exceptions? | |
(return-from query-server "You are not connected to a server!")) | |
(let ((servstr (socket-stream naledi-server))) | |
(logging "CLIENT: sending request ~S" request) | |
(format servstr request) | |
(finish-output servstr) | |
;;FIXME server still doesn't receive string until disconnect... | |
(logging "CLIENT: waiting for server response") | |
(wait-for-input naledi-server) | |
(read-from-string (read-line servstr)))) | |
(defun disconnect () | |
"Disconnect from the server" | |
(when naledi-server | |
(socket-close naledi-server) | |
(setf naledi-server NIL) | |
(notify "Disconnected from server.")))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment