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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Routines for manipulating chess positions
   4 ;;
   5
   6 ;;; Commentary:
   7
   8 ;; A chess `position' is a vector that starts with sixty-four
   9 ;; characters, representing the 8x8 grid of a chess position.  Each
  10 ;; position may contain p, r, n, b, k, q or <space>, or any of the
  11 ;; previous letters in uppercase.  Uppercase signifies white, and
  12 ;; lowercase means black.
  13 ;;
  14 ;; Creating a new position can be done with:
  15 ;;
  16 ;;   (chess-pos-create)
  17 ;;   (chess-pos-copy POSITION)
  18 ;;
  19 ;; To setup the chess board at an aritrary position, manipulate the
  20 ;; position that has been returned to you, or use a position input
  21 ;; module.
  22
  23 ;; Once you have a chess position, there are several things you can do
  24 ;; with i.  First of all, a coordinate system of octal indices is
  25 ;; used, where ?\044 signifies rank 4 file 4 (i.e., "e4").  Rank is
  26 ;; numbered 0 to 7, top to bottom, and file is 0 to 7, left to right.
  27 ;; For those who wish to use ASCII coordinates, such as "e4", there
  28 ;; are two conversion functions:
  29 ;;
  30 ;;    (chess-coord-to-index STRING)
  31 ;;    (chess-index-to-coord INDEX)
  32
  33 ;; With an octal index value, you can look up what's on a particular
  34 ;; square, or set that square's value:
  35 ;;
  36 ;;    (chess-pos-piece POSITION INDEX)
  37 ;;    (chess-pos-set-piece POSITION INDEX PIECE)
  38 ;;
  39 ;; PIECE must be one of the letters mentioned above (in upper or
  40 ;; lowercase), or a space to represent a blank square.
  41 ;;
  42 ;; To test whether a piece is at a particular position, use:
  43 ;;
  44 ;;    (chess-pos-piece-p POSITION INDEX PIECE)
  45 ;;
  46 ;; PIECE may also be t for any white piece, nil for any black piece,
  47 ;; or the symbol `any', which returns t if the square is not empty.
  48
  49 ;; You can hunt for all occurances of a certain piece using:
  50 ;;
  51 ;;    (chess-pos-search POSITION PIECE)
  52 ;;
  53 ;; You might also try the `search' event, which employs the
  54 ;; intelligence of listening rules modules to search out your piece
  55 ;; according to legal piece movements.
  56
  57 ;; Once you have a pair of indices, you can move a piece around:
  58 ;;
  59 ;;    (chess-pos-move POSITION FROM-INDEX TO-INDEX)
  60 ;;
  61 ;; NOTE This is not the safe way for users to move pieces around!
  62 ;; This function moves pieces DIRECTLY, without checking for legality,
  63 ;; or informing listening modules of the move.  To make an "official"
  64 ;; move, use:
  65 ;;
  66 ;;    (chess-move FROM-INDEX TO-INDEX)
  67 ;;
  68 ;; This will publish the move to all listening modules, which can then
  69 ;; handle the move event as they wish.
  70
  71 ;;; Code:
  72
  73 (require 'chess-message)
  74 (require 'chess-fen)
  75
  76 (defgroup chess-pos nil
  77   "Routines for manipulating chess positions."
  78   :group 'chess)
  79
  80 (defvar chess-pos-always-white nil
  81   "When set, it is assumed that white is always on move.
  82 This is really only useful when setting up training positions.
  83 This variable automatically becomes buffer-local when changed.")
  84
  85 (make-variable-buffer-local 'chess-pos-always-white)
  86
  87 (defconst chess-starting-position
  88   [;; the eight ranks and files of the chess position
  89    ?r ?n ?b ?q ?k ?b ?n ?r
  90    ?p ?p ?p ?p ?p ?p ?p ?p
  91    ?  ?  ?  ?  ?  ?  ?  ?   ; spaces are blanks!
  92    ?  ?  ?  ?  ?  ?  ?  ?   ; here too
  93    ?  ?  ?  ?  ?  ?  ?  ?   ; protect from whitespace-cleanup
  94    ?  ?  ?  ?  ?  ?  ?  ?   ; so have a comment afterwards
  95    ?P ?P ?P ?P ?P ?P ?P ?P
  96    ?R ?N ?B ?Q ?K ?B ?N ?R
  97    ;; index of pawn that can be captured en passant
  98    nil
  99    ;; can white and black castle on king or queen side?
 100    t t t t
 101    ;; is the side to move in: `check', `checkmate', `stalemate'
 102    nil
 103    ;; which color is it to move next?
 104    t
 105    ;; list of annotations for this position.  Textual annotations are
 106    ;; simply that, while lists represent interesting variations.
 107    nil
 108    ;; where are the kings?
 109    60 4
 110    ;; an alist of epd evaluation codes and arguments
 111    nil]
 112   "Starting position of a chess position.")
 113
 114 (defsubst chess-pos-piece (position index)
 115   "Return the piece on POSITION at INDEX."
 116   (assert position)
 117   (assert (and (>= index 0) (< index 64)))
 118   (aref position index))
 119
 120 (defsubst chess-pos-king-index (position color)
 121   "Return the index on POSITION of the king.
 122 If COLOR is non-nil, return the position of the white king, otherwise
 123 return the position of the black king."
 124   (assert position)
 125   (assert (memq color '(nil t)))
 126   (or (aref position (if color 72 73))
 127       (aset position (if color 72 73)
 128             (chess-pos-search position (if color ?K ?k)))))
 129
 130 (defsubst chess-pos-set-king-pos (position color index)
 131   "Set the known index of the king on POSITION for COLOR, to INDEX.
 132 It is never necessary to call this function."
 133   (assert position)
 134   (assert (memq color '(nil t)))
 135   (assert (and (>= index 0) (< index 64)))
 136   (aset position (if color 72 73) index))
 137
 138 (defsubst chess-pos-set-piece (position index piece)
 139   "Set the piece on POSITION at INDEX to PIECE.
 140 PIECE must be one of K Q N B R or P.  Use lowercase to set black
 141 pieces."
 142   (assert position)
 143   (assert (and (>= index 0) (< index 64)))
 144   (assert (memq piece '(?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 145   (aset position index piece)
 146   (if (= piece ?K)
 147       (chess-pos-set-king-pos position t index)
 148     (if (= piece ?k)
 149         (chess-pos-set-king-pos position nil index))))
 150
 151 (defsubst chess-pos-can-castle (position side)
 152   "Return whether the king on POSITION can castle on SIDE.
 153 SIDE must be either ?K for the kingside, or ?Q for the queenside (use
 154 lowercase to query if black can castle)."
 155   (assert position)
 156   (assert (memq side '(?K ?Q ?k ?q)))
 157   (aref position (+ 65 (if (< side ?a)
 158                            (if (= side ?K) 0 1)
 159                          (if (= side ?k) 2 3)))))
 160
 161 (defsubst chess-pos-set-can-castle (position side value)
 162   "Set whether the king can castle on the given POSITION on SIDE.
 163
 164 See `chess-pos-can-castle'.
 165
 166 It is only necessary to call this function if setting up a position
 167 manually.  Note that all newly created positions have full castling
 168 priveleges set, unless the position is created blank, in which case
 169 castling priveleges are unset.  See `chess-pos-copy'."
 170   (assert position)
 171   (assert (memq side '(?K ?Q ?k ?q)))
 172   (assert (memq value '(nil t)))
 173   (aset position (+ 65 (if (< side ?a)
 174                            (if (= side ?K) 0 1)
 175                          (if (= side ?k) 2 3))) value))
 176
 177 (defsubst chess-pos-en-passant (position)
 178   "Return the index of any pawn on POSITION that can be captured en passant.
 179 Returns nil if en passant is unavailable."
 180   (assert position)
 181   (aref position 64))
 182
 183 (defsubst chess-pos-set-en-passant (position index)
 184   "Set the index of any pawn on POSITION that can be captured en passant."
 185   (assert position)
 186   (assert (or (eq index nil)
 187               (and (>= index 0) (< index 64))))
 188   (aset position 64 index))
 189
 190 (defsubst chess-pos-status (position)
 191   "Return whether the side to move in the POSITION is in a special state.
 192 nil is returned if not, otherwise one of the symbols: `check',
 193 `checkmate', `stalemate'."
 194   (assert position)
 195   (aref position 69))
 196
 197 (defsubst chess-pos-set-status (position value)
 198   "Set whether the side to move in POSITION is in a special state.
 199 VALUE should either be nil, to indicate that the POSITION is normal,
 200 or one of the symbols: `check', `checkmate', `stalemate'."
 201   (assert position)
 202   (assert (or (eq value nil) (symbolp value)))
 203   (aset position 69 values))
 204
 205 (defsubst chess-pos-side-to-move (position)
 206   "Return the color whose move it is in POSITION."
 207   (assert position)
 208   (aref position 70))
 209
 210 (defsubst chess-pos-set-side-to-move (position color)
 211   "Set the color whose move it is in POSITION."
 212   (assert position)
 213   (assert (memq color '(nil t)))
 214   (aset position 70 color))
 215
 216 (defsubst chess-pos-annotations (position)
 217   "Return the list of annotations for this position."
 218   (assert position)
 219   (aref position 71))
 220
 221 (defsubst chess-pos-set-annotations (position annotations)
 222   "Return the list of annotations for this position."
 223   (assert position)
 224   (assert (listp annotations))
 225   (aset position 71 annotations))
 226
 227 (defun chess-pos-add-annotation (position annotation)
 228   "Add an annotation for this position."
 229   (assert position)
 230   (assert (or (stringp annotation) (listp annotation)))
 231   (let ((ann (chess-pos-annotations position)))
 232     (if ann
 233         (nconc ann (list annotation))
 234       (aset position 71 (list annotation)))))
 235
 236 (defsubst chess-pos-epd-alist (position)
 237   "Return the alist of EPD evaluations for this position."
 238   (assert position)
 239   (aref position 74))
 240
 241 (defsubst chess-pos-set-epd-alist (position alist)
 242   "Return the alist of EPD evaluations for this position."
 243   (assert position)
 244   (assert (listp alist))
 245   (aset position 74 alist))
 246
 247 (defsubst chess-pos-epd (position opcode)
 248   "Return the value of the given EPD OPCODE, or nil if not set."
 249   (assert position)
 250   (assert opcode)
 251   (let ((epd (chess-pos-epd-alist position)))
 252     (if epd
 253         (cdr (assq opcode epd)))))
 254
 255 (defun chess-pos-set-epd (position opcode &optional value)
 256   "Set the given EPD OPCODE to VALUE, or t if VALUE is not specified."
 257   (assert position)
 258   (assert opcode)
 259   (let* ((epd (chess-pos-epd-alist position))
 260          (entry (assq opcode epd)))
 261     (if entry
 262         (setcdr entry (or value t))
 263       (push (cons opcode (or value t)) epd))))
 264
 265 (defun chess-pos-del-epd (position opcode)
 266   "Delete the given EPD OPCODE."
 267   (assert position)
 268   (assert opcode)
 269   (chess-pos-set-epd-alist position
 270                            (assq-delete-all opcode
 271                                             (chess-pos-epd-alist position))))
 272
 273 (defsubst chess-pos-copy (position)
 274   "Copy the given chess POSITION.
 275 If there are annotations or EPD opcodes set, these lists are copied as
 276 well, so that the two positions do not share the same lists."
 277   (assert position)
 278   (let ((copy (vconcat position)) i)
 279     (setq i (chess-pos-annotations position))
 280     (if i (chess-pos-set-annotations copy (copy-alist i)))
 281     (setq i (chess-pos-epd-alist position))
 282     (if (and (not (eq i nil)) (listp i))
 283         (chess-pos-set-epd-alist copy (copy-alist i)))
 284     copy))
 285
 286 (defsubst chess-pos-create (&optional blank)
 287   "Create a new chess position, set at the starting position.
 288 If BLANK is non-nil, all of the squares will be empty.
 289 The current side-to-move is always white."
 290   (if blank
 291       (vconcat (make-vector 64 ? )
 292                [nil nil nil nil nil nil t nil nil nil nil])
 293     (chess-pos-copy chess-starting-position)))
 294
 295 (defsubst chess-rf-to-index (rank file)
 296   "Convert RANK and FILE coordinates into an octal index."
 297   (assert (or (>= rank 0) (< rank 8)))
 298   (assert (or (>= file 0) (< file 8)))
 299   (+ (* 8 rank) file))
 300
 301 (defsubst chess-coord-to-index (coord)
 302   "Convert a COORD string into an index value."
 303   (assert (stringp coord))
 304   (assert (= (length coord) 2))
 305   (+ (* 8 (- 7 (- (aref coord 1) ?1)))
 306      (- (aref coord 0) ?a)))
 307
 308 (defsubst chess-index-to-coord (index)
 309   "Convert the chess position INDEX into a coord string."
 310   (assert (and (>= index 0) (< index 64)))
 311   (concat (char-to-string (+ (mod index 8) ?a))
 312           (char-to-string (+ (- 7 (/ index 8)) ?1))))
 313
 314 (defsubst chess-index-rank (index)
 315   "Return the rank component of the given INDEX."
 316   (assert (and (>= index 0) (< index 64)))
 317   (/ index 8))
 318
 319 (defsubst chess-index-file (index)
 320   "Return the file component of the given INDEX."
 321   (assert (and (>= index 0) (< index 64)))
 322   (mod index 8))
 323
 324 (defsubst chess-incr-index (index rank-move file-move)
 325   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE."
 326   (assert (and (>= index 0) (< index 64)))
 327   (assert (and (>= rank-move -7) (<= rank-move 7)))
 328   (assert (and (>= file-move -7) (<= file-move 7)))
 329   (let ((newrank (+ (chess-index-rank index) rank-move))
 330         (newfile (+ (chess-index-file index) file-move)))
 331     (if (and (>= newrank 0) (< newrank 8)
 332              (>= newfile 0) (< newfile 8))
 333         (chess-rf-to-index newrank newfile))))
 334
 335 (defsubst chess-incr-index* (index rank-move file-move)
 336   "Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE.
 337 This differs from `chess-incr-index' by performing no safety checks,
 338 in order to execute faster."
 339   (assert (and (>= index 0) (< index 64)))
 340   (assert (and (>= rank-move -7) (<= rank-move 7)))
 341   (assert (and (>= file-move -7) (<= file-move 7)))
 342   (chess-rf-to-index (+ (chess-index-rank index) rank-move)
 343                      (+ (chess-index-file index) file-move)))
 344
 345 (defsubst chess-pos-piece-p (position index piece-or-color)
 346   "Return non-nil if at POSITION/INDEX there is the given PIECE-OR-COLOR.
 347 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 348 color will do."
 349   (assert position)
 350   (assert (and (>= index 0) (< index 64)))
 351   (assert (memq piece-or-color
 352                 '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 353   (let ((p (chess-pos-piece position index)))
 354     (cond
 355      ((= p ? ) (eq p piece-or-color))
 356      ((eq piece-or-color t) (< p ?a))
 357      ((eq piece-or-color nil) (> p ?a))
 358      (t (= p piece-or-color)))))
 359
 360 (defsubst chess-pos-search (position piece-or-color)
 361   "Look on POSITION anywhere for PIECE-OR-COLOR, returning all coordinates.
 362 If PIECE-OR-COLOR is t for white or nil for black, any piece of that
 363 color will do."
 364   (assert position)
 365   (assert (memq piece-or-color
 366                 '(t nil ?  ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 367   (let (found)
 368     (dotimes (i 64)
 369       (if (chess-pos-piece-p position i piece-or-color)
 370           (push i found)))
 371     found))
 372
 373 (defsubst chess-pos-to-string (position &optional full)
 374   "Convert the given POSITION into a string.
 375 The returned string can be converted back to a position using
 376 `chess-pos-from-string'."
 377   (assert position)
 378   (chess-pos-to-fen position full))
 379
 380 (defsubst chess-pos-from-string (string)
 381   "Convert the given STRING to a chess position.
 382 This string should have been created by `chess-pos-to-string'."
 383   (assert (stringp string))
 384   (chess-fen-to-pos string))
 385
 386 (defconst chess-pos-piece-values
 387   '((?p . 1)
 388     (?n . 3)
 389     (?b . 3)
 390     (?q . 9)
 391     (?r . 5)
 392     (?k . 0)))
 393
 394 (defun chess-pos-material-value (position color)
 395   "Return the aggregate material value in POSITION for COLOR."
 396   (assert position)
 397   (assert (memq color '(nil t)))
 398   (let ((pieces (chess-pos-search position color))
 399         (value 0))
 400     (dolist (index pieces)
 401       (setq value
 402             (+ value (cdr (assq (downcase (chess-pos-piece position index))
 403                                 chess-pos-piece-values)))))
 404     value))
 405
 406 (chess-message-catalog 'english
 407   '((move-from-blank . "Attempted piece move from blank square %s")))
 408
 409 (defun chess-pos-move (position &rest changes)
 410   "Move a piece on the POSITION directly, using the indices FROM and TO.
 411 This function does not check any rules, it only makes sure you are not
 412 trying to move a blank square."
 413   (assert position)
 414   (assert (listp changes))
 415   (assert (> (length changes) 0))
 416   (let ((ch changes))
 417     (while ch
 418       (if (symbolp (car ch))
 419           (setq ch nil)
 420         (let* ((from (car ch))
 421                (to (cadr ch))
 422                (piece (chess-pos-piece position from)))
 423           (if (= piece ? )
 424               (chess-error 'move-from-blank (chess-index-to-coord from)))
 425           (chess-pos-set-piece position from ? )
 426           (chess-pos-set-piece position to piece))
 427         (setq ch (cddr ch)))))
 428
 429   ;; now fix up the resulting position
 430   (let ((color (chess-pos-side-to-move position)))
 431
 432     ;; if the move was en-passant, remove the captured pawn
 433     (if (memq :en-passant changes)
 434         (chess-pos-set-piece position
 435                              (chess-incr-index (cadr changes)
 436                                                (if color 1 -1) 0) ? ))
 437
 438     ;; once a piece is moved, en passant is no longer available
 439     (chess-pos-set-en-passant position nil)
 440
 441     ;; if a king or rook moves, no more castling; also, if a pawn
 442     ;; jumps ahead two, mark it en-passantable
 443     (unless (symbolp (car changes))
 444       (let ((piece (downcase (chess-pos-piece position (cadr changes)))))
 445         (cond
 446          ((= piece ?k)
 447           (chess-pos-set-can-castle position (if color ?K ?k) nil)
 448           (chess-pos-set-can-castle position (if color ?Q ?q) nil))
 449
 450          ((= piece ?r)
 451           (let ((king (chess-pos-king-index position color)))
 452             (if (and (chess-pos-can-castle position (if color ?Q ?q))
 453                      (< (chess-index-file (car changes)) king))
 454                 (chess-pos-set-can-castle position (if color ?Q ?q) nil)
 455               (if (and (chess-pos-can-castle position (if color ?K ?k))
 456                        (> (chess-index-file (car changes)) king))
 457                   (chess-pos-set-can-castle position (if color ?K ?k) nil)))))
 458
 459          ((and (= piece ?p)
 460                (> (abs (- (chess-index-rank (cadr changes))
 461                           (chess-index-rank (car changes)))) 1))
 462           (chess-pos-set-en-passant position (cadr changes))))))
 463
 464     ;; toggle the side whose move it is
 465     (unless chess-pos-always-white
 466       (chess-pos-set-side-to-move position (not color)))
 467
 468     ;; promote the piece if we were meant to
 469     (let ((new-piece (cadr (memq :promote changes))))
 470       (if new-piece
 471           (chess-pos-set-piece position (cadr changes)
 472                                (if color
 473                                    new-piece
 474                                  (downcase new-piece)))))
 475
 476     ;; did we leave the position in check, mate or stalemate?
 477     (chess-pos-set-status position nil)
 478     (cond
 479      ((memq :check changes)
 480       (chess-pos-set-status position :check))
 481      ((memq :checkmate changes)
 482       (chess-pos-set-status position :checkmate))
 483      ((memq :stalemate changes)
 484       (chess-pos-set-status position :stalemate)))
 485
 486     ;; return the final position
 487     position))
 488
 489 (chess-message-catalog 'english
 490   '((piece-unrecognized . "Unrecognized piece identifier")))
 491
 492 (eval-when-compile
 493   (defvar candidates)
 494   (defvar check-only))
 495
 496 (defsubst chess--add-candidate (candidate)
 497   (if check-only
 498       (throw 'in-check t)
 499     (push candidate candidates)))
 500
 501 (defun chess-search-position (position target piece &optional check-only)
 502   "Look on POSITION from TARGET for a PIECE that can move there.
 503 This routine looks along legal paths of movement for PIECE.  It
 504 differs from `chess-pos-search', which is a more basic function that
 505 doesn't take piece movement into account.
 506
 507 If PIECE is t or nil, legal piece movements for any piece of that
 508 color will be considered (t for white, nil for black).  Otherwise, the
 509 case of the PIECE determines color.
 510
 511 The return value is a list of candidates, which means a list of
 512 indices which indicate where a piece may have moved from."
 513   (assert position)
 514   (assert (and (>= target 0) (< target 64)))
 515   (assert (memq piece '(t nil ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
 516   (let* ((color (if (char-valid-p piece)
 517                     (< piece ?a)
 518                   piece))
 519          (bias (if color -1 1))
 520          (test-piece (and (char-valid-p piece)
 521                           (upcase piece)))
 522          p pos candidates)
 523     (cond
 524      ;; if the piece is `t', it means to find the candidates resulting
 525      ;; from any piece movement.  This is useful for testing whether a
 526      ;; king is in check, for example.
 527      ((memq piece '(t nil))
 528       (dolist (p (if check-only
 529                      '(?P ?R ?N ?B ?Q)
 530                    '(?P ?R ?N ?B ?Q ?K)))
 531         (mapc 'chess--add-candidate
 532               (chess-search-position position target
 533                                      (if piece p (downcase p))))))
 534
 535      ;; skip erroneous space requests
 536      ((= test-piece ? ))
 537
 538      ;; pawn movement, which is diagonal 1 when taking, but forward
 539      ;; 1 or 2 when moving (the most complex piece, actually)
 540      ((= test-piece ?P)
 541       (let ((p (chess-pos-piece position target)))
 542         (if (if (= p ? )
 543                 ;; check for en passant
 544                 (and (= (chess-index-rank target) (if color 2 5))
 545                      ;; make this fail if no en-passant is possible
 546                      (= (or (chess-pos-en-passant position) 100)
 547                         (or (chess-incr-index target (if color 1 -1) 0) 200))
 548                      (or (and (setq pos (chess-incr-index target
 549                                                           (if color 1 -1) -1))
 550                               (chess-pos-piece-p position pos
 551                                                  (if color ?P ?p)))
 552                          (and (setq pos (chess-incr-index target
 553                                                           (if color 1 -1) 1))
 554                               (chess-pos-piece-p position pos
 555                                                  (if color ?P ?p)))))
 556               (if color (> p ?a) (< p ?a)))
 557             (progn
 558               (if (and (setq pos (chess-incr-index target (- bias) -1))
 559                        (chess-pos-piece-p position pos piece))
 560                   (chess--add-candidate pos))
 561               (if (and (setq pos (chess-incr-index target (- bias) 1))
 562                        (chess-pos-piece-p position pos piece))
 563                   (chess--add-candidate pos)))
 564           (if (setq pos (chess-incr-index target (- bias) 0))
 565               (if (chess-pos-piece-p position pos piece)
 566                   (chess--add-candidate pos)
 567                 (if (and (chess-pos-piece-p position pos ? )
 568                          (= (if color 4 3) (chess-index-rank target))
 569                          (setq pos (chess-incr-index pos (- bias) 0))
 570                          (chess-pos-piece-p position pos piece))
 571                     (chess--add-candidate pos)))))))
 572
 573      ;; the rook, bishop and queen are the easiest; just look along
 574      ;; rank and file and/or diagonal for the nearest pieces!
 575      ((memq test-piece '(?R ?B ?Q))
 576       (dolist (dir (cond
 577                     ((= test-piece ?R)
 578                      '(        (-1 0)
 579                        (0 -1)          (0 1)
 580                                (1 0)))
 581                     ((= test-piece ?B)
 582                      '((-1 -1)        (-1 1)
 583
 584                        (1 -1)         (1 1)))
 585                     ((= test-piece ?Q)
 586                      '((-1 -1) (-1 0) (-1 1)
 587                         (0 -1)         (0 1)
 588                         (1 -1)  (1 0)  (1 1)))))
 589         ;; up the current file
 590         (setq pos (apply 'chess-incr-index target dir))
 591         ;; jww (2002-04-11): In Fischer Random castling, the rook can
 592         ;; move in wacky ways
 593         (while pos
 594           (if (chess-pos-piece-p position pos piece)
 595               (progn
 596                 (chess--add-candidate pos)
 597                 (setq pos nil))
 598             (setq pos (and (chess-pos-piece-p position pos ? )
 599                            (apply 'chess-incr-index pos dir)))))))
 600
 601      ;; the king is a trivial case of the queen, except when castling
 602      ((= test-piece ?K)
 603       (let ((dirs '((-1 -1) (-1 0) (-1 1)
 604                      (0 -1)         (0 1)
 605                      (1 -1)  (1 0)  (1 1))))
 606         (while dirs
 607           ;; up the current file
 608           (setq pos (apply 'chess-incr-index target (car dirs)))
 609           (if (and pos (chess-pos-piece-p position pos piece))
 610               (progn
 611                 (chess--add-candidate pos)
 612                 (setq dirs nil))
 613             (setq dirs (cdr dirs)))))
 614
 615       (let ((rank (if color 7 0)))
 616         ;; if we can still castle, then the king and rook are in their
 617         ;; squares; also, make sure that the user is not attempting to
 618         ;; castle through check
 619         (if (and (null candidates)
 620                  (or (and (equal target (chess-rf-to-index rank 6))
 621                           (chess-pos-can-castle position (if color ?K ?k)))
 622                      (and (equal target (chess-rf-to-index rank 2))
 623                           (chess-pos-can-castle position (if color ?Q ?q)))))
 624             (let* ((king (chess-pos-king-index position color))
 625                    (king-file (chess-index-file king))
 626                    (long (= 2 (chess-index-file target)))
 627                    (file (if long 1 6))
 628                    (legal t))
 629               ;; jww (2002-04-10): this needs to be a bit more subtle
 630               ;; for Fischer Random castling
 631               (while (and legal (funcall (if long '< '>) file king-file))
 632                 (setq pos (chess-rf-to-index rank file))
 633                 (if (or (not (chess-pos-piece-p position pos ? ))
 634                         (chess-search-position position pos (not color)))
 635                     (setq legal nil)
 636                   (setq file (funcall (if long '1+ '1-) file))))
 637               (if legal
 638                   (chess--add-candidate (chess-rf-to-index rank 4)))))))
 639
 640      ;; the knight is a zesty little piece; there may be more than
 641      ;; one, but at only one possible square in each direction
 642      ((= test-piece ?N)
 643       (dolist (dir '((-2 -1) (-2 1)
 644                      (-1 -2) (-1 2)
 645                       (1 -2)  (1 2)
 646                       (2 -1)  (2 1)))
 647         ;; up the current file
 648         (if (and (setq pos (apply 'chess-incr-index target dir))
 649                  (chess-pos-piece-p position pos piece))
 650             (chess--add-candidate pos))))
 651
 652      (t (chess-error 'piece-unrecognized)))
 653
 654     ;; prune from the discovered candidates list any moves which would
 655     ;; leave the king in check; castling through check has already
 656     ;; been eliminated.
 657     (if (and candidates (char-valid-p piece))
 658         (setq candidates
 659               (chess-pos-legal-moves position color target candidates)))
 660
 661     ;; return the final list of candidate moves
 662     candidates))
 663
 664 (defun chess-pos-legal-moves (position color target candidates)
 665   "Test if TARGET can legally be reached by any of CANDIDATES.
 666 Return the list of candidates that can reach it.
 667
 668 CANDIDATES is a list of position indices which indicate the piece to
 669 be moved, and TARGET is the index of the location to be moved to.
 670
 671 Note: All of the pieces specified by CANDIDATES must be of the same
 672 type.  Also, it is the callers responsibility to ensure that the piece
 673 can legally reach the square in question.  This function merely
 674 assures that the resulting position is valid."
 675   (assert position)
 676   (assert (memq color '(nil t)))
 677   (assert (and (>= target 0) (< target 64)))
 678   (assert (listp candidates))
 679   (assert (> (length candidates) 0))
 680   (let ((cand candidates)
 681         (piece (chess-pos-piece position (car candidates)))
 682         other-piece last-cand king-pos)
 683     (while cand
 684       ;; determine the resulting position
 685       (setq other-piece (chess-pos-piece position (car cand)))
 686       (when (if color
 687                 (> other-piece ?a)
 688               (< other-piece ?A))
 689         (chess-pos-set-piece position (car cand) ? )
 690         (setq other-piece (chess-pos-piece position target))
 691         (chess-pos-set-piece position target piece)
 692         ;; find the king (only once if the king isn't moving)
 693         (if (or (null king-pos)
 694                 (memq piece '(?K ?k)))
 695             (setq king-pos (chess-pos-king-index position color)))
 696         ;; can anybody from the opposite side reach him?  if so, drop
 697         ;; the candidate
 698         (if (catch 'in-check
 699               (chess-search-position position king-pos (not color) t))
 700             (if last-cand
 701                 (setcdr last-cand (cdr cand))
 702               (setq candidates (cdr candidates)))
 703           (setq last-cand cand))
 704         ;; return the position to its original state
 705         (chess-pos-set-piece position target other-piece)
 706         (chess-pos-set-piece position (car cand) piece))
 707       ;; try the next candidate
 708       (setq cand (cdr cand)))
 709     candidates))
 710
 711 (provide 'chess-pos)
 712
 713 ;;; chess-pos.el ends here