;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game
;;;; set in Africa.
;;;; This file stores all game data and handles the server.
;;;; (c) 2018 Daniel Vedder, MIT license
;;XXX utility function during development, remove later
(defun dt (&optional (n 0))
(bt:destroy-thread (nth n (bt:all-threads))))
;; TODO save and load functions
;; XXX Will probably require `make-load-form-saving-slots'
;;; WORLD OBJECT
(let ((world NIL))
(defun set-world (w) (setf world w))
(defun world-size () (length world))
(defun save-topography (file-name) ;XXX (re)move this?
"Save the world topography as a text file"
(debugging "~&Saving world to file ~A" file-name) ;debug
(with-open-file (tf file-name :direction :output)
(dolist (row world)
(format stream "~&~A~%"
(mapcar #'(lambda (p)
(biome-char (patch-biome p)))
(defun save-world ()
(defun coord (x y)
"Return the patch at the given coordinates or NIL if out of bounds"
(unless (or (< x 0) (< y 0) (> x (length world)) (> y (length world)))
(nth x (nth y world)))))
;;; 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
;; -> comes from not closing connections properly?
;;FIXME causes Naledi to hang on `q' -> Is this really the problem?
(unless (or world-thread server-thread)
(setf running T)
(bt:make-thread #'update-loop :name "world-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
(dolist (pt player-threads)
(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 and occupants in each patch
(dotimes (y (world-size))
(dotimes (x (world-size))
(unless running (return-from update-loop))
(when (patch-occupant (coord x y))
(update (patch-occupant (coord x y))))
(dolist (i (patch-items (coord x y)))
;;Update all items each player has
;;Save the world and start over
(save-world) ;XXX not yet implemented
(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*)
;;FIXME infinite threads created over time
(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)))
(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
((eq cmd 'get-map) (get-map player-name))
((eq cmd 'describe-patch) (describe-patch args))
;;; COMMUNICATION FUNCTIONS
(defun get-map (player-name)
"Return a 2d list of map places (each a list of a char and a colour)"
(defun describe-patch (coords)
"Return a list of lines describing the patch at these coordinates."
(let ((p (coord (first coords) (second coords))))
(list (string-upcase (biome-name (patch-biome p))) ""
(format NIL "~A / ~A" (first (patch-pos p)) (second (patch-pos p))) ""
(format NIL "The ground here is ~A." (biome-ground (patch-biome p)))
(when (patch-occupant p) ;TODO players -> "$name is here."
(format NIL "There is ~A here."
(leading-vowel (.name (patch-occupant p)))))
(when (patch-items p)
(format NIL "The following items are here:~A *~A" #\newline
(string-from-list (mapcar #'.name (patch-items p)))
(format NIL "~% *"))))))
;;; CLIENT FUNCTIONS
(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))
(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 "~A~%" request)
;;FIXME server still doesn't receive string until disconnect...
(logging "CLIENT: waiting for server response")
(read-from-string (read-line servstr))))
(defun disconnect ()
"Disconnect from the server"
(setf naledi-server NIL)
(notify "Disconnected from server."))))