From fcce94e59f70e22ac418f7a5e295f3d464e8086a Mon Sep 17 00:00:00 2001 From: Logen Kain Date: Sun, 25 Jun 2017 18:33:48 -0700 Subject: [PATCH] lisp:land-of-lisp:ch6 --- lisp/land-of-lisp/ch6/notes.lisp | 68 +++++ ...wizard_adventure_add_repl-no-comments.lisp | 103 ++++++++ .../ch6/wizard_adventure_add_repl.lisp | 233 ++++++++++++++++++ 3 files changed, 404 insertions(+) create mode 100644 lisp/land-of-lisp/ch6/notes.lisp create mode 100644 lisp/land-of-lisp/ch6/wizard_adventure_add_repl-no-comments.lisp create mode 100644 lisp/land-of-lisp/ch6/wizard_adventure_add_repl.lisp diff --git a/lisp/land-of-lisp/ch6/notes.lisp b/lisp/land-of-lisp/ch6/notes.lisp new file mode 100644 index 0000000..a773538 --- /dev/null +++ b/lisp/land-of-lisp/ch6/notes.lisp @@ -0,0 +1,68 @@ +(defun say-hello () + (print "Please type your name:") + (let ((name (read))) + (print "Nice to meet you, ") + (print name))) + +;; Type name in quotes in order for it to be a string and not a symbol +;; When running the function + +;; First we print a message asking users for a name +;; Next we define a local variable called "name" which is set +;; to the value returned by (read) + +;; (read) will cause lisp to wait for the user to type in something +;; Only after the user has typed something and pressed ENTER will +;; the variable name be set to the result + +;; Now that we have the user's name, we print a personalized greeting + +;; The print command leaves in the quotes when printing to the screen. + +;; It is recomended to use (print) or (read) if we can get away with it +;; in order to save doing extra work. (I still like (format)) + +;; Basically, (read) and (print) simply take in and spit out things +;; In a computer understood way. Hence the quotes. + +;;Let's do something with numbers + +(defun add-five () + (print "please enter a number:") + (let ((num (read))) + (print "When I add five I get") + (print (+ num 5 )))) + +;; We can use literal characters by putting #\ in front of it +;; So we can do #\a to get "a" + +;; There are also special characters used this way +;; #\newline #\tab #\space .. Should be self-explaintory + +;; To avoid getting quotes back from print and prin1 +;; we can use (princ) + +(progn (princ "This sentence will be interrupted") + (princ #\newline) + (princ "By an annoying newline character.")) +;; >> This sentence will be interrupted +;; >> by an annoying newline character. + +;; This is posibly a better methond than bothering with (format) + +;; Now let's create a say-hello function that doesn't suck +(defun say-hello2 () + (princ "Please type your name:") + (let ((name (read-line))) + (princ "Nice to meet you, ") + (princ name))) + +;; This is similar to our original, but now it doesn't +;; print quotes around the string. +;; It just takes everything the user enters as one big string + +;; back to the game +;; So far we've been able to do everything in our game from the lisp repl +;; this is awesome for prototyping, but it's time to make a real interface + +;; (see the new wizard file) diff --git a/lisp/land-of-lisp/ch6/wizard_adventure_add_repl-no-comments.lisp b/lisp/land-of-lisp/ch6/wizard_adventure_add_repl-no-comments.lisp new file mode 100644 index 0000000..a9515d1 --- /dev/null +++ b/lisp/land-of-lisp/ch6/wizard_adventure_add_repl-no-comments.lisp @@ -0,0 +1,103 @@ +(defparameter *nodes* '((living-room (you are in a the living-room. + a wizard is snoring loudly on the couch.)) + (garden (you are in a beautiful garden. + there is a well in front of you.)) + (attic (you are in the attic. + there is a giant welding torch in the corner.)))) + +(defun describe-location (location nodes) + (cadr (assoc location nodes))) + +(defparameter *edges* '((living-room (garden west door) + (attic upstairs ladder)) + (garden (living-room east door)) + (attic (living-room downstairs ladder)))) + +(defun describe-path (edge) + `(there is a ,(caddr edge) going ,(cadr edge) from here.)) + +(defun describe-paths (location edges) + (apply #'append (mapcar #'describe-path (cdr (assoc location edges))))) + +(defparameter *objects* '(whiskey bucket frog chain)) + +(defparameter *object-locations* '((whiskey living-room) + (bucket living-room) + (chain garden) + (frog garden))) + +(defun objects-at (loc objs obj-locs) + (labels ((at-loc-p (obj) + (eq (cadr (assoc obj obj-locs)) loc))) + (remove-if-not #'at-loc-p objs))) + +(defun describe-objects (loc objs obj-loc) + (labels ((describe-obj (obj) + `(you see a ,obj on the floor.))) + (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc))))) + +(defparameter *location* 'living-room) + +(defun look () + (append (describe-location *location* *nodes*) + (describe-paths *location* *edges*) + (describe-objects *location* *objects* *object-locations*))) + +(defun walk (direction) + (let ((next (find direction + (cdr (assoc *location* *edges*)) + :key #'cadr))) + (if next + (progn (setf *location* (car next)) + (look)) + '(you cannot go that way.)))) + +(defun pickup (object) + (cond ((member object + (objects-at *location* *objects* *object-locations*)) + (push (list object 'body) *object-locations*) + `(you are now carring the ,object)) + (t '(you cannot get that.)))) + +(defun inventory () + (cons 'items- (objects-at 'body *objects* *object-locations*))) + +(defun game-repl () + (let ((cmd (game-read))) + (unless (eq (car cmd) 'quit) + (game-print (game-eval cmd)) + (game-repl)))) + +(defun game-read () + (let ((cmd (read-from-string + (concatenate 'string "(" (read-line) ")")))) + (flet ((quote-it (x) + (list 'quote x))) + (cons (car cmd) (mapcar #'quote-it (cdr cmd)))))) + +(defparameter *allowed-commands* '(look walk pickup inventory)) + +(defun game-eval (sexp) + (if (member (car sexp) *allowed-commands*) + (eval sexp) + '(i do not know that command.))) + +(defun tweak-text (lst caps lit) + (when lst + (let ((item (car lst)) + (rest (cdr lst))) + (cond ((eql item #\space) (cons item (tweak-text rest caps lit))) + ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit))) + ((eql item #\") (tweak-text rest caps (not lit))) + (lit (cons item (tweak-text rest nil lit))) + (caps (cons (char-upcase item) (tweak-text rest nil lit))) + (t (cons (char-downcase item) (tweak-text rest nil nil))))))) + +(defun game-print (lst) + (princ (coerce (tweak-text (coerce (string-trim "() " + (prin1-to-string lst)) + 'list) + t + nil) + 'string)) + (fresh-line)) diff --git a/lisp/land-of-lisp/ch6/wizard_adventure_add_repl.lisp b/lisp/land-of-lisp/ch6/wizard_adventure_add_repl.lisp new file mode 100644 index 0000000..1e86704 --- /dev/null +++ b/lisp/land-of-lisp/ch6/wizard_adventure_add_repl.lisp @@ -0,0 +1,233 @@ +(defparameter *nodes* '((living-room (you are in a the living-room. + a wizard is snoring loudly on the couch.)) + (garden (you are in a beautiful garden. + there is a well in front of you.)) + (attic (you are in the attic. + there is a giant welding torch in the corner.)))) + +(defun describe-location (location nodes) + (cadr (assoc location nodes))) + +(defparameter *edges* '((living-room (garden west door) + (attic upstairs ladder)) + (garden (living-room east door)) + (attic (living-room downstairs ladder)))) + +(defun describe-path (edge) + `(there is a ,(caddr edge) going ,(cadr edge) from here.)) + +(defun describe-paths (location edges) + (apply #'append (mapcar #'describe-path (cdr (assoc location edges))))) + +(defparameter *objects* '(whiskey bucket frog chain)) + +(defparameter *object-locations* '((whiskey living-room) + (bucket living-room) + (chain garden) + (frog garden))) + +(defun objects-at (loc objs obj-locs) + (labels ((at-loc-p (obj) + (eq (cadr (assoc obj obj-locs)) loc))) + (remove-if-not #'at-loc-p objs))) + +(defun describe-objects (loc objs obj-loc) + (labels ((describe-obj (obj) + `(you see a ,obj on the floor.))) + (apply #'append (mapcar #'describe-obj (objects-at loc objs obj-loc))))) + +(defparameter *location* 'living-room) + +(defun look () + (append (describe-location *location* *nodes*) + (describe-paths *location* *edges*) + (describe-objects *location* *objects* *object-locations*))) + +(defun walk (direction) + (let ((next (find direction + (cdr (assoc *location* *edges*)) + :key #'cadr))) + (if next + (progn (setf *location* (car next)) + (look)) + '(you cannot go that way.)))) + +(defun pickup (object) + (cond ((member object + (objects-at *location* *objects* *object-locations*)) + (push (list object 'body) *object-locations*) + `(you are now carring the ,object)) + (t '(you cannot get that.)))) + +(defun inventory () + (cons 'items- (objects-at 'body *objects* *object-locations*))) + +;; Let's now define a repl + +;;(defun game-repl () +;; (loop (print (eval (read))))) + +;; Well, that's the definition of a repl isn't it? +;; It reads, then evals, then prints, and loops... This is easy. + +;; Time to redefine the repl to work proper for us. Also, why loop? + +(defun game-repl () + (let ((cmd (game-read))) + (unless (eq (car cmd) 'quit) + (game-print (game-eval cmd)) + (game-repl)))) + +(defun game-read () + (let ((cmd (read-from-string + (concatenate 'string "(" (read-line) ")")))) + (flet ((quote-it (x) + (list 'quote x))) + (cons (car cmd) (mapcar #'quote-it (cdr cmd)))))) + +;; (read-from-string) works like (read) but lets us read a syntax expression +;; or any other basic Lisp data type from a string instead +;; of directly from the console + +;; The string we use for this is a tweaked version of a string +;; we get from read-line + +;; We tweak it by adding quotes around it using (concatenate) +;; which can be used for cating strings together as well as +;; some parens + +;; Then we define a local function called (quote-it) which we can use to +;; (quote) any arguments the player has in a command +;; (remember that the single quote is shorthand for (quote ) + +;; Let's test + +;; (game-read) +;; walk east +;; >> (WALK 'EAST) + +;; Looks like it adds the parens and quotes it + +;; Note that our read loop isn't perfect. If a player threw +;; in an extra paren, it would go to hell + +(defparameter *allowed-commands* '(look walk pickup inventory)) + +(defun game-eval (sexp) + (if (member (car sexp) *allowed-commands*) + (eval sexp) + '(i do not know that command.))) + +;; The first line checks to see if the command the user gives is in our +;; list of allowed commands. + +;; If we didn't do this, it would be easy to call Lisp commands +;; from our custom repl from beyond the scope of this game + +;; Our eval command doesn't protect against hacking 100%, but it's a start + +;; Our game-print function will convert our symbol-based writing +;; into properly capitalized text +;; by having this function available, we can store +;; the text in our game engine in the most comfortable format possible +;; lists of symbols + +;; this makes it easier to manipulate text + +(defun tweak-text (lst caps lit) + (when lst + (let ((item (car lst)) + (rest (cdr lst))) + (cond ((eql item #\space) (cons item (tweak-text rest caps lit))) + ((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit))) + ((eql item #\") (tweak-text rest caps (not lit))) + (lit (cons item (tweak-text rest nil lit))) + (caps (cons (char-upcase item) (tweak-text rest nil lit))) + (t (cons (char-downcase item) (tweak-text rest nil nil))))))) + +(defun game-print (lst) + (princ (coerce (tweak-text (coerce (string-trim "() " + (prin1-to-string lst)) + 'list) + t + nil) + 'string)) + (fresh-line)) + +;; So this is a bit more complex + +;; The first important part of code xecuted is in game-pring +;; it converts the symbol list (containing the text whose layout we want to fix +;; into a string with prin1-to-string + +;; The "to-string" part means this function doesn't show the result on the screen +;; but just returns it as a string +;; The "1" means it will stay on a single line + +;; Next game-print converts the string to a list of characters with (coerce) +;; By coercing our string into a list, we can reduce the bigger goal +;; of the function into a list-processing problem + +;; In this case we're creaing a list of chars making up the text we want to fix + +;; No we send the data to the list-eater function (tweak-text) +;; Some of the arguments used in (game-print) are printed on their own line +;; for clarity + +;; to make it easier to see which argments are meant for which commands by +;; looking at indentation + +;; for instance, the "t" and "nil" arguments belong to tweak-text + +;; (tweak-text) looks at each character in the list and modifies it as needed +;; At the top of this function we define item and rest +;; which we get by chewing off an item from the front of the sentence +;; we're tweaking + +;; Then the tweak-text function uses a cond to check the character at the +;; top of the list for different conditions + +;; The first checks whether the character is a space character +;; if so, leave it alone and go to the next char +;; if the char is a period, question mark, or exclamation point +;; we turn on the (cap) parameter for the rest of the string +;; (by using the value "t" as an argument in the recursive call) to +;; indicate that the next symbol is at the beginning of a sentence +;; and needs to be a capital letter + +;; We also track whether we've encountered a quotation mark +;; we do this because, infrequently, a symbol list is not +;; adequate for encoding English text + +;; Examples include having a comma as commas are not allowed +;; in standard common lisp symbols + +;; or product names with non-standard capitalization + +;; In these cases we can fall back on using text strings + +;; Example: +;; (game-print '(not only does this sentence have a "comma," it also mentions the "iPad.")) +;; >> Not only does this sentence have a comma, it also mentions the iPad. + +;; We tell the function to treat the capitlization as shown literally by +;; turning off the lit variable in the recursive call +;; As long as this value is set, (tweak-text) prevents +;; the capitalization rules from being reached + +;; Next (tweak-text) checks to see whether the next char is supposed to be +;; capitalized. If it is, we use the char-upcase function to change the +;; current character to uppercase (if it isn't already) before processing +;; the next item in the list + +;; If none of the other conditons were met, we know that the current char +;; should be lowercase and we can convert it using the char-downcase function + +;; After tweak-text is finished correcting the text in the list, +;; (game-print) coerces it back into a proper string and princs it + +;; (fresh-line) makes sure the next item appearing on the screen will start +;; on a fresh line + +;; Note: (read) and (eval) should be mostly avoided for production code +;; Someone will be able to think up a way to break into it