Dice of Doom

;;Defining Some Global Variables
;玩家数二
(defparameter *num-players* 2)
;一个六边形最多3个骰子
(defparameter *max-dice* 3)
(defparameter *board-size* 2)
;2x2的board
(defparameter *board-hexnum* (* *board-size* *board-size*))
;clean
;将list转化为array，为今后优化做准备
(defun board-array (lst)
  (make-array *board-hexnum* :initial-contents lst))
;dirty
;生成随机的玩家分布和力量
(defun gen-board ()
  (board-array (loop for n below *board-hexnum*
                     collect (list (random *num-players*)
                                   (1+ (random *max-dice*))))))
;clean
;将玩家名由数字转换成字母
(defun player-letter (n)
  (code-char (+ 97 n)))
;dirty
;通过两层循环控制输出，绘制board
(defun draw-board (board)
  (loop for y below *board-size*
        do (progn (fresh-line)
                  (loop repeat (- *board-size* y)
                        do (princ " "))
                  (loop for x below *board-size*
                        for hex = (aref board (+ x (* *board-size* y)))
                        do (format t "~a-~a " (player-letter (first hex))
                                   (second hex))))))
;;;Decoupling Dice of Doom’s Rules from the Rest of the Game
;;Generating a Game Tree
;clean
;产生一个game-tree，形如(player board (moves))
(defun game-tree (board player spare-dice first-move)
  (list player
        board
        (add-passing-move board
                          player
                          spare-dice
                          first-move
                          (attacking-moves board player spare-dice))))
;;Calculating Passing Moves
;clean
;如果是第一次移动则返回原tree的moves，如果不是则添加nil表示
;无法移动，并递归调用game-tree添加玩家移动树
(defun add-passing-move (board player spare-dice first-move moves)
  (if first-move
    moves
    (cons (list nil
                (game-tree (add-new-dice board player (1- spare-dice))
                           (mod (1+ player) *num-players*)
                           0
                           t))
          moves)))
;clean
;Calculating Attacking Moves
;生成攻击可行的攻击game-tree中的moves
(defun attacking-moves (board cur-player spare-dice)
  (labels ((player (pos)
             (car (aref board pos)))
           (dice (pos)
             (cadr (aref board pos))))
    (mapcan (lambda (src)
              (when (eq (player src) cur-player)
                (mapcan (lambda (dst)
                          (when (and (not (eq (player dst) cur-player))
                                     (> (dice src) (dice dst)))
                            (list
                              (list (list src dst)
                                    (game-tree (board-attack board cur-player src dst (dice src))
                                               cur-player
                                               (+ spare-dice (dice dst))
                                               nil)))))
                        (neighbors src))))
            (loop for n below *board-hexnum*
              collect n))))
;Finding the Neighbors
;clean
;返回邻近的pos列表
(defun neighbors (pos)
  (let ((up (- pos *board-size*))
        (down (+ pos *board-size*)))
    (loop for p in (append (list up down)
                           (unless (zerop (mod pos *board-size*))
                             (list (1- up) (1- pos)))
                           (unless (zerop (mod (1+ pos) *board-size*))
                             (list (1+ pos) (1+ down))))
          when (and (>= p 0) (< p *board-hexnum*))
          collect p)))
;Attacking
;clean
;生成attack后的board
(defun board-attack (board player src dst dice)
  (board-array (loop for pos;第一个for为位置
                     for hex across board;数组用across
                     collect (cond ((eq pos src) (list player 1))
                                   ((eq pos dst) (list player (1- dice)))
                                   (t hex)))))
;Reinforcements
;clean
;根据spare-dice添加骰子,返回新的board（数组）
(defun add-new-dice (board player spare-dice)
  (labels ((f (lst n)
             (cond ((null lst) nil)
                   ((zerop n) lst)
                   (t (let ((cur-player (caar lst))
                            (cur-dice (cadar lst)))
                        (if (and (eq cur-player player) (< cur-dice *max-dice*))
                          (cons (list cur-player (1+ cur-dice))
                                (f (cdr lst) (1- n)))
                          (cons (car lst) (f (cdr lst) n))))))))
    (board-array (f (coerce board 'list) spare-dice))))
;;Playing Dice of Doom Against Another Human
;The Main Loop
;dirty
;人人对战主函数
(defun play-vs-human (tree)
  (print-info tree)
  (if (caddr tree)
    (play-vs-human (handle-human tree))
    (announce-winner (cadr tree))))
;Giving Information About the State of the Game
;dirty
;打印当前信息，包括当前玩家和board
(defun print-info (tree)
  (fresh-line)
  (format t "current player = ~a" (player-letter (car tree)))
  (draw-board (cadr tree)))
;Handling Input from Human Players
;dirty
;处理人的行动的函数，根据人的输入返回不同move的子树
(defun handle-human (tree)
  (fresh-line)
  (princ "choose your move:")
  (let ((moves (caddr tree)))
    (loop for move in moves
          for n from 1
          do (let ((action (car move)))
               (fresh-line)
               (format t "~a. " n)
               (if action
                 (format t "~a -> ~a" (car action) (cadr action))
                 (princ "end turn"))))
    (fresh-line)
    (cadr (nth (1- (read)) moves))))

;Determining the Winner
(defun winners (board)
  (let* ((tally (loop for hex across board
                      collect (car hex)))
         (totals (mapcar (lambda (player)
                           (cons player (count player tally)))
                         (remove-duplicates tally)))
         (best (apply #'max (mapcar #'cdr totals))))
    (mapcar #'car
            (remove-if (lambda (x)
                         (not (eq (cdr x) best)))
                       totals))))

(play-vs-human (game-tree (gen-board) 0 0 t))