显然对于特定的领域，特定的程序是更好的解决方案，这个程序就是DSL1.lisp非常方便来实现DSL。在land of lisp一书中进行了两种dsl，一种是生成xml或html，另一种是对我们之前 wizard游戏的 中的游戏命令进行dsl。
关于svg文件不加以详述，读者可以参考 这里 。这非常重要，只有理解了xml文件的格式才能继续我们的dsl。svg采用xml格式，顺便我们也说说生成网页的dsl。
首先写一个辅助函数，
;Creating XML and HTML with the tag Macro
;Writing a Macro Helper Function
(defun print-tag (name alst closingp)
(princ #\<)
(when closingp
(princ #\/))
(princ (string-downcase name))
(mapc (lambda (att);使用mapc是为了副作用。它总返回第一个参数
(format t " ~a=\"~a\"" (string-downcase (car att)) (cdr att)))
alst)
(princ #\>))可以试试
(print-tag 'mytag '((color . blue) (height . 9)) nil)然后创造生成标签的宏，宏能在以下几个方面提供不可替代的改善：
总之我们想让我们的宏看上去这样：
(tag mytag (color 'blue height (+ 4 5)))
我们这么做：
(defmacro tag (name atts &body; body)
`(progn (print-tag ',name
(list ,@(mapcar (lambda (x)
`(cons ',(car x) ,(cdr x)))
(pairs atts)))
nil)
,@body
(print-tag ',name nil t)))很好的实现了以上要求，可以展开看看：
(macroexpand '(tag mytag (color 'blue height (+ 4 5))))可以看看如何实现嵌套的：
(tag mytag (color 'blue size 'big)
(tag first_inner_tag ())
(tag second_inner_tag ()))我们还可以用来生成html
(tag html ();比之前我们生成html的版本好看多了……
(tag body ()
(princ "Hello World!")))html的标签是特定的，我们还能为特定的html标签编写宏：
(defmacro html (&body; body)
`(tag html ()
,@body))
(defmacro body (&body; body)
`(tag body ()
,@body))
(html (body (princ "Hi boys")))好了，不跑题了，开始写生成svg的宏
;Creating SVG-Specific Macros and Functions
(defmacro svg (&body; body)
`(tag svg (xmlns "http://www.w3.org/2000/svg";声明标准在哪里
"xmlns:xlink" "http://www.w3.org/1999/xlink");链接
,@body))写一个函数专门加深色彩，方便我们绘图
(defun brightness (col amt)
(mapcar (lambda (x)
(min 255 (max 0 (+ x amt))))
col))
(brightness '(255 0 0) -100)使用一个svg样式函数生成颜色属性，边比内部颜色深.注意～{和～}可以起遍历的作用。
(defun svg-style (color)
(format nil
"~{fill:rgb(~a,~a,~a);stroke:rgb(~a,~a,~a)~}"
(append color;边界比内部颜色更深
(brightness color -100))))于是得到生成圆的一个函数
(defun circle (center radius color)
(tag circle (cx (car center)
cy (cdr center)
r radius
style (svg-style color))))最后可以简单的得到svg文件
(svg (circle '(50 .50) 50 '(255 0 0))
(circle '(100 . 100) 50 '(0 0 255)))还可以写些更复杂的svg例子，比如一个多边形
;Building a More Complicated SVG Example
(defun polygon (points color)
(tag polygon (points (format nil
"~{~a,~a ~}";~{允许我们迭代
(mapcan (lambda (tp)
(list (car tp) (cdr tp)));mapcan是有append的mapcar
points))
style (svg-style color))))写个random-walk函数，我想读者应该知道是干什么的
(defun random-walk (value length)
(unless (zerop length)
(cons value
(random-walk (if (zerop (random 2))
(1- value)
(1+ value))
(1- length)))))
(random-walk 100 10);测试写进一个文件
(with-open-file (*standard-output* "random_walk.svg"
:direction :output
:if-exists :supersede)
(svg (loop repeat 10
do (polygon (append '((0 . 200))
(loop for x;又是这种风格，sbcl识别不了啊
for y in (random-walk 100 400)
collect (cons x y))
'((400 . 200)))
(loop repeat 3
collect (random 256))))))用你的浏览器打开random_walk.svg看看吧，生成大概这样的图像:
random_walk
首先别忘了加载那个游戏
;Creating Custom Game Commands for Wizard's Adventure Game
(load "wizards_game")添加两个命令，一个把链条和篮子焊接在一起，另一个用焊好的篮子从井里打水。
;Creating New Game Commands by Hand
;A Command for Welding
(defun have (object)
(member object (inventory)))
(defparameter *chain-welded* nil)
(defun weld (subject object)
(if (and (eq *location* 'attic)
(eq subject 'chain)
(eq obejct 'bucket)
(have 'chain)
(have 'bucket)
(not *chain-welded*))
(progn (setf *chain-welded* t)
'(the chain is now securely welded to the bucket.))
'(you cannot weld like that)))
(weld 'chain 'bucket)
;(game-repl)
(pushnew 'weld *allowed-commands*);这很关键，不是吗？
;A Command for Dunking
(setf *bucket-filled* nil)
(defun dunk (subject object)
(if (and (eq *location* 'garden)
(eq subject 'bucket)
(eq object 'well)
(have 'bucket)
*chain-welded*)
(progn (setf *bucket-filled* 't)
'(the bucket is now full of water))
'(you cannot dunk like that.)))
(pushnew 'dunk *allowed-commands*)发现没？这两种命令很相似，我们来dsl,重新用我们的宏来重新添加上两个命令，另为我们还添加了一个更复杂的命令splash，把水泼到巫师脸上……
;The game-action Macro
(defmacro game-action (command subj obj place &body; body)
(let1 subject (gensym) (let1 object (gensym)
`(progn (defun ,command (,subject ,object)
(if (and (eq *location* ',place)
(eq ,subject ',subj)
(eq ,object ',obj)
(have ',subj))
,@body
'(i cant ,command like that.)))
(pushnew ',command *allowed-commands*)))))
;rewrite
(defparameter *chain-welded* nil)
(game-action weld chain bucket attic
(if (and (have 'bucket) (not *chain-welded*))
(progn (setf *chain-welded* 't)
'(the chain is now securely welded to the bucket.))
'(you do not have a bucket.)))
(setf *bucket-filled* nil)
(game-action dunk bucket well garden
(if *chain-welded*
(progn (setf *bucket-filled* 't)
'(the bucket is now full of water))
'(the water level is too low to reach.)))
(game-action splash bucket wizard living-room
(cond ((not *bucket-filled*) '(the bucket has nothing in it.))
((have 'frog) '(the wizard awakens and sees that you stole his frog.
he is so upset he banishes you to the
netherworlds- you lose! the end.))
(t '(the wizard awakens from his slumber and greets you warmly.
he hands you the magic low-carb donut- you win! the end.))))试试我们的新游戏，很棒不是？
(game-repl)寝室的室友在看dota比赛，不要这么激情好么，吵死了。晚上试着跑了将近一个小时步，感觉不错。
1 domian-specific language