Newer
Older
naledi / server.lisp
;;;;
;;;; 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~%"
					(string-from-list
						(mapcar #'(lambda (p)
									  (biome-char (patch-biome p)))
							row) "")))))

	(defun save-world ()
		;;TODO
		)
	
	(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 THREAD

(let ((uptime 0) (world-thread NIL) (server-thread NIL)
		 (player-threads NIL) (running NIL))

	(defun start-server ()
		"Start the game server"
		(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)))
	
	(defun age-of-the-world () uptime)

	(Defun reset-world-age () (setf uptime 0))
	
	(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 i))))
		;;Update all items each player has
		;;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 #'handle-connection
								  (socket-accept socket))))
					(setf player-threads (cons thread player-threads))))))

	(defun handle-connection (socket)			
		(with-connected-socket (connection (socket-accept socket))
			(do* ((sockstr (socket-stream connection))
					 (request (read-line sockstr (eof-error-p NIL))
						 (read-line sockstr (eof-error-p NIL))))
				((or (not running) (null request)) (force-output sockstr))
				(format (socket-stream connection) "~S" (answer request))))))

;;TODO (defun answer (request) )