mollusk/practice-beefki
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

lisp:land-of-lisp:ch6

Browse Source
This commit is contained in:
Logen Kain 2017-06-25 18:33:48 -07:00
parent 6215a98407
commit fcce94e59f
3 changed files with 404 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
lisp/land-of-lisp/ch6/notes.lisp Normal file
View File

@ -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)

103
lisp/land-of-lisp/ch6/wizard_adventure_add_repl-no-comments.lisp Normal file
View File

@ -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))

233
lisp/land-of-lisp/ch6/wizard_adventure_add_repl.lisp Normal file
View File

@ -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