diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5ae2444 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.msg +saves/* diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5ae2444 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.msg +saves/* diff --git a/doc/TODO b/doc/TODO index b3ddbae..d7927b9 100644 --- a/doc/TODO +++ b/doc/TODO @@ -10,3 +10,4 @@ * require XP minimum to finish game? * think of more quests * integrate the quests to lead the player through the game +* add 'ring' command at Owl's porch diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5ae2444 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.msg +saves/* diff --git a/doc/TODO b/doc/TODO index b3ddbae..d7927b9 100644 --- a/doc/TODO +++ b/doc/TODO @@ -10,3 +10,4 @@ * require XP minimum to finish game? * think of more quests * integrate the quests to lead the player through the game +* add 'ring' command at Owl's porch diff --git a/lisp/ui.lisp b/lisp/ui.lisp index 7d1a01c..291f4ac 100644 --- a/lisp/ui.lisp +++ b/lisp/ui.lisp @@ -14,6 +14,8 @@ ;; (This module should be purely UI) ;; Yeah, probably not going to happen ;-) +;; XXX Change to 5 once the (string-from-list) bug is fixed +(setf *max-line-items* 10) (defun play-game () "The main game loop" @@ -28,7 +30,6 @@ (let ((place (get-game-object 'place (player-place player)))) (describe-place place) (input-string command) - ;; TODO Tidy up the exit process (while (not (and (or (equalp command "quit") (equalp command "exit")) (y-or-n-p "~&Really quit?"))) @@ -38,19 +39,25 @@ (defun describe-place (p) "Print out a complete description of place p" - ;;TODO only display non-nil lists (as with commands) (when (stringp p) (setf p (get-game-object 'place p))) (objectify-place-monsters p) (format t "~&~A" (string-upcase (place-name p))) (format t "~&~%~A" (place-description p)) (format t "~&~%Neighbouring places: ~A" - (string-from-list (place-neighbour p))) - (format t "~&Items: ~A" (string-from-list (place-item p))) - (format t "~&NPCs: ~A" (string-from-list (place-npc p))) - (format t "~&Monsters: ~A" (string-from-list - (list-place-objects 'monster p))) + (string-from-list (place-neighbour p) :line-length *max-line-items*)) + (when (place-item p) + (format t "~&Items: ~A" (string-from-list (place-item p) + :line-length *max-line-items*))) + (when (place-npc p) + (format t "~&NPCs: ~A" (string-from-list (place-npc p) + :line-length *max-line-items*))) + (when (place-monster p) + (format t "~&Monsters: ~A" (string-from-list + (list-place-objects 'monster p) + :line-length *max-line-items*))) (when (place-command p) - (format t "~&Commands: ~A" (string-from-list (place-command p))))) + (format t "~&Commands: ~A" (string-from-list (place-command p) + :line-length *max-line-items*)))) (defun describe-player (p) "Print a description of this player" @@ -66,13 +73,15 @@ (player-constitution p) tab (player-dexterity p)) (format t "~&=====~&Abilities:~&~A" (let ((abilities (player-ability p))) - (dolist (i (player-item p) (string-from-list abilities)) + (dolist (i (player-item p) (string-from-list abilities + :line-length *max-line-items*)) (let ((ia (item-ability (get-game-object 'item i)))) (when ia (setf abilities (append abilities ia))))))) (format t "~&=====") (format t "~&Weapon: ~A" (player-weapon p)) ;; XXX This will need adjusting for large item numbers - (format t "~&Items: ~A" (string-from-list (player-item p))) + (format t "~&Items: ~A" (string-from-list (player-item p) + :line-length *max-line-items*)) (format t "~&=====") (format t "~&Max health: ~A~ACurrent health: ~A" (player-max-health p) tab (player-health p)) @@ -271,7 +280,8 @@ (format t "~&~A: ~A" (string-upcase npc-name) (quest-say-before quest))) (when (y-or-n-p "~%Give to ~A: ~A?" npc-name - (string-from-list (quest-proof-item quest) ", ")) + (string-from-list (quest-proof-item quest) :sep ", " + :line-length *max-line-items*)) (dolist (j (quest-proof-item quest)) (remove-object-attribute player 'item j)) (dolist (k (quest-reward-item quest)) @@ -283,7 +293,8 @@ (format t "~&~%Quest complete. You gain:") (format t "~&Money: ~A Experience: ~A~&Items: ~A" (quest-money quest) (quest-experience quest) - (string-from-list (quest-reward-item quest))) + (string-from-list (quest-reward-item quest) + :line-length *max-line-items*)) (unless (quest-infinite quest) (remove-object-attribute npc 'quest npc)))))))) @@ -358,7 +369,8 @@ (format t "~&You have picked up: ~A" item-name) (when (item-command item) (format t "~&This item provides commands: ~A" - (string-from-list (item-command item)))) + (string-from-list (item-command item) + :line-length *max-line-items*))) (unless (zerop (length (item-pickup-hook item))) (funcall (read-from-string (item-pickup-hook item)) player)))) diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..5ae2444 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +*.msg +saves/* diff --git a/doc/TODO b/doc/TODO index b3ddbae..d7927b9 100644 --- a/doc/TODO +++ b/doc/TODO @@ -10,3 +10,4 @@ * require XP minimum to finish game? * think of more quests * integrate the quests to lead the player through the game +* add 'ring' command at Owl's porch diff --git a/lisp/ui.lisp b/lisp/ui.lisp index 7d1a01c..291f4ac 100644 --- a/lisp/ui.lisp +++ b/lisp/ui.lisp @@ -14,6 +14,8 @@ ;; (This module should be purely UI) ;; Yeah, probably not going to happen ;-) +;; XXX Change to 5 once the (string-from-list) bug is fixed +(setf *max-line-items* 10) (defun play-game () "The main game loop" @@ -28,7 +30,6 @@ (let ((place (get-game-object 'place (player-place player)))) (describe-place place) (input-string command) - ;; TODO Tidy up the exit process (while (not (and (or (equalp command "quit") (equalp command "exit")) (y-or-n-p "~&Really quit?"))) @@ -38,19 +39,25 @@ (defun describe-place (p) "Print out a complete description of place p" - ;;TODO only display non-nil lists (as with commands) (when (stringp p) (setf p (get-game-object 'place p))) (objectify-place-monsters p) (format t "~&~A" (string-upcase (place-name p))) (format t "~&~%~A" (place-description p)) (format t "~&~%Neighbouring places: ~A" - (string-from-list (place-neighbour p))) - (format t "~&Items: ~A" (string-from-list (place-item p))) - (format t "~&NPCs: ~A" (string-from-list (place-npc p))) - (format t "~&Monsters: ~A" (string-from-list - (list-place-objects 'monster p))) + (string-from-list (place-neighbour p) :line-length *max-line-items*)) + (when (place-item p) + (format t "~&Items: ~A" (string-from-list (place-item p) + :line-length *max-line-items*))) + (when (place-npc p) + (format t "~&NPCs: ~A" (string-from-list (place-npc p) + :line-length *max-line-items*))) + (when (place-monster p) + (format t "~&Monsters: ~A" (string-from-list + (list-place-objects 'monster p) + :line-length *max-line-items*))) (when (place-command p) - (format t "~&Commands: ~A" (string-from-list (place-command p))))) + (format t "~&Commands: ~A" (string-from-list (place-command p) + :line-length *max-line-items*)))) (defun describe-player (p) "Print a description of this player" @@ -66,13 +73,15 @@ (player-constitution p) tab (player-dexterity p)) (format t "~&=====~&Abilities:~&~A" (let ((abilities (player-ability p))) - (dolist (i (player-item p) (string-from-list abilities)) + (dolist (i (player-item p) (string-from-list abilities + :line-length *max-line-items*)) (let ((ia (item-ability (get-game-object 'item i)))) (when ia (setf abilities (append abilities ia))))))) (format t "~&=====") (format t "~&Weapon: ~A" (player-weapon p)) ;; XXX This will need adjusting for large item numbers - (format t "~&Items: ~A" (string-from-list (player-item p))) + (format t "~&Items: ~A" (string-from-list (player-item p) + :line-length *max-line-items*)) (format t "~&=====") (format t "~&Max health: ~A~ACurrent health: ~A" (player-max-health p) tab (player-health p)) @@ -271,7 +280,8 @@ (format t "~&~A: ~A" (string-upcase npc-name) (quest-say-before quest))) (when (y-or-n-p "~%Give to ~A: ~A?" npc-name - (string-from-list (quest-proof-item quest) ", ")) + (string-from-list (quest-proof-item quest) :sep ", " + :line-length *max-line-items*)) (dolist (j (quest-proof-item quest)) (remove-object-attribute player 'item j)) (dolist (k (quest-reward-item quest)) @@ -283,7 +293,8 @@ (format t "~&~%Quest complete. You gain:") (format t "~&Money: ~A Experience: ~A~&Items: ~A" (quest-money quest) (quest-experience quest) - (string-from-list (quest-reward-item quest))) + (string-from-list (quest-reward-item quest) + :line-length *max-line-items*)) (unless (quest-infinite quest) (remove-object-attribute npc 'quest npc)))))))) @@ -358,7 +369,8 @@ (format t "~&You have picked up: ~A" item-name) (when (item-command item) (format t "~&This item provides commands: ~A" - (string-from-list (item-command item)))) + (string-from-list (item-command item) + :line-length *max-line-items*))) (unless (zerop (length (item-pickup-hook item))) (funcall (read-from-string (item-pickup-hook item)) player)))) diff --git a/lisp/util.lisp b/lisp/util.lisp index 0317d9d..a5584be 100644 --- a/lisp/util.lisp +++ b/lisp/util.lisp @@ -31,14 +31,6 @@ (format t "~&~A " ,prompt) (setf ,var (read)))) -;; FIXME Remove from the code! -;; XXX Very useful for debugging, but represents a major security hole -;; when used in a network setting -(defmacro magic (var) - "Execute typed-in Lisp code" - `(when (eq ,var 'magic) - (repl))) - ;; XXX potentially inefficient if called often (defmacro set-list (value &rest var-list) "Set each symbol in var-list to value" @@ -53,7 +45,6 @@ `(progn (format t "~&>>> ") (set-list (read) ,@vars) - (magic (first (list ,@vars))) ;;TODO Remove this again (first (list ,@vars)))) (defmacro input-string (&optional (var (gensym))) @@ -61,7 +52,6 @@ `(progn (format t "~&>>> ") (setf ,var (read-line)) - (magic (read-from-string ,var)) ;;TODO Remove this again ,var)) (defmacro while (condition &body body) @@ -116,15 +106,23 @@ (if (null assoc-list) NIL (cons (car (car assoc-list)) (keys (cdr assoc-list))))) -;; TODO change &optional to &key (and figure out why the heck that doesn't -;; work - clisp bug?), add null-filler keyword -;; TODO Add a maximum line length after which a newline is inserted -(defun string-from-list (lst &optional (separator " - ")) - "Put all elements of lst into a single string, separated by the separator" - (cond ((null lst) "") - ((= (length lst) 1) (to-string (car lst))) - (T (concatenate 'string (to-string (first lst)) (to-string separator) - (string-from-list (cdr lst) separator))))) +;; FIXME If (string-from-list) produces a string with linebreaks and is +;; used in conjunction with a (format t "~A") call, (format) will insert +;; an additional newline before the returned string. WTH?! +(defun string-from-list (lst &key (sep " - ") line-length line-sep) + "Put all elements of lst into a single string, separated by sep" + (unless line-sep ;; set the line separator to newline+tab + (setf line-sep (concatenate 'string + (to-string #\Newline) (to-string #\Tab)))) + ;; Iterate through the list, building the string as we go + (do ((l (cdr lst) (cdr l)) (current-line 1 (1+ current-line)) + (str (to-string (first lst)))) + ((zerop (length l)) str) + (if (and line-length (zerop (rem current-line line-length))) + (setf str (concatenate 'string str (to-string sep) + (to-string line-sep) (to-string (first l)))) + (setf str (concatenate 'string str (to-string sep) + (to-string (first l))))))) (defun split-string (str separator) "Split the string up into a list of strings along the separator character" @@ -223,7 +221,7 @@ (defun build-symbol (&rest components) "Concatenate the passed components into a single symbol" - (read-from-string (string-from-list components ""))) + (read-from-string (string-from-list components :sep ""))) (defun make-list-function (container-type &optional (add-s t)) "Return a function to return a list of the names of all objects of the @@ -262,7 +260,7 @@ (format t "~&$ ") (do* ((line (read-line) (read-line)) (text line (string-from-list - (list text line) #\newline))) + (list text line) :sep #\newline))) ((equalp line ".") (first (cut-string text (- (length text) 2)))) (format t "$ ")))) @@ -286,21 +284,3 @@ ((member ':win32 *features*) (ext:shell "cls")) (t (debugging "~&clear-screen is not supported on this operating system!")))) -(defun repl () - "Launch a read-eval-print loop" - (let ((expr (simple-input expr "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 >")))) - -;; 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.) -