;;;;
;;;; 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
;;;;

(in-package :naledi-ya-africa)

;;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 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?
		(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))
		(reset-server-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 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"
		(usocket:with-socket-listener (socket "127.0.0.1" *port*)
			(while running
				(usocket: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))
					(sleep 1))))) ;;give the socket a chance to connect

	(defun handle-connection (socket)
		"Answer requests until the player disconnects"
		(usocket:with-connected-socket (conn (usocket:socket-accept socket))
			(logging "~&SERVER: received a connection.") ; cf. `get-peer-name'
			(do* ((sockstr (usocket:socket-stream conn))
					 (request (read-line sockstr NIL) (read-line sockstr NIL)))
				;;TODO remove player-thread from list when terminated
				((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
			((eq cmd 'get-map) (get-map player-name))
			((eq cmd 'describe-patch) (describe-patch args))
		;;TODO
			)))

;;; COMMUNICATION FUNCTIONS

(defun get-map (player-name)
	"Return a 2d list of map places (each a list of a char and a colour)"
	;;TODO
	)

(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 "~%  *"))))))