Frozen
Here is an active version
Trilobite: Player Moves and a Test for Win
In the previous post we have a game board, now it’s time to try to revive it.
Moves
To make a move means to copy a board, simultaneously changing one of the cells to the desired one.
;; 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))))
Form the list of possible cells for the move. These are empty cells located at the very bottom of each column. Of course, if there are free cells on the column at all.
;; 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)))
Checking for a winning situation
The condition for winning the game is to create a line from the *win-len* chips of the same color. We will check for victory after each move. To do this, it is necessary to detect the lines that resulted from the last move. The following figure shows how we will check cells and count the number of identical chips in directions (vectors) starting from the last move[^how-to-make-svg] cell.
For each square of the board we will get the cell numbers and the order in which we need to check them for the presence of chips of the same color. As a result, a list of lists1 is generated.
- (
- (List of cells to the left) (list of cells to the right)
- (List of cells up) 2 (list of cells down)
- (List of cells to the left and up) (list of cells to the right and down)
- (List of cells to the left and down) (list of cells to the right and up)
- )
Next comes a function that actually creates this template for checking the neighbors of any cell on the board. I do not like it, it’s just terrible, too big, confused and completely non-Lisp. But it has no side effects, it depends only on the cell number and several constants, so I hope to rewrite it later without breaking the rest.
;; 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))))))
Having received a template for testing cells, one can proceed with the actual verification. Here one need to take into account that the central cell already contains a chip of the desired color - this is the last move, so the vectors are considered in pairs. That is, if we have two left chips on the left and one desired chip on the right, then in the sum with the central chip we have a line of 2 + 1 + 1 = 4 chips.
The function * test-halfline * is a workhorse: it checks one vector (or half of the line) and counts the number of chips of the desired color in succession.
The function * test-line * simply adds two halves of the line and the central cell itself. Cycles in functions are not observed since lists and tail recursion are not bad friends.
;; 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))))
Checking for a player’s victory turned out ridiculously simple:
;; test for win for player
(defun test-for-win (board cell player)
(>= (count-player-cells board cell player) *win-len*))
You can see how well it is possible to create a template for testing for victory:
* (defparameter *board-width* 10) ; one need to increase the size of the board for clarity
*BOARD-WIDTH*
* (defparameter *board-height* 10)
*BOARD-HEIGHT*
* (defparameter *board-size* (* *board-width* *board-height*))
*BOARD-SIZE*
* (defparameter *win-len* 5) ; Also increase the size of the winning line
*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))
Well, this is the center of the board and the function (after all, I do not like it) has formed all the vectors correctly. Let’s try to choose a cell closer to the upper left corner. In this case, some of the lists should be trimmed.
* (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))
Not bad, the vectors to the left and up are shortened. Another critical cell should be close to the right edge of the board:
* (get-test-patterns 29)
((28 27 26 25) NIL (19 9) (39 49 59 69) (18 7) NIL (38 47 56 65) NIL)
*
Great! Vectors pointing to the right are empty.
The drawings were also created using a tiny [Lisp program (/pub/lisp/create-win-patterns-svg.lisp) and pairs [macros for work with SVG] (/pub/lisp/svg.lisp).
