code.delx.au - gnu-emacs-elpa/blob - packages/chess/chess-pos.el

   1 ;;; chess-pos.el --- Routines for manipulating chess positions
   2
   3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
   4
   5 ;; This is free software; you can redistribute it and/or modify it under
   6 ;; the terms of the GNU General Public License as published by the Free
   7 ;; Software Foundation; either version 3, or (at your option) any later
   8 ;; version.
   9 ;;
  10 ;; This is distributed in the hope that it will be useful, but WITHOUT
  11 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  12 ;; FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  13 ;; for more details.
  14 ;;
  15 ;; You should have received a copy of the GNU General Public License
  16 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  17
  18 ;;; Commentary:
  19
  20 ;; A chess `position' is a vector that starts with sixty-four
  21 ;; characters, representing the 8x8 grid of a chess position.  Each
  22 ;; position may contain p, r, n, b, k, q or <space>, or any of the
  23 ;; previous letters in uppercase.  Uppercase signifies white, and
  24 ;; lowercase means black.
  25 ;;
  26 ;; Creating a new position can be done with:
  27 ;;
  28 ;;   (chess-pos-create)
  29 ;;   (chess-pos-copy POSITION)
  30 ;;
  31 ;; To setup the chess board at an aritrary position, manipulate the
  32 ;; position that has been returned to you, or use a position input
  33 ;; module.
  34
  35 ;; Once you have a chess position, there are several things you can do
  36 ;; with it.  First of all, a coordinate system of octal indices is
  37 ;; used, where ?\044 signifies rank 4 file 4 (i.e., "e4").  Rank is
  38 ;; numbered 0 to 7, top to bottom, and file is 0 to 7, left to right.
  39 ;; For those who wish to use ASCII coordinates, such as "e4", there
  40 ;; are two conversion functions:
  41 ;;
  42 ;;    (chess-coord-to-index STRING)
  43 ;;    (chess-index-to-coord INDEX)
  44
  45 ;; With an octal index value, you can look up what's on a particular
  46 ;; square, or set that square's value:
  47 ;;
  48 ;;    (chess-pos-piece POSITION INDEX)
  49 ;;    (chess-pos-set-piece POSITION INDEX PIECE)
  50 ;;
  51 ;; PIECE must be one of the letters mentioned above (in upper or
  52 ;; lowercase), or a space to represent a blank square.
  53 ;;
  54 ;; To test whether a piece is at a particular position, use:
  55 ;;
  56 ;;    (chess-pos-piece-p POSITION INDEX PIECE)
  57 ;;
  58 ;; PIECE may also be t for any white piece, nil for any black piece,
  59 ;; or the symbol `any', which returns t if the square is not empty.
  60
  61 ;; You can hunt for all occurances of a certain piece using:
  62 ;;
  63 ;;    (chess-pos-search POSITION PIECE)
  64 ;;    (chess-pos-search* POSITION PIECE...)
  65 ;;
  66 ;; You might also try the `search' event, which employs the
  67 ;; intelligence of listening rules modules to search out your piece
  68 ;; according to legal piece movements.
  69
  70 ;; Once you have a pair of indices, you can move a piece around:
  71 ;;
  72 ;;    (chess-pos-move POSITION FROM-INDEX TO-INDEX)
  73 ;;
  74 ;; NOTE This is not the safe way for users to move pieces around!
  75 ;; This function moves pieces DIRECTLY, without checking for legality,
  76 ;; or informing listening modules of the move.  To make an "official"
  77 ;; move, use:
  78 ;;
  79 ;;    (chess-move FROM-INDEX TO-INDEX)
  80 ;;
  81 ;; This will publish the move to all listening modules, which can then
  82 ;; handle the move event as they wish.
  83
  84 ;;; Code:
  85
  86 (require 'chess-message)
  87 (require 'chess-fen)
  88 (eval-when-compile
  89   (require 'cl-lib)
  90   (cl-proclaim '(optimize (speed 3) (safety 2))))
  91
  92 (defgroup chess-pos nil
  93   "Routines for manipulating chess positions."
  94   :group 'chess)
  95
  96 (defvar chess-pos-always-white nil
  97   "When set, it is assumed that white is always on move.
  98 This is really only useful when setting up training positions.
  99 This variable automatically becomes buffer-local when changed.")
 100
 101 (make-variable-buffer-local 'chess-pos-always-white)
 102
 103 (defconst chess-starting-position
 104   [;; the eight ranks and files of the chess position
 105    ?r ?n ?b ?q ?k ?b ?n ?r
 106    ?p ?p ?p ?p ?p ?p ?p ?p
 107    ?  ?  ?  ?  ?  ?  ?  ?   ; spaces are blanks!
 108    ?  ?  ?  ?  ?  ?  ?  ?   ; here too
 109    ?  ?  ?  ?  ?  ?  ?  ?   ; protect from whitespace-cleanup
 110    ?  ?  ?  ?  ?  ?  ?  ?   ; so have a comment afterwards
 111    ?P ?P ?P ?P ?P ?P ?P ?P
 112    ?R ?N ?B ?Q ?K ?B ?N ?R
 113    ;; index of pawn that can be captured en passant
 114    nil
 115    ;; can white and black castle on king or queen side?
 116    ?\077 ?\070 ?\007 ?\000
 117    ;; is the side to move in: `check', `checkmate', `stalemate'
 118    nil
 119    ;; which color is it to move next?
 120    t
 121    ;; list of annotations for this position.  Textual annotations are
 122    ;; simply that, while lists represent interesting variations.
 123    nil
 124    ;; where are the kings?
 125    60 4
 126    ;; a pointer to the ply which led to this position
 127    nil]
 128   "Starting position of a regular chess game.")
 129
 130 (chess-message-catalog 'english
 131   '((chess-nag-1   . "good move [traditional \"!\"]")
 132     (chess-nag-2   . "poor move [traditional \"?\"]")
 133     (chess-nag-3   . "very good move (traditional \"!!\"")
 134     (chess-nag-4   . "very poor move (traditional \"??\")")
 135     (chess-nag-5   . "speculative move (traditional \"!?\")")
 136     (chess-nag-6   . "questionable move (traditional \"?!\")")
 137     (chess-nag-7   . "forced move (all others lose quickly)")
 138     (chess-nag-8   . "singular move (no reasonable alternatives)")
 139     (chess-nag-9   . "worst move")
 140     (chess-nag-10  . "drawish position")
 141     (chess-nag-11  . "equal chances, quiet position")
 142     (chess-nag-12  . "equal chances, active position")
 143     (chess-nag-13  . "unclear position")
 144     (chess-nag-14  . "White has a slight advantage")
 145     (chess-nag-15  . "Black has a slight advantage")
 146     (chess-nag-16  . "White has a moderate advantage")
 147     (chess-nag-17  . "Black has a moderate advantage")
 148     (chess-nag-18  . "White has a decisive advantage")
 149     (chess-nag-19  . "Black has a decisive advantage")
 150     (chess-nag-20  . "White has a crushing advantage (Black should resign)")
 151     (chess-nag-21  . "Black has a crushing advantage (White should resign)")
 152     (chess-nag-22  . "White is in zugzwang")
 153     (chess-nag-23  . "Black is in zugzwang")
 154     (chess-nag-24  . "White has a slight space advantage")
 155     (chess-nag-25  . "Black has a slight space advantage")
 156     (chess-nag-26  . "White has a moderate space advantage")
 157     (chess-nag-27  . "Black has a moderate space advantage")
 158     (chess-nag-28  . "White has a decisive space advantage")
 159     (chess-nag-29  . "Black has a decisive space advantage")
 160     (chess-nag-30  . "White has a slight time (development) advantage")
 161     (chess-nag-31  . "Black has a slight time (development) advantage")
 162     (chess-nag-32  . "White has a moderate time (development) advantage")
 163     (chess-nag-33  . "Black has a moderate time (development) advantage")
 164     (chess-nag-34  . "White has a decisive time (development) advantage")
 165     (chess-nag-35  . "Black has a decisive time (development) advantage")
 166     (chess-nag-36  . "White has the initiative")
 167     (chess-nag-37  . "Black has the initiative")
 168     (chess-nag-38  . "White has a lasting initiative")
 169     (chess-nag-39  . "Black has a lasting initiative")
 170     (chess-nag-40  . "White has the attack")
 171     (chess-nag-41  . "Black has the attack")
 172     (chess-nag-42  . "White has insufficient compensation for material deficit")
 173     (chess-nag-43  . "Black has insufficient compensation for material deficit")
 174     (chess-nag-44  . "White has sufficient compensation for material deficit")
 175     (chess-nag-45  . "Black has sufficient compensation for material deficit")
 176     (chess-nag-46  . "White has more than adequate compensation for material deficit")
 177     (chess-nag-47  . "Black has more than adequate compensation for material deficit")
 178     (chess-nag-48  . "White has a slight center control advantage")
 179     (chess-nag-49  . "Black has a slight center control advantage")
 180     (chess-nag-50  . "White has a moderate center control advantage")
 181     (chess-nag-51  . "Black has a moderate center control advantage")
 182     (chess-nag-52  . "White has a decisive center control advantage")
 183     (chess-nag-53  . "Black has a decisive center control advantage")
 184     (chess-nag-54  . "White has a slight kingside control advantage")
 185     (chess-nag-55  . "Black has a slight kingside control advantage")
 186     (chess-nag-56  . "White has a moderate kingside control advantage")
 187     (chess-nag-57  . "Black has a moderate kingside control advantage")
 188     (chess-nag-58  . "White has a decisive kingside control advantage")
 189     (chess-nag-59  . "Black has a decisive kingside control advantage")
 190     (chess-nag-60  . "White has a slight queenside control advantage")
 191     (chess-nag-61  . "Black has a slight queenside control advantage")
 192     (chess-nag-62  . "White has a moderate queenside control advantage")
 193     (chess-nag-63  . "Black has a moderate queenside control advantage")
 194     (chess-nag-64  . "White has a decisive queenside control advantage")
 195     (chess-nag-65  . "Black has a decisive queenside control advantage")
 196     (chess-nag-66  . "White has a vulnerable first rank")
 197     (chess-nag-67  . "Black has a vulnerable first rank")
 198     (chess-nag-68  . "White has a well protected first rank")
 199     (chess-nag-69  . "Black has a well protected first rank")
 200     (chess-nag-70  . "White has a poorly protected king")
 201     (chess-nag-71  . "Black has a poorly protected king")
 202     (chess-nag-72  . "White has a well protected king")
 203     (chess-nag-73  . "Black has a well protected king")
 204     (chess-nag-74  . "White has a poorly placed king")
 205     (chess-nag-75  . "Black has a poorly placed king")
 206     (chess-nag-76  . "White has a well placed king")
 207     (chess-nag-77  . "Black has a well placed king")
 208     (chess-nag-78  . "White has a very weak pawn structure")
 209     (chess-nag-79  . "Black has a very weak pawn structure")
 210     (chess-nag-80  . "White has a moderately weak pawn structure")
 211     (chess-nag-81  . "Black has a moderately weak pawn structure")
 212     (chess-nag-82  . "White has a moderately strong pawn structure")
 213     (chess-nag-83  . "Black has a moderately strong pawn structure")
 214     (chess-nag-84  . "White has a very strong pawn structure")
 215     (chess-nag-85  . "Black has a very strong pawn structure")
 216     (chess-nag-86  . "White has poor knight placement")
 217     (chess-nag-87  . "Black has poor knight placement")
 218     (chess-nag-88  . "White has good knight placement")
 219     (chess-nag-89  . "Black has good knight placement")
 220     (chess-nag-90  . "White has poor bishop placement")
 221     (chess-nag-91  . "Black has poor bishop placement")
 222     (chess-nag-92  . "White has good bishop placement")
 223     (chess-nag-93  . "Black has good bishop placement")
 224     (chess-nag-84  . "White has poor rook placement")
 225     (chess-nag-85  . "Black has poor rook placement")
 226     (chess-nag-86  . "White has good rook placement")
 227     (chess-nag-87  . "Black has good rook placement")
 228     (chess-nag-98  . "White has poor queen placement")
 229     (chess-nag-99  . "Black has poor queen placement")
 230     (chess-nag-100 . "White has good queen placement")
 231     (chess-nag-101 . "Black has good queen placement")
 232     (chess-nag-102 . "White has poor piece coordination")
 233     (chess-nag-103 . "Black has poor piece coordination")
 234     (chess-nag-104 . "White has good piece coordination")
 235     (chess-nag-105 . "Black has good piece coordination")
 236     (chess-nag-106 . "White has played the opening very poorly")
 237     (chess-nag-107 . "Black has played the opening very poorly")
 238     (chess-nag-108 . "White has played the opening poorly")
 239     (chess-nag-109 . "Black has played the opening poorly")
 240     (chess-nag-110 . "White has played the opening well")
 241     (chess-nag-111 . "Black has played the opening well")
 242     (chess-nag-112 . "White has played the opening very well")
 243     (chess-nag-113 . "Black has played the opening very well")
 244     (chess-nag-114 . "White has played the middlegame very poorly")
 245     (chess-nag-115 . "Black has played the middlegame very poorly")
 246     (chess-nag-116 . "White has played the middlegame poorly")
 247     (chess-nag-117 . "Black has played the middlegame poorly")
 248     (chess-nag-118 . "White has played the middlegame well")
 249     (chess-nag-119 . "Black has played the middlegame well")
 250     (chess-nag-120 . "White has played the middlegame very well")
 251     (chess-nag-121 . "Black has played the middlegame very well")
 252     (chess-nag-122 . "White has played the ending very poorly")
 253     (chess-nag-123 . "Black has played the ending very poorly")
 254     (chess-nag-124 . "White has played the ending poorly")
 255     (chess-nag-125 . "Black has played the ending poorly")
 256     (chess-nag-126 . "White has played the ending well")
 257     (chess-nag-127 . "Black has played the ending well")
 258     (chess-nag-128 . "White has played the ending very well")
 259     (chess-nag-129 . "Black has played the ending very well")
 260     (chess-nag-130 . "White has slight counterplay")
 261     (chess-nag-131 . "Black has slight counterplay")
 262     (chess-nag-132 . "White has moderate counterplay")
 263     (chess-nag-133 . "Black has moderate counterplay")
 264     (chess-nag-134 . "White has decisive counterplay")
 265     (chess-nag-135 . "Black has decisive counterplay")
 266     (chess-nag-136 . "White has moderate time control pressure")
 267     (chess-nag-137 . "Black has moderate time control pressure")
 268     (chess-nag-138 . "White has severe time control pressure")
 269     (chess-nag-139 . "Black has severe time control pressure")))
 270
 271 (defsubst chess-pos-piece (position index)
 272   "Return the piece on POSITION at INDEX."
 273   (cl-assert (vectorp position))
 274   (cl-assert (and (>= index 0) (< index 64)))
 275   (aref position index))
 276
 277 (defsubst chess-pos-piece-p (position index piece-or-color)
 278   "Return non-nil if at POSITION/INDEX there is the given PIECE-OR-COLOR.
 279 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 280 color will do."
 281   (cl-assert (vectorp position))
 282   (cl-assert (and (>= index 0) (< index 64)))
 283   (cl-assert (memq piece-or-color
 284                 '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 285   (let ((p (chess-pos-piece position index)))
 286     (cond
 287      ((= p ? ) (eq p piece-or-color))
 288      ((eq piece-or-color t) (< p ?a))
 289      ((eq piece-or-color nil) (> p ?a))
 290      (t (= p piece-or-color)))))
 291
 292 (defsubst chess-rf-to-index (rank file)
 293   "Convert RANK and FILE coordinates into an octal index."
 294   (cl-check-type rank (integer 0 7))
 295   (cl-check-type file (integer 0 7))
 296   (+ (* 8 rank) file))
 297
 298 (defsubst chess-coord-to-index (coord)
 299   "Convert a COORD string into an index value."
 300   (cl-assert (stringp coord))
 301   (cl-assert (= (length coord) 2))
 302   (+ (* 8 (- 7 (- (aref coord 1) ?1)))
 303      (- (aref coord 0) ?a)))
 304
 305 (defsubst chess-index-to-coord (index)
 306   "Convert the chess position INDEX into a coord string."
 307   (cl-assert (and (>= index 0) (< index 64)))
 308   (concat (char-to-string (+ (mod index 8) ?a))
 309           (char-to-string (+ (- 7 (/ index 8)) ?1))))
 310
 311 (defsubst chess-index-rank (index)
 312   "Return the rank component of the given INDEX."
 313   (cl-assert (and (>= index 0) (< index 64)))
 314   (/ index 8))
 315
 316 (defsubst chess-index-file (index)
 317   "Return the file component of the given INDEX."
 318   (cl-assert (and (>= index 0) (< index 64)))
 319   (mod index 8))
 320
 321 (defsubst chess-incr-index (index rank-move file-move)
 322   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE."
 323   (cl-assert (and (>= index 0) (< index 64)))
 324   (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
 325   (cl-assert (and (>= file-move -7) (<= file-move 7)))
 326   (let ((newrank (+ (chess-index-rank index) rank-move))
 327         (newfile (+ (chess-index-file index) file-move)))
 328     (if (and (>= newrank 0) (< newrank 8)
 329              (>= newfile 0) (< newfile 8))
 330         (chess-rf-to-index newrank newfile))))
 331
 332 (defsubst chess-incr-index* (index rank-move file-move)
 333   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE.
 334 This differs from `chess-incr-index' by performing no safety checks,
 335 in order to execute faster."
 336   (cl-assert (and (>= index 0) (< index 64)))
 337   (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
 338   (cl-assert (and (>= file-move -7) (<= file-move 7)))
 339   (chess-rf-to-index (+ (chess-index-rank index) rank-move)
 340                      (+ (chess-index-file index) file-move)))
 341
 342 ;; A 10x12 based scheme to increment indices
 343
 344 (defconst chess-pos-10x12-index
 345   (apply #'vector
 346          (nconc (make-list (* 2 10) nil)
 347                 (cl-loop for rank from 0 to 7
 348                          nconc (nconc (list nil)
 349                                       (cl-loop for file from 0 to 7
 350                                                collect (chess-rf-to-index
 351                                                         rank file))
 352                                       (list nil)))
 353                 (make-list (* 2 10) nil)))
 354   "Map square addresses to square indices.")
 355
 356 (defconst chess-pos-10x12-address
 357   (apply #'vector
 358          (cl-loop for rank from 0 to 7
 359                   nconc (cl-loop for file from 0 to 7
 360                                  collect (+ (* (+ rank 2) 10) 1 file))))
 361   "Map square indices to square addresses.")
 362
 363 (defconst chess-direction-north -10)
 364 (defconst chess-direction-east 1)
 365 (defconst chess-direction-south 10)
 366 (defconst chess-direction-west -1)
 367 (defconst chess-direction-northeast (+ chess-direction-north
 368                                        chess-direction-east))
 369 (defconst chess-direction-southeast (+ chess-direction-south
 370                                        chess-direction-east))
 371 (defconst chess-direction-southwest (+ chess-direction-south
 372                                        chess-direction-west))
 373 (defconst chess-direction-northwest (+ chess-direction-north
 374                                        chess-direction-west))
 375 (defconst chess-direction-north-northeast (+ chess-direction-north
 376                                              chess-direction-northeast))
 377 (defconst chess-direction-east-northeast (+ chess-direction-east
 378                                             chess-direction-northeast))
 379 (defconst chess-direction-east-southeast (+ chess-direction-east
 380                                             chess-direction-southeast))
 381 (defconst chess-direction-south-southeast (+ chess-direction-south
 382                                              chess-direction-southeast))
 383 (defconst chess-direction-south-southwest (+ chess-direction-south
 384                                              chess-direction-southwest))
 385 (defconst chess-direction-west-southwest (+ chess-direction-west
 386                                             chess-direction-southwest))
 387 (defconst chess-direction-west-northwest (+ chess-direction-west
 388                                             chess-direction-northwest))
 389 (defconst chess-direction-north-northwest (+ chess-direction-north
 390                                              chess-direction-northwest))
 391
 392 (defconst chess-rook-directions (list chess-direction-north
 393                                       chess-direction-west
 394                                       chess-direction-east
 395                                       chess-direction-south)
 396   "The directions a rook is allowed to move to.")
 397
 398 (defconst chess-bishop-directions (list chess-direction-northwest
 399                                         chess-direction-northeast
 400                                         chess-direction-southwest
 401                                         chess-direction-southeast)
 402   "The directions a bishop is allowed to move to.")
 403
 404 (defconst chess-knight-directions (list chess-direction-north-northeast
 405                                         chess-direction-east-northeast
 406                                         chess-direction-east-southeast
 407                                         chess-direction-south-southeast
 408                                         chess-direction-south-southwest
 409                                         chess-direction-west-southwest
 410                                         chess-direction-west-northwest
 411                                         chess-direction-north-northwest)
 412   "The directions a knight is allowed to move to.")
 413
 414 (defconst chess-queen-directions (append chess-bishop-directions
 415                                          chess-rook-directions)
 416   "The directions a queen is allowed to move to.")
 417
 418 (defvaralias 'chess-king-directions 'chess-queen-directions
 419   "The directions a king is allowed to move to.")
 420
 421 (defconst chess-sliding-white-piece-directions
 422   (list (list chess-direction-north ?R ?Q)
 423         (list chess-direction-northeast ?B ?Q)
 424         (list chess-direction-east ?R ?Q)
 425         (list chess-direction-southeast ?B ?Q)
 426         (list chess-direction-south ?R ?Q)
 427         (list chess-direction-southwest ?B ?Q)
 428         (list chess-direction-west ?R ?Q)
 429         (list chess-direction-northwest ?B ?Q)))
 430
 431 (defconst chess-sliding-black-piece-directions
 432   (mapcar (lambda (entry) (cons (car entry) (mapcar #'downcase (cdr entry))))
 433           chess-sliding-white-piece-directions))
 434
 435 (defsubst chess-next-index (index direction)
 436   "Create a new INDEX from an old one, by advancing it in DIRECTION.
 437
 438 DIRECTION should be one of
 439 `chess-direction-north' (white pawns, rooks, queens and kings),
 440 `chess-direction-north-northeast' (knights),
 441 `chess-direction-northeast' (bishops, queens and kings),
 442 `chess-direction-east-northeast' (knights),
 443 `chess-direction-east' (rooks, queens and kings),
 444 `chess-direction-east-southeast' (knights),
 445 `chess-direction-southeast' (bishops, queens and kings),
 446 `chess-direction-south-southeast' (knights),
 447 `chess-direction-south' (black pawns, rooks, queens and kings),
 448 `chess-direction-south-southwest' (knights),
 449 `chess-direction-southwest' (bishops, queens and kings),
 450 `chess-direction-west-southwest' (knights),
 451 `chess-direction-west' (rooks, queens and kings),
 452 `chess-direction-west-northwest' (knights),
 453 `chess-direction-northwest' (bishops, queens and kings) or
 454 `chess-direction-north-northwest' (knights).
 455
 456 For predefined lists of all directions a certain piece can go, see
 457 `chess-knight-directions',, `chess-bishop-directions', `chess-rook-directions',
 458 `chess-queen-directions' and `chess-king-directions'.
 459
 460 If the new index is not on the board, nil is returned."
 461   (cl-check-type index (integer 0 63))
 462   (cl-check-type direction (integer -21 21))
 463   (aref chess-pos-10x12-index
 464         (+ (aref chess-pos-10x12-address index) direction)))
 465
 466 (defsubst chess-pos-search (position piece-or-color)
 467   "Look on POSITION anywhere for PIECE-OR-COLOR, returning all coordinates.
 468 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 469 color will do.  See also `chess-pos-search*'."
 470   (cl-assert (vectorp position))
 471   (cl-assert (memq piece-or-color
 472                 '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 473   (let (found)
 474     (dotimes (i 64)
 475       (if (chess-pos-piece-p position i piece-or-color)
 476           (push i found)))
 477     found))
 478
 479 (defsubst chess-pos-search* (position &rest pieces)
 480   "Look on POSITION for any of PIECES.
 481 The result is an alist where each element looks like (PIECE . INDICES).
 482 Pieces which did not appear in POSITION will be present in the resulting
 483 alist, but the `cdr' of their enties will be nil."
 484   (cl-assert (not (null pieces)))
 485   (cl-assert (cl-reduce (lambda (ok piece)
 486                           (when ok
 487                             (memq piece '(?P ?N ?B ?R ?Q ?K ?p ?n ?b ?r ?q ?k))))
 488                         pieces :initial-value t))
 489   (cl-assert (= (length pieces) (length (cl-delete-duplicates pieces))))
 490   (let ((alist (mapcar #'list pieces)))
 491     (dotimes (index 64)
 492       (let ((piece (chess-pos-piece position index)))
 493         (unless (eq piece ? )
 494           (let ((entry (assq piece alist)))
 495             (when entry (push index (cdr entry)))))))
 496     alist))
 497
 498 (defsubst chess-pos-set-king-index (position color index)
 499   "Set the known index of the king on POSITION for COLOR, to INDEX.
 500 It is never necessary to call this function."
 501   (cl-assert (vectorp position))
 502   (cl-assert (memq color '(nil t)))
 503   (cl-assert (and (>= index 0) (< index 64)))
 504   (aset position (if color 72 73) index))
 505
 506 (defsubst chess-pos-king-index (position color)
 507   "Return the index on POSITION of the king.
 508 If COLOR is non-nil, return the position of the white king, otherwise
 509 return the position of the black king."
 510   (cl-assert (vectorp position))
 511   (cl-assert (memq color '(nil t)))
 512   (or (aref position (if color 72 73))
 513       (chess-pos-set-king-index position color
 514                                 (chess-pos-search position (if color ?K ?k)))))
 515
 516 (defsubst chess-pos-set-piece (position index piece)
 517   "Set the piece on POSITION at INDEX to PIECE.
 518 PIECE must be one of K Q N B R or P.  Use lowercase to set black
 519 pieces."
 520   (cl-assert (vectorp position))
 521   (cl-assert (and (>= index 0) (< index 64)))
 522   (cl-assert (memq piece '(?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 523   (aset position index piece)
 524   (if (= piece ?K)
 525       (chess-pos-set-king-index position t index)
 526     (if (= piece ?k)
 527         (chess-pos-set-king-index position nil index))))
 528
 529 (defun chess-pos-can-castle (position side)
 530   "Return whether the king on POSITION can castle on SIDE.
 531 SIDE must be either ?K for the kingside, or ?Q for the queenside (use
 532 lowercase to query if black can castle)."
 533   (cl-assert (vectorp position))
 534   (cl-assert (memq side '(?K ?Q ?k ?q)))
 535   (let* ((index (+ 65 (if (< side ?a)
 536                           (if (= side ?K) 0 1)
 537                         (if (= side ?k) 2 3))))
 538          (value (aref position index)))
 539     (if (or (eq value nil) (integerp value))
 540         value
 541       (when (chess-pos-king-index position (< side ?a))
 542         (let* ((color (< side ?a))
 543                (long (= ?Q (upcase side)))
 544                (file (if long 0 7))
 545                (king-file (chess-index-file
 546                            (chess-pos-king-index position color)))
 547                rook)
 548           (while (funcall (if long '< '>) file king-file)
 549             (let ((index (chess-rf-to-index (if color 7 0) file)))
 550               (if (chess-pos-piece-p position index (if color ?R ?r))
 551                   (setq rook index file king-file)
 552                 (setq file (funcall (if long '1+ '1-) file)))))
 553           (aset position index rook))))))
 554
 555 (defsubst chess-pos-set-can-castle (position side value)
 556   "Set whether the king can castle on the given POSITION on SIDE.
 557
 558 See `chess-pos-can-castle'.
 559
 560 It is only necessary to call this function if setting up a position
 561 manually.  Note that all newly created positions have full castling
 562 priveleges set, unless the position is created blank, in which case
 563 castling priveleges are unset.  See `chess-pos-copy'."
 564   (cl-assert (vectorp position))
 565   (cl-assert (memq side '(?K ?Q ?k ?q)))
 566   (cl-assert (memq value '(nil t)))
 567   (aset position (+ 65 (if (< side ?a)
 568                            (if (= side ?K) 0 1)
 569                          (if (= side ?k) 2 3))) value))
 570
 571 (defsubst chess-pos-en-passant (position)
 572   "Return the index of any pawn on POSITION that can be captured en passant.
 573 Returns nil if en passant is unavailable."
 574   (cl-assert (vectorp position))
 575   (aref position 64))
 576
 577 (defsubst chess-pos-set-en-passant (position index)
 578   "Set the INDEX of any pawn on POSITION that can be captured en passant."
 579   (cl-assert (vectorp position))
 580   (cl-assert (or (eq index nil)
 581               (and (>= index 0) (< index 64))))
 582   (aset position 64 index))
 583
 584 (defsubst chess-pos-status (position)
 585   "Return whether the side to move in the POSITION is in a special state.
 586 nil is returned if not, otherwise one of the symbols: `check',
 587 `checkmate', `stalemate'."
 588   (cl-assert (vectorp position))
 589   (aref position 69))
 590
 591 (defsubst chess-pos-set-status (position value)
 592   "Set whether the side to move in POSITION is in a special state.
 593 VALUE should either be nil, to indicate that the POSITION is normal,
 594 or one of the symbols: `check', `checkmate', `stalemate'."
 595   (cl-assert (vectorp position))
 596   (cl-assert (or (eq value nil) (symbolp value)))
 597   (aset position 69 value))
 598
 599 (defsubst chess-pos-side-to-move (position)
 600   "Return the color whose move it is in POSITION."
 601   (cl-assert (vectorp position))
 602   (aref position 70))
 603
 604 (defsubst chess-pos-set-side-to-move (position color)
 605   "Set the COLOR whose move it is in POSITION."
 606   (cl-assert (vectorp position))
 607   (cl-assert (memq color '(nil t)))
 608   (aset position 70 color))
 609
 610 (defsubst chess-pos-annotations (position)
 611   "Return the list of annotations for this POSITION."
 612   (cl-assert (vectorp position))
 613   (aref position 71))
 614
 615 (defsubst chess-pos-set-annotations (position annotations)
 616   "Set the list of ANNOTATIONS for this POSITION."
 617   (cl-assert (vectorp position))
 618   (cl-assert (listp annotations))
 619   (aset position 71 annotations))
 620
 621 (defun chess-pos-add-annotation (position annotation)
 622   "Add an ANNOTATION for this POSITION."
 623   (cl-assert (vectorp position))
 624   (cl-assert (or (stringp annotation) (listp annotation)))
 625   (let ((ann (chess-pos-annotations position)))
 626     (if ann
 627         (nconc ann (list annotation))
 628       (aset position 71 (list annotation)))))
 629
 630 (defsubst chess-pos-epd (position opcode)
 631   "Return the value of the given EPD OPCODE, or nil if not set."
 632   (cl-assert (vectorp position))
 633   (cl-assert opcode)
 634   (cdr (assq opcode (chess-pos-annotations position))))
 635
 636 (defun chess-pos-set-epd (position opcode &optional value)
 637   "Set the given EPD OPCODE to VALUE, or t if VALUE is not specified."
 638   (cl-assert (vectorp position))
 639   (cl-assert opcode)
 640   (let ((entry (assq opcode (chess-pos-annotations position))))
 641     (if entry
 642         (setcdr entry (or value t))
 643       (chess-pos-add-annotation position (cons opcode (or value t))))))
 644
 645 (defun chess-pos-del-epd (position opcode)
 646   "Delete the given EPD OPCODE."
 647   (cl-assert (vectorp position))
 648   (cl-assert opcode)
 649   (chess-pos-set-annotations
 650    position (assq-delete-all opcode (chess-pos-annotations position))))
 651
 652 (defun chess-pos-preceding-ply (position)
 653   "Return the ply that preceds POSITION."
 654   (cl-assert (vectorp position))
 655   (aref position 74))
 656
 657 (defun chess-pos-set-preceding-ply (position ply)
 658   "Set the preceding PLY for POSITION."
 659   (cl-assert (vectorp position))
 660   (cl-assert (listp ply))
 661   (aset position 74 ply))
 662
 663 (defsubst chess-pos-copy (position)
 664   "Copy the given chess POSITION.
 665 If there are annotations or EPD opcodes set, these lists are copied as
 666 well, so that the two positions do not share the same lists."
 667   (cl-assert (vectorp position))
 668   (let ((copy (vconcat position)) i)
 669     (setq i (chess-pos-annotations position))
 670     (if i (chess-pos-set-annotations copy (copy-alist i)))
 671     copy))
 672
 673 (defsubst chess-pos-create (&optional blank)
 674   "Create a new chess position, set at the starting position.
 675 If BLANK is non-nil, all of the squares will be empty.
 676 The current side-to-move is always white."
 677   (if blank
 678       (vconcat (make-vector 64 ? )
 679                [nil nil nil nil nil nil t nil nil nil nil])
 680     (chess-pos-copy chess-starting-position)))
 681
 682 (defsubst chess-pos-to-string (position &optional full)
 683   "Convert the given POSITION into a string.
 684 The returned string can be converted back to a position using
 685 `chess-pos-from-string'."
 686   (cl-assert (vectorp position))
 687   (chess-pos-to-fen position full))
 688
 689 (defsubst chess-pos-from-string (string)
 690   "Convert the given STRING to a chess position.
 691 This string should have been created by `chess-pos-to-string'."
 692   (cl-assert (stringp string))
 693   (chess-fen-to-pos string))
 694
 695 (defconst chess-pos-piece-values
 696   '((?p . 1)
 697     (?n . 3)
 698     (?b . 3)
 699     (?q . 9)
 700     (?r . 5)
 701     (?k . 0)))
 702
 703 (defun chess-pos-material-value (position color)
 704   "Return the aggregate material value in POSITION for COLOR."
 705   (cl-assert (vectorp position))
 706   (cl-assert (memq color '(nil t)))
 707   (let ((pieces (chess-pos-search position color))
 708         (value 0))
 709     (dolist (index pieces)
 710       (setq value
 711             (+ value (cdr (assq (downcase (chess-pos-piece position index))
 712                                 chess-pos-piece-values)))))
 713     value))
 714
 715 (defun chess-pos-passed-pawns (position color &optional pawn-indices)
 716   "If COLOR has Passed Pawns in POSITION, return a list of their indices.
 717 Optionally, if INDICES is non-nil those indices are considered as candidates.
 718
 719 A Pawn whose advance to the eighth rank is not blocked by an
 720 opposing Pawn in the same file and who does not have to pass one
 721 on an adjoining file is called a passed Pawn."
 722   (let ((seventh (if color 1 6)) (bias (if color -1 1)) (pawn (if color ?p ?P))
 723         pawns)
 724     (dolist (index (or pawn-indices
 725                        (chess-pos-search position (if color ?P ?p))) pawns)
 726       (if (= (chess-index-rank index) seventh)
 727           (push index pawns)
 728         (let ((file (chess-index-file index)))
 729           (if (catch 'passed-pawn
 730                 (let ((test (chess-incr-index index (if color -1 1) 0)))
 731                   (while (funcall (if color '>= '<=)
 732                                   (chess-index-rank test) seventh)
 733                     (if (if (and (> file 0) (< file 7))
 734                             (or (chess-pos-piece-p position test pawn)
 735                                 (chess-pos-piece-p
 736                                  position (chess-incr-index test 0 1) pawn)
 737                                 (chess-pos-piece-p
 738                                  position (chess-incr-index test 0 -1) pawn))
 739                           (or (chess-pos-piece-p position test pawn)
 740                               (chess-pos-piece-p
 741                                position
 742                                (chess-incr-index test 0 (if (zerop file) 1 -1))
 743                                pawn)))
 744                         (throw 'passed-pawn nil)
 745                       (setq test (chess-incr-index test (if color -1 1) 0))))
 746                   t))
 747               (push index pawns)))))))
 748
 749 (chess-message-catalog 'english
 750   '((move-from-blank . "Attempted piece move from blank square %s")))
 751
 752 (defun chess-pos-move (position &rest changes)
 753   "Move a piece on the POSITION directly, using the indices in CHANGES.
 754 This function does not check any rules, it only makes sure you are not
 755 trying to move a blank square."
 756   (cl-assert (vectorp position))
 757   (cl-assert (listp changes))
 758   (cl-assert (> (length changes) 0))
 759
 760   (let* ((color (chess-pos-side-to-move position))
 761          (can-castle-kingside (chess-pos-can-castle position (if color ?K ?k)))
 762          (can-castle-queenside (chess-pos-can-castle position (if color ?Q ?q))))
 763
 764     ;; apply the piece movements listed in `changes'
 765     (let ((ch changes))
 766       (while ch
 767         (if (symbolp (car ch))
 768             (setq ch nil)
 769           (let* ((from (car ch))
 770                  (to (cadr ch))
 771                  (piece (chess-pos-piece position from)))
 772             (if (= piece ? )
 773                 (chess-error 'move-from-blank (chess-index-to-coord from))
 774               (chess-pos-set-piece position from ? )
 775               (chess-pos-set-piece position to piece)))
 776           (setq ch (cddr ch)))))
 777
 778     ;; now fix up the resulting position
 779
 780     ;; if the move was en-passant, remove the captured pawn
 781     (if (memq :en-passant changes)
 782         (chess-pos-set-piece position
 783                              (chess-next-index (cadr changes)
 784                                                (if color
 785                                                    chess-direction-south
 786                                                  chess-direction-north)) ? ))
 787
 788     ;; once a piece is moved, en passant is no longer available
 789     (chess-pos-set-en-passant position nil)
 790
 791     ;; if a king or rook moves, no more castling; also, if a pawn
 792     ;; jumps ahead two, mark it en-passantable
 793     (unless (symbolp (car changes))
 794       (let ((piece (downcase (chess-pos-piece position (cadr changes)))))
 795         (cond
 796          ((= piece ?k)
 797           (chess-pos-set-can-castle position (if color ?K ?k) nil)
 798           (chess-pos-set-can-castle position (if color ?Q ?q) nil))
 799
 800          ((= piece ?r)
 801           (if (and can-castle-queenside
 802                    (= (car changes)
 803                       can-castle-queenside))
 804               (chess-pos-set-can-castle position (if color ?Q ?q) nil)
 805             (if (and can-castle-kingside
 806                      (= (car changes)
 807                         can-castle-kingside))
 808                 (chess-pos-set-can-castle position (if color ?K ?k) nil))))
 809
 810          ((let ((can-castle (chess-pos-can-castle position (if color ?q ?Q))))
 811             (and can-castle (= (cadr changes) can-castle)))
 812           (chess-pos-set-can-castle position (if color ?q ?Q) nil))
 813
 814          ((let ((can-castle (chess-pos-can-castle position (if color ?k ?K))))
 815             (and can-castle (= (cadr changes) can-castle)))
 816           (chess-pos-set-can-castle position (if color ?k ?K) nil))
 817
 818          ((and (= piece ?p)
 819                (> (abs (- (chess-index-rank (cadr changes))
 820                           (chess-index-rank (car changes)))) 1))
 821           (chess-pos-set-en-passant position (cadr changes))))))
 822
 823     ;; toggle the side whose move it is
 824     (unless chess-pos-always-white
 825       (chess-pos-set-side-to-move position (not color)))
 826
 827     ;; promote the piece if we were meant to
 828     (let ((new-piece (cadr (memq :promote changes))))
 829       (if new-piece
 830           (chess-pos-set-piece position (cadr changes)
 831                                (if color
 832                                    new-piece
 833                                  (downcase new-piece)))))
 834
 835     ;; did we leave the position in check, mate or stalemate?
 836     (cond
 837      ((memq :check changes)
 838       (chess-pos-set-status position :check))
 839      ((memq :checkmate changes)
 840       (chess-pos-set-status position :checkmate))
 841      ((memq :stalemate changes)
 842       (chess-pos-set-status position :stalemate))
 843      (t (chess-pos-set-status position nil)))
 844
 845     ;; return the final position
 846     position))
 847
 848 (chess-message-catalog 'english
 849   '((piece-unrecognized . "Unrecognized piece identifier")))
 850
 851 (eval-when-compile
 852   (defvar candidates)
 853   (defvar check-only))
 854
 855 (defsubst chess--add-candidate (candidate)
 856   (if check-only
 857       (throw 'in-check t)
 858     (push candidate candidates)))
 859
 860 (defconst chess-white-can-slide-to
 861   (let ((squares (make-vector 64 nil)))
 862     (dotimes (index 64)
 863       (aset squares index
 864             (cl-loop for dir in chess-sliding-white-piece-directions
 865                      for ray = (let ((square index) (first t))
 866                                  (cl-loop while (setq square (chess-next-index
 867                                                               square (car dir)))
 868                                           collect (cons square
 869                                                         (if first
 870                                                             (cons ?K (cdr dir))
 871                                                           (cdr dir)))
 872                                           do (setq first nil)))
 873                      when ray collect ray)))
 874     squares))
 875 (defconst chess-black-can-slide-to
 876   (let ((squares (make-vector 64 nil)))
 877     (dotimes (index 64)
 878       (aset squares index
 879             (cl-loop for dir in chess-sliding-black-piece-directions
 880                      for ray = (let ((square index) (first t))
 881                                  (cl-loop while (setq square (chess-next-index
 882                                                               square (car dir)))
 883                                           collect (cons square
 884                                                         (if first
 885                                                             (cons ?k (cdr dir))
 886                                                           (cdr dir)))
 887                                           do (setq first nil)))
 888                      when ray collect ray)))
 889     squares))
 890
 891 (defun chess-search-position (position target piece &optional
 892                                        check-only no-castling)
 893   "Look on POSITION from TARGET for a PIECE that can move there.
 894 This routine looks along legal paths of movement for PIECE.  It
 895 differs from `chess-pos-search', which is a more basic function that
 896 doesn't take piece movement into account.
 897
 898 If PIECE is t or nil, legal piece movements for any piece of that
 899 color will be considered (t for white, nil for black).  Otherwise, the
 900 case of the PIECE determines color.
 901
 902 The return value is a list of candidates, which means a list of
 903 indices which indicate where a piece may have moved from.
 904
 905 If CHECK-ONLY is non-nil and PIECE is either t or nil, only consider
 906 pieces which can give check (not the opponents king).
 907 If NO-CASTLING is non-nil, do not consider castling moves."
 908   (cl-assert (vectorp position))
 909   (cl-assert (and (>= target 0) (< target 64)))
 910   (cl-assert (memq piece '(t nil ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 911   (let* ((color (if (characterp piece)
 912                     (< piece ?a)
 913                   piece))
 914          (test-piece (and (characterp piece)
 915                           (upcase piece)))
 916          p pos candidates)
 917     (cond
 918      ;; if the piece is `t', it means to find the candidates resulting
 919      ;; from any piece movement.  This is useful for testing whether a
 920      ;; king is in check, for example.
 921      ((memq piece '(t nil))
 922       ;; test for bishops, rooks, queens and kings at once
 923       (dolist (ray (aref (if piece
 924                              chess-white-can-slide-to
 925                            chess-black-can-slide-to) target))
 926         (while ray
 927           (let ((pos-piece (chess-pos-piece position (caar ray))))
 928             (setq ray (cond ((memq pos-piece (cdar ray))
 929                              (chess--add-candidate (caar ray)) nil)
 930                             ((eq pos-piece ? ) (cdr ray)))))))
 931
 932       ;; test for knights and pawns
 933       (dolist (p (if piece '(?P ?N) '(?p ?n)))
 934         (mapc 'chess--add-candidate
 935               (chess-search-position position target p check-only no-castling)))
 936
 937       ;; test whether the rook or king can move to the target by castling
 938       (unless no-castling
 939         (if (and (or (and (eq target (if color ?\076 ?\006))
 940                           (chess-pos-can-castle position (if color ?K ?k))
 941                           (chess-ply-castling-changes position))
 942                      (and (eq target (if color ?\072 ?\002))
 943                           (chess-pos-can-castle position (if color ?Q ?q))
 944                           (chess-ply-castling-changes position t))))
 945             (chess--add-candidate (chess-pos-king-index position color))
 946           (let (rook)
 947             (if (and (eq target (if color ?\075 ?\005))
 948                      (setq rook (chess-pos-can-castle position (if color ?K ?k)))
 949                      (chess-ply-castling-changes position))
 950                 (chess--add-candidate rook)
 951               (if (and (eq target (if color ?\073 ?\003))
 952                        (setq rook (chess-pos-can-castle position
 953                                                         (if color ?Q ?q)))
 954                        (chess-ply-castling-changes position t))
 955                   (chess--add-candidate rook)))))))
 956
 957      ;; skip erroneous space requests
 958      ((= test-piece ? ))
 959
 960      ;; pawn movement, which is diagonal 1 when taking, but forward
 961      ;; 1 or 2 when moving (the most complex piece, actually)
 962      ((eq test-piece ?P)
 963       (let ((p (chess-pos-piece position target))
 964             (backward (if color chess-direction-south chess-direction-north)))
 965         (if (if (eq p ? )
 966                 ;; check for en passant
 967                 (and (= (chess-index-rank target) (if color 2 5))
 968                      (let ((ep (chess-pos-en-passant position)))
 969                        (when ep
 970                          (= ep (funcall (if color #'+ #'-) target 8))))
 971                      (or (and (setq pos (chess-next-index target
 972                                                           (if color
 973                                                               chess-direction-southwest
 974                                                             chess-direction-northeast)))
 975                               (chess-pos-piece-p position pos
 976                                                  (if color ?P ?p)))
 977                          (and (setq pos (chess-next-index target
 978                                                           (if color
 979                                                               chess-direction-southeast
 980                                                             chess-direction-northwest)))
 981                               (chess-pos-piece-p position pos
 982                                                  (if color ?P ?p)))))
 983               (if color (> p ?a) (< p ?a)))
 984             (progn
 985               (if (and (setq pos (chess-next-index target (if color
 986                                                               chess-direction-southeast
 987                                                             chess-direction-northwest)))
 988                        (chess-pos-piece-p position pos piece))
 989                   (chess--add-candidate pos))
 990               (if (and (setq pos (chess-next-index target (if color
 991                                                               chess-direction-southwest
 992                                                             chess-direction-northeast)))
 993                        (chess-pos-piece-p position pos piece))
 994                   (chess--add-candidate pos)))
 995           (if (setq pos (chess-next-index target backward))
 996               (let ((pos-piece (chess-pos-piece position pos)))
 997                 (if (eq pos-piece piece)
 998                     (chess--add-candidate pos)
 999                   (if (and (eq pos-piece ? )
1000                            (= (if color 4 3) (chess-index-rank target))
1001                            (setq pos (funcall (if color #'+ #'-) pos 8))
1002                            (chess-pos-piece-p position pos piece))
1003                       (chess--add-candidate pos))))))))
1004
1005      ;; the rook, bishop and queen are the easiest; just look along
1006      ;; rank and file and/or diagonal for the nearest pieces!
1007      ((memq test-piece '(?R ?B ?Q))
1008       (dolist (dir (cond
1009                     ((= test-piece ?R) chess-rook-directions)
1010                     ((= test-piece ?B) chess-bishop-directions)
1011                     ((= test-piece ?Q) chess-queen-directions)))
1012         ;; up the current file
1013         (setq pos (chess-next-index target dir))
1014         (while pos
1015           (let ((pos-piece (chess-pos-piece position pos)))
1016             (if (eq pos-piece piece)
1017                 (progn
1018                   (chess--add-candidate pos)
1019                   (setq pos nil))
1020               (setq pos (and (eq pos-piece ? ) (chess-next-index pos dir)))))))
1021       ;; test whether the rook can move to the target by castling
1022       (if (and (= test-piece ?R) (not no-castling))
1023           (let (rook)
1024             (if (and (= target (if color ?\075 ?\005))
1025                      (setq rook (chess-pos-can-castle position
1026                                                       (if color ?K ?k)))
1027                      (chess-ply-castling-changes position))
1028                 (chess--add-candidate rook)
1029               (if (and (= target (if color ?\073 ?\003))
1030                        (setq rook (chess-pos-can-castle position
1031                                                         (if color ?Q ?q)))
1032                        (chess-ply-castling-changes position t))
1033                   (chess--add-candidate rook))))))
1034
1035      ;; the king is a trivial case of the queen, except when castling
1036      ((= test-piece ?K)
1037       (let ((dirs chess-king-directions))
1038         (while dirs
1039           ;; up the current file
1040           (setq pos (chess-next-index target (car dirs)))
1041           (if (and pos (chess-pos-piece-p position pos piece))
1042               (progn
1043                 (chess--add-candidate pos)
1044                 (setq dirs nil))
1045             (setq dirs (cdr dirs))))
1046
1047         ;; test whether the king can move to the target by castling
1048         (if (and (not no-castling)
1049                  (or (and (eq target (if color ?\076 ?\006))
1050                           (chess-pos-can-castle position (if color ?K ?k))
1051                           (chess-ply-castling-changes position))
1052                      (and (eq target (if color ?\072 ?\002))
1053                           (chess-pos-can-castle position (if color ?Q ?q))
1054                           (chess-ply-castling-changes position t))))
1055             (chess--add-candidate (chess-pos-king-index position color)))))
1056
1057      ;; the knight is a zesty little piece; there may be more than
1058      ;; one, but at only one possible square in each direction
1059      ((= test-piece ?N)
1060       (dolist (dir chess-knight-directions)
1061         ;; up the current file
1062         (if (and (setq pos (chess-next-index target dir))
1063                  (chess-pos-piece-p position pos piece))
1064             (chess--add-candidate pos))))
1065
1066      (t (chess-error 'piece-unrecognized)))
1067
1068     ;; prune from the discovered candidates list any moves which would
1069     ;; leave the king in check; castling through check has already
1070     ;; been eliminated.
1071     (if (and candidates (characterp piece))
1072         (setq candidates
1073               (chess-pos-legal-candidates position color target
1074                                           candidates)))
1075
1076     ;; return the final list of candidate moves
1077     candidates))
1078
1079 (defun chess-pos-legal-candidates (position color target candidates)
1080   "Test if TARGET can legally be reached by any of CANDIDATES.
1081 Return the list of candidates that can reach it.
1082
1083 CANDIDATES is a list of position indices which indicate the piece to
1084 be moved, and TARGET is the index of the location to be moved to.
1085
1086 Note: All of the pieces specified by CANDIDATES must be of the same
1087 type.  Also, it is the callers responsibility to ensure that the piece
1088 can legally reach the square in question.  This function merely
1089 assures that the resulting position is valid (the move does not leave the king
1090 in check)."
1091   (cl-assert (vectorp position))
1092   (cl-assert (memq color '(nil t)))
1093   (cl-assert (and (>= target 0) (< target 64)))
1094   (cl-assert (listp candidates))
1095   (cl-assert (> (length candidates) 0))
1096   (let ((cand candidates)
1097         (piece (chess-pos-piece position (car candidates)))
1098         (other-piece (chess-pos-piece position target))
1099         en-passant-square last-cand king-pos)
1100     (while cand
1101       (unwind-protect
1102           (progn
1103             ;; determine the resulting position
1104             (chess-pos-set-piece position (car cand) ? )
1105             (chess-pos-set-piece position target piece)
1106             (when (and (= piece (if color ?P ?p))
1107                        (let ((ep (chess-pos-en-passant position)))
1108                          (when ep
1109                            (= ep (chess-next-index target (if color
1110                                                               chess-direction-south
1111                                                             chess-direction-north))))))
1112               (chess-pos-set-piece position
1113                                    (setq en-passant-square
1114                                          (chess-incr-index target
1115                                                            (if color 1 -1)
1116                                                            0))
1117                                    ? ))
1118             ;; find the king (only once if the king isn't moving)
1119             (if (or (null king-pos)
1120                     (memq piece '(?K ?k)))
1121                 (setq king-pos (chess-pos-king-index position color)))
1122             ;; can anybody from the opposite side reach him?  if so,
1123             ;; drop the candidate
1124             (if (and king-pos
1125                      (catch 'in-check
1126                        (chess-search-position position king-pos
1127                                               (not color) t)))
1128                 (if last-cand
1129                     (setcdr last-cand (cdr cand))
1130                   (setq candidates (cdr candidates)))
1131               (setq last-cand cand)))
1132         ;; return the position to its original state
1133         (chess-pos-set-piece position target other-piece)
1134         (chess-pos-set-piece position (car cand) piece)
1135         (when en-passant-square
1136           (chess-pos-set-piece position en-passant-square (if color ?p ?P))))
1137       ;; try the next candidate
1138       (setq cand (cdr cand)))
1139     candidates))
1140
1141 (provide 'chess-pos)
1142
1143 ;;; chess-pos.el ends here