Трилобит: ходы игроков и проверка на победу

В предыдущей заметке у нас появилась игровая доска, теперь время попробовать её оживить.

Ходы

Сделать ход - значит скопировать доску, попутно заменив одну из клеток на нужную.

;; add move to the board
(defun board-add-move (board move-cell player)
  (board-from-list
    (loop
      for idx from 0
      for cell across board
      collect (if (eql idx move-cell)
                (get-player-color player)
                cell))))

Формируем список возможных клеток для хода. Это пустые клетки, находящиеся в самом низу каждой вертикали. Конечно если на вертикали есть свободные клетки вообще.

;; possible moves
(defun possible-moves (board)
  (labels ((lastlinep (idx)
                (>= idx (- *board-size* *board-width*)))
           (lowest-empty-cellp (idx)
                (and (cell-emptyp board idx)
                     (or (lastlinep idx)
                         (and (not (lastlinep idx))
                              (not (cell-emptyp board
                                     (+ idx *board-width*))))))))
   (loop 
      for cell below *board-size*
      if (lowest-empty-cellp cell)
        collect cell)))

Проверка на победную ситуацию

Условием победы в игре является создание линии из *win-len* фишек одного цвета. Будем проверять на победу после каждого хода. Для этого нужно обнаруживать линии, которые получились в результате последнего хода. На следующем рисунке показано как мы будем проверять клетки и подсчитывать количество одинаковых фишек по направлениям (векторам) начиная от клетки последнего хода¹.

Для каждой клетки доски будем получать номера клеток и порядок, в котором нужно проверить их на наличие фишек одинакового цвета. В результате формируется список списков².

• (
  • (список клеток влево) (список клеток вправо)
  • (список клеток вверх)³ (список клеток вниз)
  • (список клеток налево и вверх) (список клеток направо и вниз)
  • (список клеток налево и вниз) (список клеток направо и вверх)
• )

Далее следует функция, которая собственно и создаёт этот шаблон для проверки соседей любой клетки на доске. Она мне не нравится, она просто ужасна, слишком велика, запутана и совсем не-Lisp’овская. Но она не имеет побочных эффектов, зависит только от номера клетки и нескольких констант, так что я надеюсь переписать её попозже не ломая всего остального.

;; test pattern for win
;; ((left...) (right...)
;;  (up...) (down...)
;;  (left-up...) (right-down...)
;;  (left-down...) (right-up))
(defun get-test-patterns (cell)
  (list
    ; left
    (when (> (mod cell *board-width*) 0)
      (loop
        for off from 1 to (min (1- *win-len*) (mod cell *board-width*))
        collect (- cell off)))
    ; right
    (when (< (mod cell *board-width*) (1- *board-width*))
      (loop
        for off from 1 to (min (1- *win-len*) 
                               (- *board-width* (mod cell *board-width*) 1))
        collect (+ cell off)))
    ; up
    (when (> (floor cell *board-width*) 0)
      (loop
        for off from 1 to (min (1- *win-len*) (floor cell *board-width*))
        collect (- cell (* off *board-width*))))
    ; down
    (when (< cell (- *board-size* *board-width*))
      (loop
        for off from 1 to (min (1- *win-len*)
                               (- *board-height* (floor cell *board-width*) 1))
        collect (+ cell (* off *board-width*))))
    ; left-up
    (when (and (> (mod cell *board-width*) 0) (> (floor cell *board-width*) 0))
      (loop
        for xoff from 1 to (min (1- *win-len*) (mod cell *board-width*))
        for yoff from 1 to (min (1- *win-len*) (floor cell *board-width*))
        collect (- cell (* yoff *board-width*) xoff)))
    ; right-down
    (when (and (< (mod cell *board-width*) (1- *board-width*))
                  (< cell (- *board-size* *board-width*)))
      (loop
        for xoff from 1 to (min (1- *win-len*) 
                               (- *board-width* (mod cell *board-width*) 1))
        for yoff from 1 to (min (1- *win-len*)
                               (- *board-height* (floor cell *board-width*) 1))
        collect (+ cell (* yoff *board-width*) xoff)))
    ; left-down
    (when (and (> (mod cell *board-width*) 0)
               (< cell (- *board-size* *board-width*)))
      (loop
        for xoff from 1 to (min (1- *win-len*) (mod cell *board-width*))
        for yoff from 1 to (min (1- *win-len*)
                               (- *board-height* (floor cell *board-width*) 1))
        collect (- cell (- xoff (* yoff *board-width*)))))
    ; right-up
    (when (and (< (mod cell *board-width*) (1- *board-width*))
               (> (floor cell *board-width*) 0))
      (loop
        for xoff from 1 to (min (1- *win-len*) 
                               (- *board-width* (mod cell *board-width*) 1))
        for yoff from 1 to (min (1- *win-len*) (floor cell *board-width*))
        collect (- cell (- (* yoff *board-width*) xoff))))))

