Skip to content

Instantly share code, notes, and snippets.

@veddox
Created November 26, 2018 20:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save veddox/d0df0d6ea685a348d5674c30b2cdfe6d to your computer and use it in GitHub Desktop.
Save veddox/d0df0d6ea685a348d5674c30b2cdfe6d to your computer and use it in GitHub Desktop.
;;; 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