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