Получив шаблон для проверки клеток можно приступать к собственно проверке. Здесь нужно учесть, что центральная клетка уже содержит фишку нужного цвета - это ведь клетка последнего хода, поэтому вектора рассматриваются попарно. То есть, если у нас слева две нужные фишки и справа одна нужная фишка, то в сумме с центральной фишкой имеем линию длиной 2+1+1=4 фишки.

Функция test-halfline является рабочей лошадкой: она проверяет один вектор (или половину линии) и считает количество фишек нужного цвета идущих подряд.

Функция test-line просто складывает две половинки линии и собственно центральную клетку. Циклов в функциях не наблюдается поскольку списки и хвостовая рекурсия неплохо дружат.

;; count cells with player's color in row
;; pattern is a list of lists
;;      first halfline    second halfline
;; ((cell cell cell...) (cell cell cell...)
;;  other lines
;; ...)
(defun count-player-cells (board cell player)
  (let ((pattern (get-test-patterns cell)))
    (labels 
      ((test-halfline (pat acc1)
                      (if (and pat (cell-playerp board (car pat) player))
                        (test-halfline (cdr pat) (1+ acc1))
                        acc1))
       (test-line (pat acc)
                  (if pat
                    (test-line (cddr pat) 
                               (max acc (+ 1 
                                           (test-halfline (car pat) 0)
                                           (test-halfline (cadr pat) 0))))
                    acc)))
       (test-line pattern 0))))

Проверка на победу игрока получилась до смешного проста:

;; test for win for player
(defun test-for-win (board cell player)
  (>= (count-player-cells board cell player) *win-len*))

Можно посмотреть насколько хорошо удаётся формировать шаблон для проверки на победу:

* (defparameter *board-width* 10) ; нужно увеличить размер доски для наглядности

*BOARD-WIDTH*
* (defparameter *board-height* 10)

*BOARD-HEIGHT*
* (defparameter *board-size* (* *board-width* *board-height*))

*BOARD-SIZE*
* (defparameter *win-len* 5) ; также увеличиваем размер победной линии

*WIN-LEN*
* (get-test-patterns 44)
((43 42 41 40) (45 46 47 48) (34 24 14 4) (54 64 74 84) (33 22 11 0)
 (55 66 77 88) (53 62 71 80) (35 26 17 8))

Ну это центр доски и функция (всё-таки я её не люблю) сформировала все вектора правильно. Попробуем выбрать клетку ближе к левому верхнему углу. В этом случае часть списков должна быть урезана.

* (get-test-patterns 32)

((31 30) (33 34 35 36) (22 12 2) (42 52 62 72) (21 10) (43 54 65 76) (41 50)
 (23 14 5))

Неплохо, вектора влево и вверх укорочены. Другая критичная клетка пусть будет вплотную к правому краю доски:

* (get-test-patterns 29)

((28 27 26 25) NIL (19 9) (39 49 59 69) (18 7) NIL (38 47 56 65) NIL)
*

Замечательно! Векторы, указывающие направо, пусты.

1. Рисунки были созданы также с помощью крошечной Lisp программки и пары макросов для работы с SVG. ↩

2. А что вы хотели? Язык обработки списков всё таки!  ↩

3. Вверх можно и не проверять, но возможно пригодится. ↩

Также можно почитать

• 18 May 2018 » Преобразователь логических уровней
• 09 Apr 2018 » Хранение температуры в базе данных
• 28 Mar 2018 » Raspberry Pi и 1-wire устройства

---

Tweet