diff --git a/data.lisp b/data.lisp deleted file mode 100644 index c89241e..0000000 --- a/data.lisp +++ /dev/null @@ -1,56 +0,0 @@ -;;;; -;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game -;;;; set in Africa. -;;;; -;;;; This file stores all game data. -;;;; -;;;; (c) 2018 Daniel Vedder, MIT license -;;;; - -;; TODO save and load functions -;; XXX Will probably require `make-load-form-saving-slots' - -;;; PATCHES - -(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))))) - -;;; BIOMES - -(let ((biome-list NIL)) - (defun register-biome (symbol-name biome-object) - (setf biome-list (cons (list symbol-name biome-object) biome-list))) - - (defun available-biomes () - (keys biome-list)) - - (defun get-biome (symbol-name) - (cassoc symbol-name biome-list))) - -(defmacro new-biome (name &body body) - `(register-biome ',name - (make-biome - :name ,(symbol-to-string name) - ,@body))) diff --git a/data.lisp b/data.lisp deleted file mode 100644 index c89241e..0000000 --- a/data.lisp +++ /dev/null @@ -1,56 +0,0 @@ -;;;; -;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game -;;;; set in Africa. -;;;; -;;;; This file stores all game data. -;;;; -;;;; (c) 2018 Daniel Vedder, MIT license -;;;; - -;; TODO save and load functions -;; XXX Will probably require `make-load-form-saving-slots' - -;;; PATCHES - -(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))))) - -;;; BIOMES - -(let ((biome-list NIL)) - (defun register-biome (symbol-name biome-object) - (setf biome-list (cons (list symbol-name biome-object) biome-list))) - - (defun available-biomes () - (keys biome-list)) - - (defun get-biome (symbol-name) - (cassoc symbol-name biome-list))) - -(defmacro new-biome (name &body body) - `(register-biome ',name - (make-biome - :name ,(symbol-to-string name) - ,@body))) diff --git a/naledi.lisp b/naledi.lisp index bc60f7b..ee950eb 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,32 +10,32 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *world-size* 250) (defparameter *framerate* 1000) +(defparameter *port* 21895) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) +(ql:quickload :usocket) (use-package :croatoan) +(use-package :usocket) (load "util.lisp") (load "item-classes.lisp") (load "item-methods.lisp") -(load "data.lisp") (load "world.lisp") (load "items.lisp") (load "biomes.lisp") (load "animals.lisp") +(load "server.lisp") (defun start-game () - ;;Initialize the log and random state - (write-to-file "NALEDI ya AFRICA" *logfile*) - (logging (time-stamp)) - (setf *random-state* (make-random-state t)) - (create-world 250) + "Start the game logic and UI" + (start-server) (with-screen (scr :input-blocking *framerate* :enable-colors t :input-echoing nil :cursor-visibility nil :input-reading :unbuffered) (splash-screen scr) - (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -87,8 +87,7 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) - ((nil) (logging "Detected NIL event.") - (update-ui mapwin playerwin placewin newswin me)) + ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) @@ -155,7 +154,6 @@ (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - ;;TODO (clear win) (move win 0 0) (add-string win (car news)) @@ -171,21 +169,23 @@ (defun message-window () "Return a dialog window with the last game messages." ;;TODO complete + ;;FIXME causes an error somewhere in the croatoan library... (make-instance 'dialog-window :input-blocking t - :items (mapcar - #'(lambda (n) (break-lines - (string-from-list (list "*" n)) 50) - news) + :items (break-lines + (mapcar #'(lambda (n) (string-from-list (list "*" n))) + news) + 50) :center t :border t + :stacked t :layout nil :title "Game messages" - :max-item-length 50)))) - ;:scrolled-layout '(10 1) - ;; :message-height 2 - ;; :message-text "Press b to go back." - ;; :event-handlers '((#\b #'exit-event-loop))))) + :max-item-length 50 + :scrolled-layout '(10 1) + :message-height 2 + :message-text "Press b to go back."))) + ;;:event-handlers '((#\b #'exit-event-loop))))) (defun process-command (event) ;;TODO diff --git a/data.lisp b/data.lisp deleted file mode 100644 index c89241e..0000000 --- a/data.lisp +++ /dev/null @@ -1,56 +0,0 @@ -;;;; -;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game -;;;; set in Africa. -;;;; -;;;; This file stores all game data. -;;;; -;;;; (c) 2018 Daniel Vedder, MIT license -;;;; - -;; TODO save and load functions -;; XXX Will probably require `make-load-form-saving-slots' - -;;; PATCHES - -(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))))) - -;;; BIOMES - -(let ((biome-list NIL)) - (defun register-biome (symbol-name biome-object) - (setf biome-list (cons (list symbol-name biome-object) biome-list))) - - (defun available-biomes () - (keys biome-list)) - - (defun get-biome (symbol-name) - (cassoc symbol-name biome-list))) - -(defmacro new-biome (name &body body) - `(register-biome ',name - (make-biome - :name ,(symbol-to-string name) - ,@body))) diff --git a/naledi.lisp b/naledi.lisp index bc60f7b..ee950eb 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,32 +10,32 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *world-size* 250) (defparameter *framerate* 1000) +(defparameter *port* 21895) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) +(ql:quickload :usocket) (use-package :croatoan) +(use-package :usocket) (load "util.lisp") (load "item-classes.lisp") (load "item-methods.lisp") -(load "data.lisp") (load "world.lisp") (load "items.lisp") (load "biomes.lisp") (load "animals.lisp") +(load "server.lisp") (defun start-game () - ;;Initialize the log and random state - (write-to-file "NALEDI ya AFRICA" *logfile*) - (logging (time-stamp)) - (setf *random-state* (make-random-state t)) - (create-world 250) + "Start the game logic and UI" + (start-server) (with-screen (scr :input-blocking *framerate* :enable-colors t :input-echoing nil :cursor-visibility nil :input-reading :unbuffered) (splash-screen scr) - (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -87,8 +87,7 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) - ((nil) (logging "Detected NIL event.") - (update-ui mapwin playerwin placewin newswin me)) + ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) @@ -155,7 +154,6 @@ (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - ;;TODO (clear win) (move win 0 0) (add-string win (car news)) @@ -171,21 +169,23 @@ (defun message-window () "Return a dialog window with the last game messages." ;;TODO complete + ;;FIXME causes an error somewhere in the croatoan library... (make-instance 'dialog-window :input-blocking t - :items (mapcar - #'(lambda (n) (break-lines - (string-from-list (list "*" n)) 50) - news) + :items (break-lines + (mapcar #'(lambda (n) (string-from-list (list "*" n))) + news) + 50) :center t :border t + :stacked t :layout nil :title "Game messages" - :max-item-length 50)))) - ;:scrolled-layout '(10 1) - ;; :message-height 2 - ;; :message-text "Press b to go back." - ;; :event-handlers '((#\b #'exit-event-loop))))) + :max-item-length 50 + :scrolled-layout '(10 1) + :message-height 2 + :message-text "Press b to go back."))) + ;;:event-handlers '((#\b #'exit-event-loop))))) (defun process-command (event) ;;TODO diff --git a/server.lisp b/server.lisp new file mode 100644 index 0000000..11e2e3a --- /dev/null +++ b/server.lisp @@ -0,0 +1,111 @@ +;;;; +;;;; 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) ) diff --git a/data.lisp b/data.lisp deleted file mode 100644 index c89241e..0000000 --- a/data.lisp +++ /dev/null @@ -1,56 +0,0 @@ -;;;; -;;;; Naledi ya Africa ("Star of Africa") is an ncurses-based survival game -;;;; set in Africa. -;;;; -;;;; This file stores all game data. -;;;; -;;;; (c) 2018 Daniel Vedder, MIT license -;;;; - -;; TODO save and load functions -;; XXX Will probably require `make-load-form-saving-slots' - -;;; PATCHES - -(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))))) - -;;; BIOMES - -(let ((biome-list NIL)) - (defun register-biome (symbol-name biome-object) - (setf biome-list (cons (list symbol-name biome-object) biome-list))) - - (defun available-biomes () - (keys biome-list)) - - (defun get-biome (symbol-name) - (cassoc symbol-name biome-list))) - -(defmacro new-biome (name &body body) - `(register-biome ',name - (make-biome - :name ,(symbol-to-string name) - ,@body))) diff --git a/naledi.lisp b/naledi.lisp index bc60f7b..ee950eb 100644 --- a/naledi.lisp +++ b/naledi.lisp @@ -10,32 +10,32 @@ (defparameter *debugging* T) (defparameter *logfile* "naledi.log") +(defparameter *world-size* 250) (defparameter *framerate* 1000) +(defparameter *port* 21895) (ql:quickload :bordeaux-threads) (ql:quickload :croatoan) +(ql:quickload :usocket) (use-package :croatoan) +(use-package :usocket) (load "util.lisp") (load "item-classes.lisp") (load "item-methods.lisp") -(load "data.lisp") (load "world.lisp") (load "items.lisp") (load "biomes.lisp") (load "animals.lisp") +(load "server.lisp") (defun start-game () - ;;Initialize the log and random state - (write-to-file "NALEDI ya AFRICA" *logfile*) - (logging (time-stamp)) - (setf *random-state* (make-random-state t)) - (create-world 250) + "Start the game logic and UI" + (start-server) (with-screen (scr :input-blocking *framerate* :enable-colors t :input-echoing nil :cursor-visibility nil :input-reading :unbuffered) (splash-screen scr) - (run-world) (user-interface scr))) (defun splash-screen (scr) @@ -87,8 +87,7 @@ placewin newswin me)) (:right (incf (first me)) (update-ui mapwin playerwin placewin newswin me)) - ((nil) (logging "Detected NIL event.") - (update-ui mapwin playerwin placewin newswin me)) + ((nil) (update-ui mapwin playerwin placewin newswin me)) (otherwise (notify (string event))))))) (defun update-ui (mapwin playerwin placewin newswin me) @@ -155,7 +154,6 @@ (let ((news '("Press h for help."))) (defun draw-news-panel (win) "Draw a thin panel at the bottom of the screen to display news items." - ;;TODO (clear win) (move win 0 0) (add-string win (car news)) @@ -171,21 +169,23 @@ (defun message-window () "Return a dialog window with the last game messages." ;;TODO complete + ;;FIXME causes an error somewhere in the croatoan library... (make-instance 'dialog-window :input-blocking t - :items (mapcar - #'(lambda (n) (break-lines - (string-from-list (list "*" n)) 50) - news) + :items (break-lines + (mapcar #'(lambda (n) (string-from-list (list "*" n))) + news) + 50) :center t :border t + :stacked t :layout nil :title "Game messages" - :max-item-length 50)))) - ;:scrolled-layout '(10 1) - ;; :message-height 2 - ;; :message-text "Press b to go back." - ;; :event-handlers '((#\b #'exit-event-loop))))) + :max-item-length 50 + :scrolled-layout '(10 1) + :message-height 2 + :message-text "Press b to go back."))) + ;;:event-handlers '((#\b #'exit-event-loop))))) (defun process-command (event) ;;TODO diff --git a/server.lisp b/server.lisp new file mode 100644 index 0000000..11e2e3a --- /dev/null +++ b/server.lisp @@ -0,0 +1,111 @@ +;;;; +;;;; 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) ) diff --git a/world.lisp b/world.lisp index 8104d48..6f137b1 100644 --- a/world.lisp +++ b/world.lisp @@ -22,6 +22,23 @@ (char #\.) ;default map display character (col ':white)) ;default map display colour +;; BIOME LIST + +(let ((biome-list NIL)) + (defun register-biome (symbol-name biome-object) + (setf biome-list (cons (list symbol-name biome-object) biome-list))) + + (defun available-biomes () + (keys biome-list)) + + (defun get-biome (symbol-name) + (cassoc symbol-name biome-list))) + +(defmacro new-biome (name &body body) + `(register-biome ',name + (make-biome + :name ,(symbol-to-string name) + ,@body))) ;; MATRIX FUNCTIONS @@ -155,47 +172,19 @@ (setf (patch-occupant patch) NIL))) (defun create-world (size) + "Create a world of the specified size (square)" (set-world (init-matrix size)) ;;XXX magic numbers (generate-biomes 10) (dotimes (s (round (/ (expt size 2) 2000))) (generate-stream (random size) (random size)))) -;;TODO This section needs to go somewhere else (naledi-server?) -(let ((uptime 0) (running NIL) (world-thread NIL)) - (defun run-world () - (setf running T) - (setf world-thread - (bt:make-thread #'update-loop :name "world-thread"))) - - (defun interrupt-world () (setf running NIL)) - - (defun terminate () - (notify "Terminating the world.") - (interrupt-world) - (bt:join-thread world-thread)) - - (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" - ;;Update all items and occupants in each patch - (dotimes (y (world-size)) - (dotimes (x (world-size)) - (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) - (logging "Ran update ~S." uptime) - (sleep (/ *framerate* 1000)) - (when running (update-loop)))) ;;requires Tail-Call Optimization +(defun init-world () + "Initialize the log, RNG, and world." + (write-to-file "NALEDI ya AFRICA" *logfile*) + (logging (time-stamp)) + (setf *random-state* (make-random-state t)) + (create-world *world-size*)) (defun describe-patch (p) "Return a list of lines describing this patch."