diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/lisp-test.atl b/ATL/lisp-test.atl index c95dd2f..990bcbc 100644 --- a/ATL/lisp-test.atl +++ b/ATL/lisp-test.atl @@ -2,8 +2,7 @@ ; @author Daniel Vedder ; @date 04/05/2015 -; TODO change the name of this command? -name-world "Westernesse" +name-world "Underworld" define-place "Nowhere" description "Welcome to Nowhere! diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/lisp-test.atl b/ATL/lisp-test.atl index c95dd2f..990bcbc 100644 --- a/ATL/lisp-test.atl +++ b/ATL/lisp-test.atl @@ -2,8 +2,7 @@ ; @author Daniel Vedder ; @date 04/05/2015 -; TODO change the name of this command? -name-world "Westernesse" +name-world "Underworld" define-place "Nowhere" description "Welcome to Nowhere! diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 0e0c3a7..7150ab6 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -24,6 +24,8 @@ :strength 6 :constitution 12 :dexterity 19 :intelligence 14))) (add-game-object player) + (set-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (play-game (player-name player)))) (defun start-server () diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/lisp-test.atl b/ATL/lisp-test.atl index c95dd2f..990bcbc 100644 --- a/ATL/lisp-test.atl +++ b/ATL/lisp-test.atl @@ -2,8 +2,7 @@ ; @author Daniel Vedder ; @date 04/05/2015 -; TODO change the name of this command? -name-world "Westernesse" +name-world "Underworld" define-place "Nowhere" description "Welcome to Nowhere! diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 0e0c3a7..7150ab6 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -24,6 +24,8 @@ :strength 6 :constitution 12 :dexterity 19 :intelligence 14))) (add-game-object player) + (set-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (play-game (player-name player)))) (defun start-server () diff --git a/lisp/client.lisp b/lisp/client.lisp index 3a99a98..61e1682 100644 --- a/lisp/client.lisp +++ b/lisp/client.lisp @@ -26,7 +26,7 @@ (let ((place (get-game-object 'place (player-place player)))) (describe-place place) (input-string command) - (while (!= (read-from-string command) 'quit) + (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) (input-string command)) (format t "~&Goodbye!")))) @@ -91,6 +91,8 @@ (defun describe-place (p) "Print out a complete description of place p" + (when (stringp p) + (setf p (get-game-object 'place p))) (format t "~&~%~A" (place-description p)) (format t "~&Neighbouring places: ~A" (string-from-list (place-neighbour p))) (format t "~&Players present: ~A" (string-from-list (place-player p))) @@ -98,22 +100,57 @@ (defun game-command (cmd player) "Execute a typed-in game command" + ;; TODO Instead of converting typed-in text into a function call, would it + ;; be better to keep an association list (command:function)? That would + ;; mean some more book-keeping, but would prevent ugly/fatal error messages. (let ((space (position #\Space cmd))) (if space (call-function (read-from-string cmd) - (read-from-string (second (cut-string cmd space))) player) + (second (cut-string cmd (1+ space))) player) (call-function (read-from-string cmd) player)))) -;;; Here follow the functions that define the in-game commands. -;;; All of them have to take exactly two argument (the argument -;;; to the function and a player instance). -(defun help (&optional arg player) +;;; +;;; Here follow the functions that define the in-game commands. +;;; + +;;; The following commands consist of only one word and take only one argument + +(defun help (&optional player) "Print out a list of in-game commands" - (format t "~&Sorry, not yet available!")) + (let ((tab (string #\tab))) + (format t "~&Commands:~%") + (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))) + +;; XXX Will the following two functions give problems? +;; (Their name is identical with the struct name) +(defun place (player) + "Describe the player's current location" + (describe-place (player-place player))) + +(defun player (player) + "Print a description of this player" + ;; TODO + ) + +;;; These next functions have to take exactly two argument (the argument +;;; to the function and a player instance). (defun goto (location player) "Go to the specified location" + (format t "~&~A is going to ~A." (player-name player) location) + (when (symbolp location) (setf location (symbol-name location))) + (when (not (member location + (place-neighbour (get-game-object 'place + (player-place player))) + :test #'equalp)) + (format t "~&This place does not border your current location!") + (return-from goto NIL)) + (remove-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (set-object-attribute player 'place location) (set-object-attribute (get-game-object 'place (player-place player)) - 'player (player-name player))) + 'player (player-name player)) + (describe-place location)) diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/lisp-test.atl b/ATL/lisp-test.atl index c95dd2f..990bcbc 100644 --- a/ATL/lisp-test.atl +++ b/ATL/lisp-test.atl @@ -2,8 +2,7 @@ ; @author Daniel Vedder ; @date 04/05/2015 -; TODO change the name of this command? -name-world "Westernesse" +name-world "Underworld" define-place "Nowhere" description "Welcome to Nowhere! diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 0e0c3a7..7150ab6 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -24,6 +24,8 @@ :strength 6 :constitution 12 :dexterity 19 :intelligence 14))) (add-game-object player) + (set-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (play-game (player-name player)))) (defun start-server () diff --git a/lisp/client.lisp b/lisp/client.lisp index 3a99a98..61e1682 100644 --- a/lisp/client.lisp +++ b/lisp/client.lisp @@ -26,7 +26,7 @@ (let ((place (get-game-object 'place (player-place player)))) (describe-place place) (input-string command) - (while (!= (read-from-string command) 'quit) + (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) (input-string command)) (format t "~&Goodbye!")))) @@ -91,6 +91,8 @@ (defun describe-place (p) "Print out a complete description of place p" + (when (stringp p) + (setf p (get-game-object 'place p))) (format t "~&~%~A" (place-description p)) (format t "~&Neighbouring places: ~A" (string-from-list (place-neighbour p))) (format t "~&Players present: ~A" (string-from-list (place-player p))) @@ -98,22 +100,57 @@ (defun game-command (cmd player) "Execute a typed-in game command" + ;; TODO Instead of converting typed-in text into a function call, would it + ;; be better to keep an association list (command:function)? That would + ;; mean some more book-keeping, but would prevent ugly/fatal error messages. (let ((space (position #\Space cmd))) (if space (call-function (read-from-string cmd) - (read-from-string (second (cut-string cmd space))) player) + (second (cut-string cmd (1+ space))) player) (call-function (read-from-string cmd) player)))) -;;; Here follow the functions that define the in-game commands. -;;; All of them have to take exactly two argument (the argument -;;; to the function and a player instance). -(defun help (&optional arg player) +;;; +;;; Here follow the functions that define the in-game commands. +;;; + +;;; The following commands consist of only one word and take only one argument + +(defun help (&optional player) "Print out a list of in-game commands" - (format t "~&Sorry, not yet available!")) + (let ((tab (string #\tab))) + (format t "~&Commands:~%") + (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))) + +;; XXX Will the following two functions give problems? +;; (Their name is identical with the struct name) +(defun place (player) + "Describe the player's current location" + (describe-place (player-place player))) + +(defun player (player) + "Print a description of this player" + ;; TODO + ) + +;;; These next functions have to take exactly two argument (the argument +;;; to the function and a player instance). (defun goto (location player) "Go to the specified location" + (format t "~&~A is going to ~A." (player-name player) location) + (when (symbolp location) (setf location (symbol-name location))) + (when (not (member location + (place-neighbour (get-game-object 'place + (player-place player))) + :test #'equalp)) + (format t "~&This place does not border your current location!") + (return-from goto NIL)) + (remove-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (set-object-attribute player 'place location) (set-object-attribute (get-game-object 'place (player-place player)) - 'player (player-name player))) + 'player (player-name player)) + (describe-place location)) diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp index 81c61ce..549db76 100644 --- a/lisp/game-objects.lisp +++ b/lisp/game-objects.lisp @@ -51,3 +51,14 @@ (setf (,command ,game-object) (append (,command ,game-object) '(,value))) (setf (,command ,game-object) ,value))))) + +(defun remove-object-attribute (game-object property value) + "Remove 'value' from the attribute 'property' in 'game-object'" + ;; Same comment applies as above + (let ((command (build-symbol (type-of game-object) "-" property))) + (eval `(if (listp (,command ,game-object)) + ;; XXX This is going to give problems with multiple values + (setf (,command ,game-object) + (remove-if #'(lambda (x) (equalp x ,value)) + (,command ,game-object))) + (setf (,command ,game-object) NIL))))) diff --git a/ATL/atl-mode.el b/ATL/atl-mode.el index 3740f83..127b8fa 100644 --- a/ATL/atl-mode.el +++ b/ATL/atl-mode.el @@ -15,6 +15,6 @@ "define-race" "define-place" "name-world" "load-file" "start-place") '() ;; other commands (adjust this? '("\\.atl$") ;; files for which to activate this mode - '(#'(lambda () (setq linum-mode T))) ;; other functions to call + '(#'linum-mode) ;; other functions to call "An Emacs mode for the ATL game description language" ;; doc string ) diff --git a/ATL/lisp-test.atl b/ATL/lisp-test.atl index c95dd2f..990bcbc 100644 --- a/ATL/lisp-test.atl +++ b/ATL/lisp-test.atl @@ -2,8 +2,7 @@ ; @author Daniel Vedder ; @date 04/05/2015 -; TODO change the name of this command? -name-world "Westernesse" +name-world "Underworld" define-place "Nowhere" description "Welcome to Nowhere! diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 0e0c3a7..7150ab6 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -24,6 +24,8 @@ :strength 6 :constitution 12 :dexterity 19 :intelligence 14))) (add-game-object player) + (set-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (play-game (player-name player)))) (defun start-server () diff --git a/lisp/client.lisp b/lisp/client.lisp index 3a99a98..61e1682 100644 --- a/lisp/client.lisp +++ b/lisp/client.lisp @@ -26,7 +26,7 @@ (let ((place (get-game-object 'place (player-place player)))) (describe-place place) (input-string command) - (while (!= (read-from-string command) 'quit) + (while (not (or (equalp command "quit") (equalp command "exit"))) (game-command command player) (input-string command)) (format t "~&Goodbye!")))) @@ -91,6 +91,8 @@ (defun describe-place (p) "Print out a complete description of place p" + (when (stringp p) + (setf p (get-game-object 'place p))) (format t "~&~%~A" (place-description p)) (format t "~&Neighbouring places: ~A" (string-from-list (place-neighbour p))) (format t "~&Players present: ~A" (string-from-list (place-player p))) @@ -98,22 +100,57 @@ (defun game-command (cmd player) "Execute a typed-in game command" + ;; TODO Instead of converting typed-in text into a function call, would it + ;; be better to keep an association list (command:function)? That would + ;; mean some more book-keeping, but would prevent ugly/fatal error messages. (let ((space (position #\Space cmd))) (if space (call-function (read-from-string cmd) - (read-from-string (second (cut-string cmd space))) player) + (second (cut-string cmd (1+ space))) player) (call-function (read-from-string cmd) player)))) -;;; Here follow the functions that define the in-game commands. -;;; All of them have to take exactly two argument (the argument -;;; to the function and a player instance). -(defun help (&optional arg player) +;;; +;;; Here follow the functions that define the in-game commands. +;;; + +;;; The following commands consist of only one word and take only one argument + +(defun help (&optional player) "Print out a list of in-game commands" - (format t "~&Sorry, not yet available!")) + (let ((tab (string #\tab))) + (format t "~&Commands:~%") + (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))) + +;; XXX Will the following two functions give problems? +;; (Their name is identical with the struct name) +(defun place (player) + "Describe the player's current location" + (describe-place (player-place player))) + +(defun player (player) + "Print a description of this player" + ;; TODO + ) + +;;; These next functions have to take exactly two argument (the argument +;;; to the function and a player instance). (defun goto (location player) "Go to the specified location" + (format t "~&~A is going to ~A." (player-name player) location) + (when (symbolp location) (setf location (symbol-name location))) + (when (not (member location + (place-neighbour (get-game-object 'place + (player-place player))) + :test #'equalp)) + (format t "~&This place does not border your current location!") + (return-from goto NIL)) + (remove-object-attribute (get-game-object 'place (player-place player)) + 'player (player-name player)) (set-object-attribute player 'place location) (set-object-attribute (get-game-object 'place (player-place player)) - 'player (player-name player))) + 'player (player-name player)) + (describe-place location)) diff --git a/lisp/game-objects.lisp b/lisp/game-objects.lisp index 81c61ce..549db76 100644 --- a/lisp/game-objects.lisp +++ b/lisp/game-objects.lisp @@ -51,3 +51,14 @@ (setf (,command ,game-object) (append (,command ,game-object) '(,value))) (setf (,command ,game-object) ,value))))) + +(defun remove-object-attribute (game-object property value) + "Remove 'value' from the attribute 'property' in 'game-object'" + ;; Same comment applies as above + (let ((command (build-symbol (type-of game-object) "-" property))) + (eval `(if (listp (,command ,game-object)) + ;; XXX This is going to give problems with multiple values + (setf (,command ,game-object) + (remove-if #'(lambda (x) (equalp x ,value)) + (,command ,game-object))) + (setf (,command ,game-object) NIL))))) diff --git a/lisp/util.lisp b/lisp/util.lisp index a0df301..97cd411 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -172,7 +172,6 @@ (defun repl () "Launch a read-eval-print loop" (let ((expr (simple-input expr "lisp >"))) - ;; FIXME 'done' exits Lisp (while (!= expr 'done) (if (eq expr 'help) (progn @@ -181,3 +180,10 @@ (format t "~&~S" (eval expr))) (simple-input expr "lisp >")))) +;; XXX Interesting phenomenon of repl (security bug?): +;; Enter two Lisp expressions that have not had a value assigned to them in the +;; current session (e.g. 'foo ls'). The first will cause the interpreter to +;; exit with an error. The second, however, is still printed to stdout (which is +;; now a shell), followed by a newline. If the symbol represents a valid shell +;; command, it is therefore executed. ('ls' in the example above.) +