diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 622f9a8..083b01f 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -25,11 +25,11 @@ :class (get-game-object 'character-class "Burglar") :place (world-starting-place *world*) :strength 6 :constitution 12 - :dexterity 19 :intelligence 14))) + :dexterity 19 :intelligence 14 + :game-admin T))) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player)) - (setf (world-game-manager *world*) (player-name player)) (play-game (player-name player)))) (defun start-server () @@ -49,11 +49,11 @@ (while (not (= (count-instances #\. server-ip) 3)) (format t "~&Not an IP address: ~A. Please reenter:" server-ip) (input-string server-ip)) - (setf (cassoc ip *server-address*) server-ip) + ;(setf (cassoc ip *server-address*) server-ip) (format t "~&What port does the game run on?") (while (not (numberp (input server-port))) (format t "~&Not a number: ~A. Please reenter:" server-port)) - (setf (cassoc port *server-address*) server-port) + ;(setf (cassoc port *server-address*) server-port) (format t "~&What is your player name?") (input-string name) (format t "~&Joining game on ~A:~A as ~A" server-ip server-port name) @@ -62,8 +62,22 @@ (defun single-player () "Start a single-player game" - ;; TODO - ) + (format t "~&What do you want to do?") + (setf options '("Start a new game" "Load a game" "Back to menu")) + (case (choose-number-option options) + (0 (format t "~&What world file do you want to load?") + (input-string world-file) + (format t "~&What is your name?") + (input-string name) + (load-file world-file) + (play-game name)) + (1 (format t "~&What game file do you want to load?") + (input-string game) + (format t "~&What is your name?") + (input-string name) + (load-game game) + (play-game name)) + (2 (start-menu)))) (defun print-version () (format t "~&Lisp Atlantis ~A.~A.~A" @@ -75,22 +89,22 @@ (defun start-menu () "Show the start menu and take a choice from the user" - (dolist (line (load-text-file "banner.txt")) - (unless (null line) (format t "~%~A" line))) + (print-text-file "banner.txt") (format t "~&~%Welcome! What do you want to do?") (setf options '("Start a server" "Join a game" "Play single-player" "Develop" "About" "Exit")) - (setf choice (choose-option options)) - (case choice + (case (choose-number-option options) (0 (start-server)) (1 (join-game)) (2 (single-player)) (3 (development)) (4 (print-version) + (when (y-or-n-p "Show the license text?") + (print-text-file "../LICENSE")) (start-menu)) (5 (format t "~&Goodbye!") (quit)))) - + (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." (let ((argument (member name *args* :test #'equalp))) diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 622f9a8..083b01f 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -25,11 +25,11 @@ :class (get-game-object 'character-class "Burglar") :place (world-starting-place *world*) :strength 6 :constitution 12 - :dexterity 19 :intelligence 14))) + :dexterity 19 :intelligence 14 + :game-admin T))) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player)) - (setf (world-game-manager *world*) (player-name player)) (play-game (player-name player)))) (defun start-server () @@ -49,11 +49,11 @@ (while (not (= (count-instances #\. server-ip) 3)) (format t "~&Not an IP address: ~A. Please reenter:" server-ip) (input-string server-ip)) - (setf (cassoc ip *server-address*) server-ip) + ;(setf (cassoc ip *server-address*) server-ip) (format t "~&What port does the game run on?") (while (not (numberp (input server-port))) (format t "~&Not a number: ~A. Please reenter:" server-port)) - (setf (cassoc port *server-address*) server-port) + ;(setf (cassoc port *server-address*) server-port) (format t "~&What is your player name?") (input-string name) (format t "~&Joining game on ~A:~A as ~A" server-ip server-port name) @@ -62,8 +62,22 @@ (defun single-player () "Start a single-player game" - ;; TODO - ) + (format t "~&What do you want to do?") + (setf options '("Start a new game" "Load a game" "Back to menu")) + (case (choose-number-option options) + (0 (format t "~&What world file do you want to load?") + (input-string world-file) + (format t "~&What is your name?") + (input-string name) + (load-file world-file) + (play-game name)) + (1 (format t "~&What game file do you want to load?") + (input-string game) + (format t "~&What is your name?") + (input-string name) + (load-game game) + (play-game name)) + (2 (start-menu)))) (defun print-version () (format t "~&Lisp Atlantis ~A.~A.~A" @@ -75,22 +89,22 @@ (defun start-menu () "Show the start menu and take a choice from the user" - (dolist (line (load-text-file "banner.txt")) - (unless (null line) (format t "~%~A" line))) + (print-text-file "banner.txt") (format t "~&~%Welcome! What do you want to do?") (setf options '("Start a server" "Join a game" "Play single-player" "Develop" "About" "Exit")) - (setf choice (choose-option options)) - (case choice + (case (choose-number-option options) (0 (start-server)) (1 (join-game)) (2 (single-player)) (3 (development)) (4 (print-version) + (when (y-or-n-p "Show the license text?") + (print-text-file "../LICENSE")) (start-menu)) (5 (format t "~&Goodbye!") (quit)))) - + (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." (let ((argument (member name *args* :test #'equalp))) diff --git a/lisp/player.lisp b/lisp/player.lisp index c989c22..ef83953 100644 --- a/lisp/player.lisp +++ b/lisp/player.lisp @@ -22,7 +22,8 @@ (weapon NIL) (place "") (experience 0) - (health 0)) + (health 0) + (game-admin NIL)) (defstruct race diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 622f9a8..083b01f 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -25,11 +25,11 @@ :class (get-game-object 'character-class "Burglar") :place (world-starting-place *world*) :strength 6 :constitution 12 - :dexterity 19 :intelligence 14))) + :dexterity 19 :intelligence 14 + :game-admin T))) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player)) - (setf (world-game-manager *world*) (player-name player)) (play-game (player-name player)))) (defun start-server () @@ -49,11 +49,11 @@ (while (not (= (count-instances #\. server-ip) 3)) (format t "~&Not an IP address: ~A. Please reenter:" server-ip) (input-string server-ip)) - (setf (cassoc ip *server-address*) server-ip) + ;(setf (cassoc ip *server-address*) server-ip) (format t "~&What port does the game run on?") (while (not (numberp (input server-port))) (format t "~&Not a number: ~A. Please reenter:" server-port)) - (setf (cassoc port *server-address*) server-port) + ;(setf (cassoc port *server-address*) server-port) (format t "~&What is your player name?") (input-string name) (format t "~&Joining game on ~A:~A as ~A" server-ip server-port name) @@ -62,8 +62,22 @@ (defun single-player () "Start a single-player game" - ;; TODO - ) + (format t "~&What do you want to do?") + (setf options '("Start a new game" "Load a game" "Back to menu")) + (case (choose-number-option options) + (0 (format t "~&What world file do you want to load?") + (input-string world-file) + (format t "~&What is your name?") + (input-string name) + (load-file world-file) + (play-game name)) + (1 (format t "~&What game file do you want to load?") + (input-string game) + (format t "~&What is your name?") + (input-string name) + (load-game game) + (play-game name)) + (2 (start-menu)))) (defun print-version () (format t "~&Lisp Atlantis ~A.~A.~A" @@ -75,22 +89,22 @@ (defun start-menu () "Show the start menu and take a choice from the user" - (dolist (line (load-text-file "banner.txt")) - (unless (null line) (format t "~%~A" line))) + (print-text-file "banner.txt") (format t "~&~%Welcome! What do you want to do?") (setf options '("Start a server" "Join a game" "Play single-player" "Develop" "About" "Exit")) - (setf choice (choose-option options)) - (case choice + (case (choose-number-option options) (0 (start-server)) (1 (join-game)) (2 (single-player)) (3 (development)) (4 (print-version) + (when (y-or-n-p "Show the license text?") + (print-text-file "../LICENSE")) (start-menu)) (5 (format t "~&Goodbye!") (quit)))) - + (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." (let ((argument (member name *args* :test #'equalp))) diff --git a/lisp/player.lisp b/lisp/player.lisp index c989c22..ef83953 100644 --- a/lisp/player.lisp +++ b/lisp/player.lisp @@ -22,7 +22,8 @@ (weapon NIL) (place "") (experience 0) - (health 0)) + (health 0) + (game-admin NIL)) (defstruct race diff --git a/lisp/ui.lisp b/lisp/ui.lisp index e51c597..e7eeda8 100644 --- a/lisp/ui.lisp +++ b/lisp/ui.lisp @@ -14,14 +14,13 @@ (let ((player NIL)) (defun play-game (player-name) "The main game loop" - ;(update-world) ;; Initialize the player if necessary (when (null player) (setf player (get-game-object 'player player-name))) (when (null player) (setf player (create-player player-name)) (when (null (list-world-objects 'player)) - (setf (world-game-manager *world*) (player-name player))) + (setf (player-game-admin player) T)) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player))) @@ -31,15 +30,12 @@ (input-string command) (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) - ;(server-send (game-command command player)) - ;(update-world) (input-string command)) (format t "~&Goodbye!")))) (defun create-player (player-name) "The user creates a new player" - ;; XXX This function feels somewhat inelegant - lot's of repetetive stuff. - ;; Is it worth cleaning up? + ;; XXX This function feels somewhat ugly - any possibility of a cleanup? (let ((player (make-player :name player-name :place (world-starting-place *world*))) (race NIL) (character-class NIL) @@ -52,20 +48,11 @@ (unless (y-or-n-p "~&Create a new player?") (start-menu)) ;; Chose race and class (format t "~&Please chose a race:") - (format t "~&Options: ~A" (string-from-list (list-world-objects 'race))) - (setf race (input-string)) - (while (not (member race (list-world-objects 'race) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf race (input-string))) + (setf race (choose-option (list-world-objects 'race))) (setf (player-race player) (get-game-object 'race race)) (format t "~&Please chose a class:") - (format t "~&Options: ~A" (string-from-list - (list-world-objects 'character-class))) - (setf character-class (input-string)) - (while (not (member character-class - (list-world-objects 'character-class) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf character-class (input-string))) + (setf character-class + (choose-option (list-world-objects 'character-class))) (setf (player-class player) (get-game-object 'character-class character-class)) ;; Set character attributes @@ -123,7 +110,7 @@ ;; A list of all in-game commands. Each new command must be registered here. (defvar *commands* - '(help place player goto)) + '(help place player goto save)) ;;; The following commands don't take any arguments except for a player @@ -137,8 +124,7 @@ (format t "~&place~A-~ADescribe the current location" tab tab) (format t "~&player~A-~ADescribe your player" tab tab) (format t "~&goto ~A-~AGo to a neighbouring location" tab tab) - (when (equalp (player-name player) (world-game-manager *world*)) - (format t "~&load ~A-~ALoad a saved game" tab tab) + (when (player-game-admin player) (format t "~&save ~A-~ASave the game to file" tab tab)))) ;; XXX Will the following two functions give problems? (Their name is @@ -186,3 +172,10 @@ 'player (player-name player)) (describe-place location)) +(defun save (player &optional game-file) + "Save a game to file (wrapper method around save-world)" + (unless game-file + (format t "~&Where do you want to save the game?") + (input-string game-file)) + (save-world game-file) + (format t "~&Game saved.")) diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 622f9a8..083b01f 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -25,11 +25,11 @@ :class (get-game-object 'character-class "Burglar") :place (world-starting-place *world*) :strength 6 :constitution 12 - :dexterity 19 :intelligence 14))) + :dexterity 19 :intelligence 14 + :game-admin T))) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player)) - (setf (world-game-manager *world*) (player-name player)) (play-game (player-name player)))) (defun start-server () @@ -49,11 +49,11 @@ (while (not (= (count-instances #\. server-ip) 3)) (format t "~&Not an IP address: ~A. Please reenter:" server-ip) (input-string server-ip)) - (setf (cassoc ip *server-address*) server-ip) + ;(setf (cassoc ip *server-address*) server-ip) (format t "~&What port does the game run on?") (while (not (numberp (input server-port))) (format t "~&Not a number: ~A. Please reenter:" server-port)) - (setf (cassoc port *server-address*) server-port) + ;(setf (cassoc port *server-address*) server-port) (format t "~&What is your player name?") (input-string name) (format t "~&Joining game on ~A:~A as ~A" server-ip server-port name) @@ -62,8 +62,22 @@ (defun single-player () "Start a single-player game" - ;; TODO - ) + (format t "~&What do you want to do?") + (setf options '("Start a new game" "Load a game" "Back to menu")) + (case (choose-number-option options) + (0 (format t "~&What world file do you want to load?") + (input-string world-file) + (format t "~&What is your name?") + (input-string name) + (load-file world-file) + (play-game name)) + (1 (format t "~&What game file do you want to load?") + (input-string game) + (format t "~&What is your name?") + (input-string name) + (load-game game) + (play-game name)) + (2 (start-menu)))) (defun print-version () (format t "~&Lisp Atlantis ~A.~A.~A" @@ -75,22 +89,22 @@ (defun start-menu () "Show the start menu and take a choice from the user" - (dolist (line (load-text-file "banner.txt")) - (unless (null line) (format t "~%~A" line))) + (print-text-file "banner.txt") (format t "~&~%Welcome! What do you want to do?") (setf options '("Start a server" "Join a game" "Play single-player" "Develop" "About" "Exit")) - (setf choice (choose-option options)) - (case choice + (case (choose-number-option options) (0 (start-server)) (1 (join-game)) (2 (single-player)) (3 (development)) (4 (print-version) + (when (y-or-n-p "Show the license text?") + (print-text-file "../LICENSE")) (start-menu)) (5 (format t "~&Goodbye!") (quit)))) - + (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." (let ((argument (member name *args* :test #'equalp))) diff --git a/lisp/player.lisp b/lisp/player.lisp index c989c22..ef83953 100644 --- a/lisp/player.lisp +++ b/lisp/player.lisp @@ -22,7 +22,8 @@ (weapon NIL) (place "") (experience 0) - (health 0)) + (health 0) + (game-admin NIL)) (defstruct race diff --git a/lisp/ui.lisp b/lisp/ui.lisp index e51c597..e7eeda8 100644 --- a/lisp/ui.lisp +++ b/lisp/ui.lisp @@ -14,14 +14,13 @@ (let ((player NIL)) (defun play-game (player-name) "The main game loop" - ;(update-world) ;; Initialize the player if necessary (when (null player) (setf player (get-game-object 'player player-name))) (when (null player) (setf player (create-player player-name)) (when (null (list-world-objects 'player)) - (setf (world-game-manager *world*) (player-name player))) + (setf (player-game-admin player) T)) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player))) @@ -31,15 +30,12 @@ (input-string command) (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) - ;(server-send (game-command command player)) - ;(update-world) (input-string command)) (format t "~&Goodbye!")))) (defun create-player (player-name) "The user creates a new player" - ;; XXX This function feels somewhat inelegant - lot's of repetetive stuff. - ;; Is it worth cleaning up? + ;; XXX This function feels somewhat ugly - any possibility of a cleanup? (let ((player (make-player :name player-name :place (world-starting-place *world*))) (race NIL) (character-class NIL) @@ -52,20 +48,11 @@ (unless (y-or-n-p "~&Create a new player?") (start-menu)) ;; Chose race and class (format t "~&Please chose a race:") - (format t "~&Options: ~A" (string-from-list (list-world-objects 'race))) - (setf race (input-string)) - (while (not (member race (list-world-objects 'race) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf race (input-string))) + (setf race (choose-option (list-world-objects 'race))) (setf (player-race player) (get-game-object 'race race)) (format t "~&Please chose a class:") - (format t "~&Options: ~A" (string-from-list - (list-world-objects 'character-class))) - (setf character-class (input-string)) - (while (not (member character-class - (list-world-objects 'character-class) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf character-class (input-string))) + (setf character-class + (choose-option (list-world-objects 'character-class))) (setf (player-class player) (get-game-object 'character-class character-class)) ;; Set character attributes @@ -123,7 +110,7 @@ ;; A list of all in-game commands. Each new command must be registered here. (defvar *commands* - '(help place player goto)) + '(help place player goto save)) ;;; The following commands don't take any arguments except for a player @@ -137,8 +124,7 @@ (format t "~&place~A-~ADescribe the current location" tab tab) (format t "~&player~A-~ADescribe your player" tab tab) (format t "~&goto ~A-~AGo to a neighbouring location" tab tab) - (when (equalp (player-name player) (world-game-manager *world*)) - (format t "~&load ~A-~ALoad a saved game" tab tab) + (when (player-game-admin player) (format t "~&save ~A-~ASave the game to file" tab tab)))) ;; XXX Will the following two functions give problems? (Their name is @@ -186,3 +172,10 @@ 'player (player-name player)) (describe-place location)) +(defun save (player &optional game-file) + "Save a game to file (wrapper method around save-world)" + (unless game-file + (format t "~&Where do you want to save the game?") + (input-string game-file)) + (save-world game-file) + (format t "~&Game saved.")) diff --git a/lisp/util.lisp b/lisp/util.lisp index bfd5a3f..16b4d49 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -159,6 +159,11 @@ (file-lines (list line) (append file-lines (list line)))) ((null line) file-lines)))) +(defun print-text-file (file-name) + "Print out the contents of this text file" + (dolist (line (load-text-file file-name)) + (unless (null line) (format t "~%~A" line)))) + (defun build-symbol (&rest components) "Concatenate the passed components into a single symbol" (read-from-string (string-from-list components ""))) @@ -176,7 +181,7 @@ (setf name-list (cons (funcall get-object-name object) name-list)))))) -(defun choose-option (option-list) +(defun choose-number-option (option-list) "The user chooses one out of a list of options, the index is returned" (dotimes (i (length option-list)) (format t "~&~S) ~A" (1+ i) (nth i option-list))) @@ -187,6 +192,11 @@ (simple-input choice)) (1- choice)) +(defun choose-option (option-list) + "Like choose-number-option, but return the value of the choice" + ;; Basically just a utility wrapper + (nth (choose-number-option option-list) option-list)) + (defun repl () "Launch a read-eval-print loop" (let ((expr (simple-input expr "lisp >"))) diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 622f9a8..083b01f 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -25,11 +25,11 @@ :class (get-game-object 'character-class "Burglar") :place (world-starting-place *world*) :strength 6 :constitution 12 - :dexterity 19 :intelligence 14))) + :dexterity 19 :intelligence 14 + :game-admin T))) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player)) - (setf (world-game-manager *world*) (player-name player)) (play-game (player-name player)))) (defun start-server () @@ -49,11 +49,11 @@ (while (not (= (count-instances #\. server-ip) 3)) (format t "~&Not an IP address: ~A. Please reenter:" server-ip) (input-string server-ip)) - (setf (cassoc ip *server-address*) server-ip) + ;(setf (cassoc ip *server-address*) server-ip) (format t "~&What port does the game run on?") (while (not (numberp (input server-port))) (format t "~&Not a number: ~A. Please reenter:" server-port)) - (setf (cassoc port *server-address*) server-port) + ;(setf (cassoc port *server-address*) server-port) (format t "~&What is your player name?") (input-string name) (format t "~&Joining game on ~A:~A as ~A" server-ip server-port name) @@ -62,8 +62,22 @@ (defun single-player () "Start a single-player game" - ;; TODO - ) + (format t "~&What do you want to do?") + (setf options '("Start a new game" "Load a game" "Back to menu")) + (case (choose-number-option options) + (0 (format t "~&What world file do you want to load?") + (input-string world-file) + (format t "~&What is your name?") + (input-string name) + (load-file world-file) + (play-game name)) + (1 (format t "~&What game file do you want to load?") + (input-string game) + (format t "~&What is your name?") + (input-string name) + (load-game game) + (play-game name)) + (2 (start-menu)))) (defun print-version () (format t "~&Lisp Atlantis ~A.~A.~A" @@ -75,22 +89,22 @@ (defun start-menu () "Show the start menu and take a choice from the user" - (dolist (line (load-text-file "banner.txt")) - (unless (null line) (format t "~%~A" line))) + (print-text-file "banner.txt") (format t "~&~%Welcome! What do you want to do?") (setf options '("Start a server" "Join a game" "Play single-player" "Develop" "About" "Exit")) - (setf choice (choose-option options)) - (case choice + (case (choose-number-option options) (0 (start-server)) (1 (join-game)) (2 (single-player)) (3 (development)) (4 (print-version) + (when (y-or-n-p "Show the license text?") + (print-text-file "../LICENSE")) (start-menu)) (5 (format t "~&Goodbye!") (quit)))) - + (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." (let ((argument (member name *args* :test #'equalp))) diff --git a/lisp/player.lisp b/lisp/player.lisp index c989c22..ef83953 100644 --- a/lisp/player.lisp +++ b/lisp/player.lisp @@ -22,7 +22,8 @@ (weapon NIL) (place "") (experience 0) - (health 0)) + (health 0) + (game-admin NIL)) (defstruct race diff --git a/lisp/ui.lisp b/lisp/ui.lisp index e51c597..e7eeda8 100644 --- a/lisp/ui.lisp +++ b/lisp/ui.lisp @@ -14,14 +14,13 @@ (let ((player NIL)) (defun play-game (player-name) "The main game loop" - ;(update-world) ;; Initialize the player if necessary (when (null player) (setf player (get-game-object 'player player-name))) (when (null player) (setf player (create-player player-name)) (when (null (list-world-objects 'player)) - (setf (world-game-manager *world*) (player-name player))) + (setf (player-game-admin player) T)) (add-game-object player) (set-object-attribute (get-game-object 'place (player-place player)) 'player (player-name player))) @@ -31,15 +30,12 @@ (input-string command) (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) - ;(server-send (game-command command player)) - ;(update-world) (input-string command)) (format t "~&Goodbye!")))) (defun create-player (player-name) "The user creates a new player" - ;; XXX This function feels somewhat inelegant - lot's of repetetive stuff. - ;; Is it worth cleaning up? + ;; XXX This function feels somewhat ugly - any possibility of a cleanup? (let ((player (make-player :name player-name :place (world-starting-place *world*))) (race NIL) (character-class NIL) @@ -52,20 +48,11 @@ (unless (y-or-n-p "~&Create a new player?") (start-menu)) ;; Chose race and class (format t "~&Please chose a race:") - (format t "~&Options: ~A" (string-from-list (list-world-objects 'race))) - (setf race (input-string)) - (while (not (member race (list-world-objects 'race) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf race (input-string))) + (setf race (choose-option (list-world-objects 'race))) (setf (player-race player) (get-game-object 'race race)) (format t "~&Please chose a class:") - (format t "~&Options: ~A" (string-from-list - (list-world-objects 'character-class))) - (setf character-class (input-string)) - (while (not (member character-class - (list-world-objects 'character-class) :test #'equalp)) - (format t "~&Invalid choice. Please reenter:") - (setf character-class (input-string))) + (setf character-class + (choose-option (list-world-objects 'character-class))) (setf (player-class player) (get-game-object 'character-class character-class)) ;; Set character attributes @@ -123,7 +110,7 @@ ;; A list of all in-game commands. Each new command must be registered here. (defvar *commands* - '(help place player goto)) + '(help place player goto save)) ;;; The following commands don't take any arguments except for a player @@ -137,8 +124,7 @@ (format t "~&place~A-~ADescribe the current location" tab tab) (format t "~&player~A-~ADescribe your player" tab tab) (format t "~&goto ~A-~AGo to a neighbouring location" tab tab) - (when (equalp (player-name player) (world-game-manager *world*)) - (format t "~&load ~A-~ALoad a saved game" tab tab) + (when (player-game-admin player) (format t "~&save ~A-~ASave the game to file" tab tab)))) ;; XXX Will the following two functions give problems? (Their name is @@ -186,3 +172,10 @@ 'player (player-name player)) (describe-place location)) +(defun save (player &optional game-file) + "Save a game to file (wrapper method around save-world)" + (unless game-file + (format t "~&Where do you want to save the game?") + (input-string game-file)) + (save-world game-file) + (format t "~&Game saved.")) diff --git a/lisp/util.lisp b/lisp/util.lisp index bfd5a3f..16b4d49 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -159,6 +159,11 @@ (file-lines (list line) (append file-lines (list line)))) ((null line) file-lines)))) +(defun print-text-file (file-name) + "Print out the contents of this text file" + (dolist (line (load-text-file file-name)) + (unless (null line) (format t "~%~A" line)))) + (defun build-symbol (&rest components) "Concatenate the passed components into a single symbol" (read-from-string (string-from-list components ""))) @@ -176,7 +181,7 @@ (setf name-list (cons (funcall get-object-name object) name-list)))))) -(defun choose-option (option-list) +(defun choose-number-option (option-list) "The user chooses one out of a list of options, the index is returned" (dotimes (i (length option-list)) (format t "~&~S) ~A" (1+ i) (nth i option-list))) @@ -187,6 +192,11 @@ (simple-input choice)) (1- choice)) +(defun choose-option (option-list) + "Like choose-number-option, but return the value of the choice" + ;; Basically just a utility wrapper + (nth (choose-number-option option-list) option-list)) + (defun repl () "Launch a read-eval-print loop" (let ((expr (simple-input expr "lisp >"))) diff --git a/lisp/world.lisp b/lisp/world.lisp index 0b84a15..4694c78 100644 --- a/lisp/world.lisp +++ b/lisp/world.lisp @@ -26,8 +26,7 @@ (npcs NIL) (items NIL) (weapons NIL) - (starting-place "") - (game-manager "")) ;The player in charge of the game + (starting-place "")) (setf *world* (make-world)) ;XXX Move this to another module? @@ -58,3 +57,22 @@ (setf (world-name *world*) name) NIL) +(defun load-game (game-file) + "Load a saved game from disk" + (with-open-file (g game-file) + (let ((version-number (read g)) + (loaded-world (read g))) + ;; XXX This introduces UI in a non-UI module... + (when (!= version-number ATLANTIS-VERSION :test equal) + (format t "~&WARNING: The loaded world was saved by a different") + (format t " version of Atlantis!") + (unless (yes-or-no-p "Continue anyway?") + (start-menu))) + (if (world-p loaded-world) + (setf *world* loaded-world) + (error "World file ~A is corrupted!" game-file))))) + +(defun save-world (game-file) + "Save a game to file" + (with-open-file (g game-file :direction :output) + (format g "~S~%~S~%" ATLANTIS-VERSION *world*)))