diff --git a/ATL/test.atl b/ATL/test.atl deleted file mode 100644 index 7c112b8..0000000 --- a/ATL/test.atl +++ /dev/null @@ -1,18 +0,0 @@ -# This is a simple test ATL file to test whatever I have implemented so far. -# @author Daniel Vedder -# @date 04/05/2015 - -define-place Nowhere - description Welcome to Nowhere! -#You are in the void, the space between \ -#the worlds. Around you is black. Black, except for one tiny pin-prick of -#light \to the north. - neighbour Elysium - -define-place Elysium - description This is where you want to be when you are six feet under... - neighbour Nowhere - -load test2.atl - -start-place Nowhere \ No newline at end of file diff --git a/ATL/test.atl b/ATL/test.atl deleted file mode 100644 index 7c112b8..0000000 --- a/ATL/test.atl +++ /dev/null @@ -1,18 +0,0 @@ -# This is a simple test ATL file to test whatever I have implemented so far. -# @author Daniel Vedder -# @date 04/05/2015 - -define-place Nowhere - description Welcome to Nowhere! -#You are in the void, the space between \ -#the worlds. Around you is black. Black, except for one tiny pin-prick of -#light \to the north. - neighbour Elysium - -define-place Elysium - description This is where you want to be when you are six feet under... - neighbour Nowhere - -load test2.atl - -start-place Nowhere \ No newline at end of file diff --git a/ATL/test2.atl b/ATL/test2.atl deleted file mode 100644 index 41dda7a..0000000 --- a/ATL/test2.atl +++ /dev/null @@ -1,6 +0,0 @@ -# This file is used to test the load command - -define-place Fields of Punishment - description You really, really don't want to be here! - neighbour Nowhere - neighbour Elysium \ No newline at end of file diff --git a/ATL/test.atl b/ATL/test.atl deleted file mode 100644 index 7c112b8..0000000 --- a/ATL/test.atl +++ /dev/null @@ -1,18 +0,0 @@ -# This is a simple test ATL file to test whatever I have implemented so far. -# @author Daniel Vedder -# @date 04/05/2015 - -define-place Nowhere - description Welcome to Nowhere! -#You are in the void, the space between \ -#the worlds. Around you is black. Black, except for one tiny pin-prick of -#light \to the north. - neighbour Elysium - -define-place Elysium - description This is where you want to be when you are six feet under... - neighbour Nowhere - -load test2.atl - -start-place Nowhere \ No newline at end of file diff --git a/ATL/test2.atl b/ATL/test2.atl deleted file mode 100644 index 41dda7a..0000000 --- a/ATL/test2.atl +++ /dev/null @@ -1,6 +0,0 @@ -# This file is used to test the load command - -define-place Fields of Punishment - description You really, really don't want to be here! - neighbour Nowhere - neighbour Elysium \ No newline at end of file diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 66013e0..e8ddc0b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -11,7 +11,7 @@ (load 'util.lisp) (load 'interpreter.lisp) -;(load 'client.lisp) +(load 'client.lisp) (defun start-server () @@ -72,7 +72,8 @@ (unless (null line) (format t "~%~A" line)))) (start-menu)) ((equalp choice 'e) - (format t "~&Goodbye!") (quit)))) + (format t "~&Goodbye!") (quit)) + (t (format t "~&Invalid choice!") (start-menu)))) (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." @@ -94,6 +95,10 @@ (format t "~&Sorry, the client is not yet available!")))) +;; Initialize the random state (which would otherwise not be very random...) +(setf *random-state* (make-random-state t)) + +;; Only show the interactive menu if no commandline parameters are given (if *args* (parse-commandline-args) (start-menu)) diff --git a/ATL/test.atl b/ATL/test.atl deleted file mode 100644 index 7c112b8..0000000 --- a/ATL/test.atl +++ /dev/null @@ -1,18 +0,0 @@ -# This is a simple test ATL file to test whatever I have implemented so far. -# @author Daniel Vedder -# @date 04/05/2015 - -define-place Nowhere - description Welcome to Nowhere! -#You are in the void, the space between \ -#the worlds. Around you is black. Black, except for one tiny pin-prick of -#light \to the north. - neighbour Elysium - -define-place Elysium - description This is where you want to be when you are six feet under... - neighbour Nowhere - -load test2.atl - -start-place Nowhere \ No newline at end of file diff --git a/ATL/test2.atl b/ATL/test2.atl deleted file mode 100644 index 41dda7a..0000000 --- a/ATL/test2.atl +++ /dev/null @@ -1,6 +0,0 @@ -# This file is used to test the load command - -define-place Fields of Punishment - description You really, really don't want to be here! - neighbour Nowhere - neighbour Elysium \ No newline at end of file diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 66013e0..e8ddc0b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -11,7 +11,7 @@ (load 'util.lisp) (load 'interpreter.lisp) -;(load 'client.lisp) +(load 'client.lisp) (defun start-server () @@ -72,7 +72,8 @@ (unless (null line) (format t "~%~A" line)))) (start-menu)) ((equalp choice 'e) - (format t "~&Goodbye!") (quit)))) + (format t "~&Goodbye!") (quit)) + (t (format t "~&Invalid choice!") (start-menu)))) (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." @@ -94,6 +95,10 @@ (format t "~&Sorry, the client is not yet available!")))) +;; Initialize the random state (which would otherwise not be very random...) +(setf *random-state* (make-random-state t)) + +;; Only show the interactive menu if no commandline parameters are given (if *args* (parse-commandline-args) (start-menu)) diff --git a/lisp/client.lisp b/lisp/client.lisp index 11bddd7..0c19f60 100644 --- a/lisp/client.lisp +++ b/lisp/client.lisp @@ -23,69 +23,62 @@ (setf player (get-game-object 'player player-name)) (error "~&No player name specified!"))) (when (null player) - (create-player player-name)))) + (setf player (create-player player-name))))) (defun create-player (player-name) "The user creates a new player" - ;; This function feels somewhat inelegant - lot's of repetetive stuff. + ;; XXX This function feels somewhat inelegant - lot's of repetetive stuff. ;; Is it worth cleaning up? - (let ((player (make-player :name player-name)) + (let ((player (make-player :name player-name + :place (world-starting-place *world*))) (race NIL) (character-class NIL) - (strength 0) (dexterity 0) - (constitution 0) (intelligence 0) - (items NIL) (weapons NIL) - (character-attributes '(strength dexterity - constitution intelligence)) + (char-attr + '((strength 0) (dexterity 0) + (constitution 0) (intelligence 0))) + (items NIL) (weapon "") (character-points NIL)) (format t "~&The name you have chosen is not registered on this game.") (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-objects 'race) " - ")) + (format t "~&Options: ~A" (string-from-list (list-objects 'race))) (setf race (input-string)) (while (not (member race (list-objects 'race) :test #'equalp)) (format t "~&Invalid choice. Please reenter:") (setf race (input-string))) - (setf race (get-game-object 'race race)) + (setf (player-race player) (get-game-object 'race race)) (format t "~&Please chose a class:") (format t "~&Options: ~A" (string-from-list - (list-objects 'character-class) " - ")) + (list-objects 'character-class))) (setf character-class (input-string)) (while (not (member character-class (list-objects 'character-class) :test #'equalp)) (format t "~&Invalid choice. Please reenter:") (setf character-class (input-string))) - (setf character-class + (setf (player-class player) (get-game-object 'character-class character-class)) ;; Set character attributes (while (< (reduce #'+ character-points) 24) ; Warning: magic number! - (set-list (random 20) a b c d) + (set-list (1+ (random 20)) a b c d) (setf character-points (list a b c d))) (setf text " Now distribute your attribute points. Random numbers have been chosen, you may assign one number to each of the following attributes:") - (format t "~&~A~%~A~%~%The numbers are: ~%~A" - text (string-from-list character-attributes " - ") - (string-from-list character-points " - ")) - ;; FIXME Rewrite this section ? >>> - (dolist (attr character-attributes) - (simple-input (symbol-value attr) - (concatenate 'string (string-downcase (symbol-name attr)) ":")) - ;(break) - (while (not (member attr character-points)) + (format t "~&~A~%~A~%~%The numbers are:" + text (string-from-list (keys char-attr))) + ;; TODO I should replace simple-input with something offering 'magic' + (do* ((i 0 (1+ i)) (attr (safe-nth i (keys char-attr)) + (safe-nth i (keys char-attr))) + (val (cassoc attr char-attr) (cassoc attr char-attr))) + ((= i (length char-attr)) player) + (format t "~&~A" (string-from-list character-points)) + (simple-input val (concatenate 'string (symbol-name attr) ":")) + (while (not (member val character-points)) (format t "~&Sorry, invalid number chosen. Please reenter:") - (simple-input attr - (concatenate 'string - (string-downcase (symbol-name attr)) ":"))) + (simple-input val (concatenate 'string (symbol-name attr) ":"))) + ;; FIXME Gives problems if two equal numbers are in char-points + (let ((player-fn (build-symbol "player-" attr))) + ;; XXX Kludge! + (eval `(setf (,player-fn ,player) ,val))) (setf character-points - (remove-if #'(lambda (x) - (= x (symbol-value attr))) - character-points))) - ;; Update the player - (setf (player-race player) race) - (setf (player-class player) character-class) - (setf (player-strength player) strength) - (setf (player-constitution player) constitution) - (setf (player-dexterity player) dexterity) - (setf (player-intelligence player) intelligence) - player)) + (remove-if #'(lambda (x) (= x val)) character-points))))) diff --git a/ATL/test.atl b/ATL/test.atl deleted file mode 100644 index 7c112b8..0000000 --- a/ATL/test.atl +++ /dev/null @@ -1,18 +0,0 @@ -# This is a simple test ATL file to test whatever I have implemented so far. -# @author Daniel Vedder -# @date 04/05/2015 - -define-place Nowhere - description Welcome to Nowhere! -#You are in the void, the space between \ -#the worlds. Around you is black. Black, except for one tiny pin-prick of -#light \to the north. - neighbour Elysium - -define-place Elysium - description This is where you want to be when you are six feet under... - neighbour Nowhere - -load test2.atl - -start-place Nowhere \ No newline at end of file diff --git a/ATL/test2.atl b/ATL/test2.atl deleted file mode 100644 index 41dda7a..0000000 --- a/ATL/test2.atl +++ /dev/null @@ -1,6 +0,0 @@ -# This file is used to test the load command - -define-place Fields of Punishment - description You really, really don't want to be here! - neighbour Nowhere - neighbour Elysium \ No newline at end of file diff --git a/lisp/atlantis.lisp b/lisp/atlantis.lisp index 66013e0..e8ddc0b 100644 --- a/lisp/atlantis.lisp +++ b/lisp/atlantis.lisp @@ -11,7 +11,7 @@ (load 'util.lisp) (load 'interpreter.lisp) -;(load 'client.lisp) +(load 'client.lisp) (defun start-server () @@ -72,7 +72,8 @@ (unless (null line) (format t "~%~A" line)))) (start-menu)) ((equalp choice 'e) - (format t "~&Goodbye!") (quit)))) + (format t "~&Goodbye!") (quit)) + (t (format t "~&Invalid choice!") (start-menu)))) (defun cmd-parameter (name &optional truth-value) "Return the value of the parameter 'name'. Or T for present if truth-value." @@ -94,6 +95,10 @@ (format t "~&Sorry, the client is not yet available!")))) +;; Initialize the random state (which would otherwise not be very random...) +(setf *random-state* (make-random-state t)) + +;; Only show the interactive menu if no commandline parameters are given (if *args* (parse-commandline-args) (start-menu)) diff --git a/lisp/client.lisp b/lisp/client.lisp index 11bddd7..0c19f60 100644 --- a/lisp/client.lisp +++ b/lisp/client.lisp @@ -23,69 +23,62 @@ (setf player (get-game-object 'player player-name)) (error "~&No player name specified!"))) (when (null player) - (create-player player-name)))) + (setf player (create-player player-name))))) (defun create-player (player-name) "The user creates a new player" - ;; This function feels somewhat inelegant - lot's of repetetive stuff. + ;; XXX This function feels somewhat inelegant - lot's of repetetive stuff. ;; Is it worth cleaning up? - (let ((player (make-player :name player-name)) + (let ((player (make-player :name player-name + :place (world-starting-place *world*))) (race NIL) (character-class NIL) - (strength 0) (dexterity 0) - (constitution 0) (intelligence 0) - (items NIL) (weapons NIL) - (character-attributes '(strength dexterity - constitution intelligence)) + (char-attr + '((strength 0) (dexterity 0) + (constitution 0) (intelligence 0))) + (items NIL) (weapon "") (character-points NIL)) (format t "~&The name you have chosen is not registered on this game.") (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-objects 'race) " - ")) + (format t "~&Options: ~A" (string-from-list (list-objects 'race))) (setf race (input-string)) (while (not (member race (list-objects 'race) :test #'equalp)) (format t "~&Invalid choice. Please reenter:") (setf race (input-string))) - (setf race (get-game-object 'race race)) + (setf (player-race player) (get-game-object 'race race)) (format t "~&Please chose a class:") (format t "~&Options: ~A" (string-from-list - (list-objects 'character-class) " - ")) + (list-objects 'character-class))) (setf character-class (input-string)) (while (not (member character-class (list-objects 'character-class) :test #'equalp)) (format t "~&Invalid choice. Please reenter:") (setf character-class (input-string))) - (setf character-class + (setf (player-class player) (get-game-object 'character-class character-class)) ;; Set character attributes (while (< (reduce #'+ character-points) 24) ; Warning: magic number! - (set-list (random 20) a b c d) + (set-list (1+ (random 20)) a b c d) (setf character-points (list a b c d))) (setf text " Now distribute your attribute points. Random numbers have been chosen, you may assign one number to each of the following attributes:") - (format t "~&~A~%~A~%~%The numbers are: ~%~A" - text (string-from-list character-attributes " - ") - (string-from-list character-points " - ")) - ;; FIXME Rewrite this section ? >>> - (dolist (attr character-attributes) - (simple-input (symbol-value attr) - (concatenate 'string (string-downcase (symbol-name attr)) ":")) - ;(break) - (while (not (member attr character-points)) + (format t "~&~A~%~A~%~%The numbers are:" + text (string-from-list (keys char-attr))) + ;; TODO I should replace simple-input with something offering 'magic' + (do* ((i 0 (1+ i)) (attr (safe-nth i (keys char-attr)) + (safe-nth i (keys char-attr))) + (val (cassoc attr char-attr) (cassoc attr char-attr))) + ((= i (length char-attr)) player) + (format t "~&~A" (string-from-list character-points)) + (simple-input val (concatenate 'string (symbol-name attr) ":")) + (while (not (member val character-points)) (format t "~&Sorry, invalid number chosen. Please reenter:") - (simple-input attr - (concatenate 'string - (string-downcase (symbol-name attr)) ":"))) + (simple-input val (concatenate 'string (symbol-name attr) ":"))) + ;; FIXME Gives problems if two equal numbers are in char-points + (let ((player-fn (build-symbol "player-" attr))) + ;; XXX Kludge! + (eval `(setf (,player-fn ,player) ,val))) (setf character-points - (remove-if #'(lambda (x) - (= x (symbol-value attr))) - character-points))) - ;; Update the player - (setf (player-race player) race) - (setf (player-class player) character-class) - (setf (player-strength player) strength) - (setf (player-constitution player) constitution) - (setf (player-dexterity player) dexterity) - (setf (player-intelligence player) intelligence) - player)) + (remove-if #'(lambda (x) (= x val)) character-points))))) diff --git a/lisp/util.lisp b/lisp/util.lisp index c7721eb..a0df301 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -20,12 +20,16 @@ syms) ,@body)) +(defmacro simple-input (var &optional (prompt ">>>")) + "Take input from terminal and store it in var" + `(progn + (format t "~&~A " ,prompt) + (setf ,var (read)))) + (defmacro magic (var) "Execute typed-in Lisp code" - (let-gensyms (expr) - `(when (equalp ,var 'magic) - (progn (simple-input ,expr "[spell]>") - (eval ,expr))))) + `(when (eq ,var 'magic) + (repl))) ; potentially inefficient if called often (defmacro set-list (value &rest var-list) @@ -66,6 +70,11 @@ "Returns (car (cdr (assoc entry table)))" `(car (cdr (assoc ,entry ,table :test ,test)))) +(defmacro safe-nth (index lst) + "Return (nth index lst), or NIL if index is out of range" + `(if (> ,index (1- (length ,lst))) + NIL (nth ,index ,lst))) + (defmacro safe-aref (vector index) "Return (aref vector index), but return NIL if out of range" `(if (> ,index (1- (length ,vector))) @@ -80,22 +89,22 @@ ((= ,index (length ,vector)) ,return-variable) ,@body))) -;; TODO ? -;; (defmacro call-function (function-name &rest args) -;; "Save myself some quoting when calling a function from a generated symbol" -;; `(eval - - ;;; FUNCTIONS ; Some of these functions are probably quite inefficient (lots of consing) -(defun simple-input (var &optional (prompt ">>>")) - "Take input from terminal and store it in var" - (format t "~&~A " prompt) - (setf var (read))) -(defun string-from-list (lst &optional (separator " ")) +(defun call-function (function-name &rest args) + "Save myself some quoting when calling a function from a generated symbol" + ;; Perhaps not very clean, but it works + (eval `(,function-name ,@args))) + +(defun keys (assoc-list) + "Return a list of the keys in an association list" + (if (null assoc-list) NIL + (cons (car (car assoc-list)) (keys (cdr assoc-list))))) + +(defun string-from-list (lst &optional (separator " - ")) "Put all elements of lst into a single string, separated by the separator" (let ((str (to-string (first lst)))) (dolist (item (cdr lst) str) @@ -160,3 +169,15 @@ (setf (nth i comps) (symbol-name (nth i comps))))) (eval `(read-from-string (concatenate 'string ,@comps))))) +(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 + (format t "~&You are in a read-eval-print loop.") + (format t "~&To escape, type done; to quit, type (quit).")) + (format t "~&~S" (eval expr))) + (simple-input expr "lisp >")))) +