绪论
Common Lisp是一门多范式语言，支持多种编程模式，包括面向对象编程、函数式编程。但Common Lisp鼓励函数式编程，并且包含有许多函数式编程相关的功能。
《Land of Lisp》是一本寓教于乐的学习Lisp语法的书籍。这本书配以漫画插图来进行表达，并且将小游戏的制作作为演示和练习实例。本文就《Land of Lisp》第5、6章演示、练习给出相应的代码，并作一定的辅助的分析解释。
代码实现
基本框架
场景机制
;;;; 定义场景
(defparameter *nodes* '((living-room
(you are in 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.))))
(defparameter *edges* '((living-room (garden west door)
(attic upstairs ladder))
(garden (living-room east door))
(attic (living-room downstairs ladder))))
(defun describe-location (location nodes)
"1. assoc将'(listA listB listC)中，listA/B/C的第一个元素作为关键字，获取listA/B/C
2. (cadr list) => (car(cdr list)) 获取列表中第二个元素"
(cadr (assoc location nodes)))
(defun describe-path (edge)
`(there is a ,(caddr edge) going ,(cadr edge) from here.))
(defun describe-paths (location edges)
"mapcar: (mapcar method list) 将method依次作用于list中各元素"
(apply #'append (mapcar #'describe-path (cdr (assoc location edges)))))
;;;; 查看场景
(defparameter *location* 'living-room)
(defun look ()
(append (describe-location *location* *nodes*)
(describe-paths *location* *edges*)
(describe-objects *location* *objects* *object-locations*)))
(defun walk (direction)
"find的用法示范: (find 'y '((5 x) (3 y) (7 z)) :key #'cadr)
=> (3 Y)"
(let ((next (find direction
(cdr (assoc *location* *edges*))
:key #'cadr)))
(if next
(progn (setf *location* (car next))
(look))
'(you cannot go that way.))))
物品机制
;;;; 定义物品
(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)
"对于给定的loc地点，给定objs物品列表，检查是否处在该地点
remove-if-not过滤掉列表中不符合条件的元素"
(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)))))
;;;; 捡起物品
(defun pickup (object)
"检查在当前loc地点下，输入的物品object是否存在
若存在，则“将物品转移”到身体
否则，输出禁止的提示语句"
(cond ((member object
(objects-at *location* *objects* *object-locations*))
(push (list object 'body) *object-locations*)
`(you are now carrying 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 ()
"read-from-string: 把字符串转变为表达式/符号(去除双引号)"
(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)
"给定字符列表，逐字扫描，调整大小写
1. 如果为空格，将大小写设置保留到下一字符
2. 如果为标点符号，设置下一字符为大写
3. 如果出现双引号字符，开启lit(literal)不设置大小写，不扫描字符，不作处理
4. 如果开启cap(capital)则将字母转换为为大写
5. 否则，将字母转换为小写"
(when lst
(let ((item (car lst))
(rest (cdr lst)))
(cond ((eq item #\space) (cons item (tweak-text rest caps lit)))
((member item '(#\! #\? #\.)) (cons item (tweak-text rest t lit)))
((eq 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)
"打印储存在lst中的符号。实现句首大写，引号中的部分保留大小写和符号
1. prin1-to-string: 将lisp列表打印成字符串且不输出
2. string-trim: (string-trim str1 str2)将字符串str2中，位于左侧或右侧的特定字符去除，直到遇到给定范围外的字符；特定字符由str1给定
3. coerce:
- (coerce string 'list)将字符串string转换成字符列表
- (coerce list 'string)将字符列表list转换为字符串
4. tweak-text: 自定义函数，用于中字符列表中逐字检查，并中必要时作调整"
(princ
(coerce 'string (tweak-text
(coerce (string-trim "() "
(prin1-to-string lst)) 'list)
t nil) 'string))
(fresh-line))