基于web的Dice of Doom

毋庸置疑，所有游戏界面要用svg画出来，于是我们之前写得 svg库 要派上用场了。什么？已经没有了？那么从该书主页上下载svg.lisp.

由于要创建个基于web的应用程序，之前的webserver也需要加载。

当然还有我们的游戏新引擎Dice of Doom v2

(cd "~/Documents/lisp") 
(load "dice_of_doom_v2")
(load "webserver")
(load "svg.lisp")

然后需要先设定一些常数

(defparameter *board-width* 900);面板宽度
(defparameter *board-height* 500);面板高度
(defparameter *board-scale* 64);面板缩放比例
(defparameter *top-offset* 3);两摞起来的骰子相对位移
(defparameter *dice-scale* 40);骰子缩放比例
(defparameter *dot-size* 0.05);骰子上点的大小

接下来画骰子

(defun draw-die-svg (x y col)
  (labels ((calc-pt (pt)
             (cons (+ x (* *dice-scale* (car pt)))
                   (+ y (* *dice-scale* (cdr pt)))))
           (f (pol col)
             (polygon (mapcar #'calc-pt pol) col)))
    (f '((0 . -1) (-0.6 . -0.75) (0 . -0.5) (0.6 . -0.75))
       (brightness col 40))
    (f '((0 . -0.5) (-0.6 . -0.75) (-0.6 . 0) (0 . 0.25))
       col)
    (f '((0 . -0.5) (0.6 . -0.75) (0.6 . 0) (0 . 0.25))
       (brightness col -40))
    (mapc (lambda (x y)
            (polygon (mapcar (lambda (xx yy)
                               (calc-pt (cons (+ x (* xx *dot-size*))
                                              (+ y (* yy *dot-size*)))))
                             '(-1 -1 1 1)
                             '(-1 1 1 -1))
                     '(255 255 255)))
          '(-0.05 0.125 0.3 -0.3 -0.125 0.05 0.2 0.2 0.45 0.45 -0.45 -0.2)
          '(-0.875 -0.80 -0.725 -0.775 -0.70 -0.625 -0.35 -0.05 -0.45 -0.15 -0.45 -0.05))))
;(with-open-file (*standard-output* "die.svg" :direction :output :if-exists :supersede) (svg 100 100 (draw-die-svg 50 50 '(255 0 0)))) 

再画一小块面板

(defun draw-tile-svg (x y pos hex xx yy col chosen-tile)
  (loop for z below 2
        do (polygon (mapcar (lambda (pt)
                              (cons (+ xx (* *board-scale* (car pt)))
                                    (+ yy (* *board-scale*
                                             (+ (cdr pt) (* (- 1 z) 0.1))))))
                            '((-1 . -0.2) (0 . -0.5) (1 . -0.2)
                                          (1 . 0.2) (0 . 0.5) (-1 . 0.2)))
                    (if (eql pos chosen-tile)
                      (brightness col 100)
                      col)))
  (loop for z below (second hex)
        do (draw-die-svg (+ xx
                            (* *dice-scale*
                               0.3
                               (if (oddp (+ x y z))
                                 -0.3
                                 0.3)))
                         (- yy (* *dice-scale* z 0.8)) col)))

;(with-open-file (*standard-output* "tile.svg" :direction :output) (svg 300 300 (draw-tile-svg 0 0 0 '(0 3) 100 150 '(255 0 0) nil)))

接下来是整个面板

;Draw the Board
(defparameter *die-colors* '((255 63 63) (63 63 255)))
(defun draw-board-svg (board chosen-tile legal-tiles)
  (loop for y below *board-size*
        do (loop for x below *board-size*
                 for pos = (+ x (* *board-size* y))
                 for hex = (aref board pos)
                 for xx = (* *board-scale* (+ (* 2 x) (- *board-size* y)))
                 for yy = (* *board-scale* (+ (* y 0.7) *top-offset*))
                 for col = (brightness (nth (first hex) *die-colors*)
                                       (* -15 (- *board-size* y)))
                 do (if (member pos legal-tiles)
                      (tag g ()
                        (tag a ("xlink:href" (make-game-link pos))
                          (draw-tile-svg x y pos hex xx yy col chosen-tile)))
                      (draw-tile-svg x y pos hex xx yy col chosen-tile)))))
(defun make-game-link (pos)
  (format nil "/game.html?chosen=~a" pos))
;(with-open-file (*standard-output* "board.svg" :direction :output :if-exists :supersede) (svg *board-width* *board-height* (draw-board-svg (gen-board) nil nil)))

这有个问题，之前我们svg宏不是像上文中那样定义的，svg宏需要稍加修改，具体参见本书的errata

先写游戏的驱动

(defparameter *cur-game-tree* nil);初始化当前游戏树
(defparameter *from-tile* nil);选择的一片面板

(defun dod-request-handler (path header params)
  (if (equal path "game.html")
    (progn (princ "HTTP/1.1 200 OK

                  <!doctype html>
                  <html><head></head><body>")
           (tag center ()
             (princ "Welcome to DICE OF DOOM!")
             (tag br ())
             (let ((chosen (assoc 'chosen params)))
               (when (or (not *cur-game-tree*) (not chosen))
                 (setf chosen nil)
                 (web-initialize))
               (cond ((lazy-null (caddr *cur-game-tree*))
                      (web-announce-winner (cadr *cur-game-tree*)))
                     ((zerop (car *cur-game-tree*))
                      (web-handle-human
                        (when chosen
                          (read-from-string (cdr chosen)))))
                     (t (web-handle-computer))))
             (tag br ())
             (draw-dod-page *cur-game-tree* *from-tile*))
           (princ "</body></html>")) 
    (princ "Sorry... I don't know that page.")))

在这里我稍作修改，更改了服务器返回给浏览器的信息，使它更加符合标准能在firefox12中运行正常。

我们只做了一个超级简化的服务器，功能弱爆了，但作者许诺能在最后一章很轻易的扩展。之后我们处理些基于webserver的函数

(defun web-initialize ()
  (setf *from-tile* nil)
  (setf *cur-game-tree* (game-tree (gen-board) 0 0 t)))
;宣布胜者web version
(defun web-announce-winner (board)
  (fresh-line)
  (let ((w (winners board)))
    (if (> (length w ) 1)
      (format t "The game is a tie between ~a" (mapcar #'player-letter w))
      (format t "The winner is ~a" (player-letter (car w)))))
  (tag a (href "game.html")
    (princ " play again")))
;处理人类玩家
(defun web-handle-human (pos)
  (cond ((not pos) (princ "Please choose a hex to move from:"))
        ((eq pos 'pass) (setf *cur-game-tree*
                              (cadr (lazy-car (caddr *cur-game-tree*))))
                        (princ "Your reinforcements have been placed.")
                        (tag a (href (make-game-link nil))
                          (princ "continue")))
        ((not *from-tile*) (setf *from-tile* pos)
                           (princ "Now choose a destination:"))
        ((eq pos *from-tile*) (setf *from-tile* nil)
                              (princ "Move cancelled."))
        (t (setf *cur-game-tree*
                 (cadr (lazy-find-if (lambda (move)
                                       (equal (car move)
                                              (list *from-tile* pos)))
                                     (caddr *cur-game-tree*))))
           (setf *from-tile* nil)
           (princ "You may now ")
           (tag a (href (make-game-link 'pass))
             (princ "pass"))
           (princ " or make another move:"))))
;处理计算机玩家
(defun web-handle-computer ()
  (setf *cur-game-tree* (handle-computer *cur-game-tree*))
  (princ "The computer has moved. ")
  (tag script ()
    (princ
      "window.setTimeout('window.location=\"game.html?chosen=NIL\"',3000)")));javascript，改成3秒了，感觉5秒在我这里太慢了

然后在html中绘制svg游戏面板时有些tweak，首先是svg，你遵照之前errata提到的修正svg宏后才能正常显示，否则只显示一小块或完全看不到时可别吃惊。另外是作者定义两次点击同一片游戏面板代表取消，但它的legal-tile（合法面板）中却没有包含本身，以致于不能正常取消选中。我做了如下修改，把当前选中的游戏面板添加进合法面板中。

;caXXXXXXXdr……以后我要用firstsecond改写
(defun draw-dod-page (tree selected-tile)
  (svg *board-width* ;svg要更改！！
       *board-height* 
       (draw-board-svg (cadr tree)
                       selected-tile
                       (cons selected-tile;what I add 
                             (take-all (if selected-tile
                                   (lazy-mapcar
                                     (lambda (move)
                                       (when (eql (caar move)
                                                  selected-tile)
                                         (cadar move)))
                                     (caddr tree))
                                   (lazy-mapcar #'caar (caddr tree))))))))

然后很显然，enjoy我们基于网络的游戏吧

(serve #'dod-request-handler)

---

截个图看看效果