-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Routines for manipulating chess plies
-;;
-;; $Revision$
+;;; chess-ply.el --- Routines for manipulating chess plies
+
+;; Copyright (C) 2002, 2004, 2008, 2014 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@gnu.org>
+;; Maintainer: Mario Lang <mlang@delysid.org>
+;; Keywords: games
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;; Code:
+(eval-when-compile (require 'cl-lib))
+
(require 'chess-pos)
(defgroup chess-ply nil
"Routines for manipulating chess plies."
:group 'chess)
+(defsubst chess-ply-p (ply)
+ (and (consp ply) (chess-pos-p (car ply))))
+
(defsubst chess-ply-pos (ply)
+ "Returns the base position associated with PLY."
+ (cl-check-type ply chess-ply)
(car ply))
(defsubst chess-ply-set-pos (ply position)
+ "Set the base position of PLY."
+ (cl-check-type ply chess-ply)
+ (cl-check-type position chess-pos)
(setcar ply position))
+(gv-define-simple-setter chess-ply-pos chess-ply-set-pos)
+
(defsubst chess-ply-changes (ply)
+ (cl-check-type ply chess-ply)
(cdr ply))
(defsubst chess-ply-set-changes (ply changes)
+ (cl-check-type ply chess-ply)
+ (cl-check-type changes list)
(setcdr ply changes))
+(gv-define-simple-setter chess-ply-changes chess-ply-set-changes)
+
(defun chess-ply-any-keyword (ply &rest keywords)
+ "Return non-nil if PLY contains at least one of KEYWORDS."
+ (declare (side-effect-free t))
+ (cl-check-type ply chess-ply)
(catch 'found
(dolist (keyword keywords)
(if (memq keyword (chess-ply-changes ply))
(throw 'found keyword)))))
(defun chess-ply-keyword (ply keyword)
+ "Determine if PLY has KEYWORD.
+If KEYWORD can be found in the changes of PLY, the value
+directly following it is returned (as if it was part of a property list).
+If KEYWORD is the last element of the changes of ply, `t' is returned."
+ (declare (side-effect-free t))
+ (cl-check-type ply chess-ply)
+ (cl-check-type keyword symbol)
(let ((item (memq keyword (chess-ply-changes ply))))
+ (and item (if (cdr item) (cadr item) t))))
+
+(defun chess-ply-set-keyword (ply keyword &optional value)
+ (cl-check-type ply chess-ply)
+ (cl-check-type keyword symbol)
+ (let* ((changes (chess-ply-changes ply))
+ (item (memq keyword changes)))
(if item
- (if (memq keyword '(:which :promote))
- (cdr item)
- t))))
+ (when value
+ (setcar (cdr item) value))
+ (nconc changes (if value
+ (list keyword value)
+ (list keyword))))
+ value))
+
+(gv-define-simple-setter chess-ply-keyword chess-ply-set-keyword)
(defsubst chess-ply-source (ply)
+ "Returns the source square index value of PLY."
+ (cl-check-type ply chess-ply)
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(car changes))))
(defsubst chess-ply-target (ply)
+ "Returns the target square index value of PLY."
+ (cl-check-type ply chess-ply)
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(cadr changes))))
(defsubst chess-ply-next-pos (ply)
- (apply 'chess-pos-move (chess-pos-copy (chess-ply-pos ply))
- (chess-ply-changes ply)))
-
-(defconst chess-piece-name-table
- '(("queen" . ?q)
- ("rook" . ?r)
- ("knight" . ?n)
- ("bishop" . ?b)))
-
-(defun chess-ply-create-castle (position &optional long)
+ "Return the position that results from executing PLY."
+ (cl-check-type ply chess-ply)
+ (or (chess-ply-keyword ply :next-pos)
+ (let ((position (apply 'chess-pos-move
+ (chess-pos-copy (chess-ply-pos ply))
+ (chess-ply-changes ply))))
+ (chess-pos-set-preceding-ply position ply)
+ (chess-ply-set-keyword ply :next-pos position))))
+
+(defun chess-ply-castling-changes (position &optional long king-index)
"Create castling changes; this function supports Fischer Random castling."
+ (cl-check-type position chess-pos)
(let* ((color (chess-pos-side-to-move position))
- (king (car (chess-pos-search position (if color ?K ?k))))
- (king-target (chess-rf-to-index (if color 7 0)
- (if long 2 6)))
- (king-file (chess-index-file king))
- (file (if long 0 7))
- rook)
- (while (funcall (if long '< '>) file king-file)
- (let ((index (chess-rf-to-index (if color 7 0) file)))
- (if (chess-pos-piece-p position index (if color ?R ?r))
- (setq rook index file king-file)
- (setq file (funcall (if long '1+ '1-) file)))))
- (if (and rook (chess-search-position position king-target
- (if color ?K ?k)))
- (list king king-target rook
- (chess-rf-to-index (if color 7 0) (if long 3 5))
- (if long :long-castle :castle)))))
-
-(defun chess-ply-create (position &rest changes)
- "Create a ply from the given POSITION by applying the suppiled CHANGES.
+ (king (or king-index (chess-pos-king-index position color)))
+ (rook (chess-pos-can-castle position (if color
+ (if long ?Q ?K)
+ (if long ?q ?k))))
+ (direction (if long chess-direction-west chess-direction-east)) pos)
+ (when rook
+ (setq pos (chess-next-index king direction))
+ (while (and pos (/= pos rook)
+ (chess-pos-piece-p position pos ? )
+ (or (and long (< (chess-index-file pos) 2))
+ (chess-pos-legal-candidates
+ position color pos (list king))))
+ (setq pos (chess-next-index pos direction)))
+ (when (equal pos rook)
+ (list king (if color (if long #o72 #o76) (if long #o02 #o06))
+ rook (if color (if long #o73 #o75) (if long #o03 #o05))
+ (if long :long-castle :castle))))))
+
+(chess-message-catalog 'english
+ '((ambiguous-promotion . "Promotion without :promote keyword")))
+
+(defvar chess-ply-checking-mate nil)
+
+(defsubst chess-ply-create* (position)
+ (cl-check-type position chess-pos)
+ (list position))
+
+(defun chess-ply-create (position &optional valid-p &rest changes)
+ "Create a ply from the given POSITION by applying the supplied CHANGES.
This function will guarantee the resulting ply is legal, and will also
annotate the ply with :check or other modifiers as necessary. It will
also extend castling, and will prompt for a promotion piece.
Note: Do not pass in the rook move if CHANGES represents a castling
maneuver."
- (let* ((valid-p (memq :valid changes))
- (ply (cons (chess-pos-copy position)
- (delq :valid changes)))
+ (cl-check-type position chess-pos)
+ (let* ((ply (cons position changes))
(color (chess-pos-side-to-move position))
piece)
(if (or (null changes) (symbolp (car changes)))
;; validate that `changes' can be legally applied to the given
;; position
(when (or valid-p
- (member (car changes)
- (chess-search-position position (cadr changes)
- (chess-pos-piece position
- (car changes)))))
- (setq piece (chess-pos-piece position (car changes)))
-
- ;; is this a castling maneuver?
- (if (and (= piece (if color ?K ?k))
- (not (or (memq :castle changes)
- (memq :long-castle changes))))
- (let* ((target (cadr changes))
- (file (chess-index-file target))
- (long (= 2 file))
- new-changes)
- (if (and (or (and (= file 6)
- (chess-pos-can-castle position
- (if color ?K ?k)))
- (and long
- (chess-pos-can-castle position
- (if color ?Q ?q))))
- (setq new-changes
- (chess-ply-create-castle position long)))
- (setcdr ply new-changes))))
-
- (when (= piece (if color ?P ?p))
- ;; is this a pawn move to the ultimate rank? if so, and we
- ;; haven't already been told, ask for the piece to promote
- ;; it to
- (if (and (not (memq :promote changes))
- (= (if color 0 7) (chess-index-rank (cadr changes))))
- (let ((new-piece (completing-read
- "Promote pawn to queen/rook/knight/bishop? "
- chess-piece-name-table nil t "queen")))
- (setq new-piece
- (cdr (assoc new-piece chess-piece-name-table)))
- (if color
- (setq new-piece (upcase new-piece)))
- (nconc changes (list :promote new-piece))))
-
- ;; is this an en-passant capture?
- (if (= (or (chess-pos-en-passant position) 100)
- (or (chess-incr-index (cadr changes) (if color 1 -1) 0) 200))
- (nconc changes (list :en-passant))))
-
- (unless (or (memq :check changes)
- (memq :checkmate changes)
- (memq :stalemate changes))
- (let* ((next-pos (chess-ply-next-pos ply))
- (next-color (not color)))
- ;; is the opponent's king in check/mate or stalemate now, as
- ;; a result of the changes?
- (let ((can-move
- (catch 'can-move
- ;; find out if any of `color's pieces can move. We
- ;; start the search on the home row for that color,
- ;; as it's likier to find a legal move faster.
- (let ((rank (if next-color 7 0))
- (file 0))
- (while (funcall (if next-color '>= '<) rank
- (if next-color 0 8))
- (while (< file 8)
- (let* ((to (chess-rf-to-index rank file))
- (piece (chess-pos-piece next-pos to)))
- (when (or (eq piece ? )
- (if next-color
- (> piece ?a)
- (< piece ?a)))
- (if (chess-search-position next-pos to next-color)
- (throw 'can-move t))))
- (setq file (1+ file)))
- (setq file 0 rank (funcall (if next-color '1- '1+)
- rank)))))))
-
- ;; see if anyone from the other side is attacking the king
- ;; in the new position
- (if (chess-search-position next-pos
- (car (chess-pos-search
- next-pos (if next-color ?K ?k)))
- (not next-color))
- (nconc changes (list (if can-move :check :checkmate)))
- ;; no, but is he in stalemate?
- (unless can-move
- (nconc changes (list :stalemate)))))))
-
+ (chess-legal-plies position :any :index (car changes)
+ :target (cadr changes)))
+ (unless chess-ply-checking-mate
+ (setq piece (chess-pos-piece position (car changes)))
+
+ ;; is this a castling maneuver?
+ (if (and (= piece (if color ?K ?k))
+ (not (or (memq :castle changes)
+ (memq :long-castle changes))))
+ (let* ((target (cadr changes))
+ (file (chess-index-file target))
+ (long (= 2 file))
+ new-changes)
+ (if (and (or (and (= file 6)
+ (chess-pos-can-castle position
+ (if color ?K ?k)))
+ (and long
+ (chess-pos-can-castle position
+ (if color ?Q ?q))))
+ (setq new-changes
+ (chess-ply-castling-changes position long
+ (car changes))))
+ (setcdr ply new-changes)))
+
+ (when (= piece (if color ?P ?p))
+ ;; is this a pawn move to the ultimate rank? if so, check
+ ;; that the :promote keyword is present.
+ (when (and (not (memq :promote changes))
+ (= (if color 0 7)
+ (chess-index-rank (cadr changes))))
+ (chess-error 'ambiguous-promotion))
+
+ ;; is this an en-passant capture?
+ (when (let ((ep (chess-pos-en-passant position)))
+ (when ep
+ (eq ep (funcall (if color #'+ #'-) (cadr changes) 8))))
+ (nconc changes (list :en-passant)))))
+
+ ;; we must determine whether this ply results in a check,
+ ;; checkmate or stalemate
+ (unless (or chess-pos-always-white
+ (memq :check changes)
+ (memq :checkmate changes)
+ (memq :stalemate changes))
+ (let* ((chess-ply-checking-mate t)
+ ;; jww (2002-04-17): this is a memory waste?
+ (next-pos (chess-ply-next-pos ply))
+ (next-color (not color))
+ (king (chess-pos-king-index next-pos next-color))
+ (in-check (catch 'in-check
+ (chess-search-position next-pos king color t t))))
+ ;; first, see if the moves leaves the king in check.
+ ;; This is tested by seeing if any of the opponent's
+ ;; pieces can reach the king in the position that will
+ ;; result from this ply. If the king is in check, we
+ ;; will then test for checkmate by seeing if any of his
+ ;; subjects can move or not. That test will also
+ ;; confirm stalemate for us.
+ (if (or in-check
+ (null (chess-legal-plies next-pos :any :index king)))
+ ;; is the opponent's king in check/mate or stalemate
+ ;; now, as a result of the changes?
+ (if (chess-legal-plies next-pos :any :color next-color)
+ (if in-check
+ (nconc changes (list (chess-pos-set-status
+ next-pos :check))))
+ (nconc changes (list (chess-pos-set-status
+ next-pos
+ (if in-check
+ :checkmate
+ :stalemate)))))))))
;; return the annotated ply
ply))))
(defsubst chess-ply-final-p (ply)
"Return non-nil if this is the last ply of a game/variation."
- (chess-ply-any-keyword ply :draw :perpetual :repetition :stalemate
- :resign :checkmate))
-
-(eval-when-compile
- (defvar position)
- (defvar candidate)
- (defvar color)
- (defvar plies))
-(defsubst chess-ply--add (rank-adj file-adj &optional pos)
+ (or (chess-ply-any-keyword ply :drawn :perpetual :repetition
+ :flag-fell :resign :aborted)
+ (let ((preceding-ply (chess-pos-preceding-ply (chess-ply-pos ply))))
+ (when preceding-ply
+ (chess-ply-any-keyword preceding-ply :stalemate :checkmate)))))
+
+(defvar chess-ply-throw-if-any nil)
+
+(defmacro chess-ply--add (target)
"This is totally a shortcut."
- (push (chess-ply-create position candidate
- (or pos (chess-incr-index candidate
- rank-adj file-adj)))
- plies))
+ `(let ((target ,target))
+ (if (and (or (not specific-target) (= target specific-target))
+ (chess-pos-legal-candidates position color target (list candidate)))
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (let ((promotion (and (chess-pos-piece-p position candidate
+ (if color ?P ?p))
+ (= (chess-index-rank target) (if color 0 7)))))
+ (if promotion
+ (dolist (promote '(?Q ?R ?B ?N))
+ (let ((ply (chess-ply-create position t candidate target
+ :promote promote)))
+ (when ply (push ply plies))))
+ (let ((ply (chess-ply-create position t candidate target)))
+ (when ply (push ply plies)))))))))
+
+(defconst chess-white-pieces '(?P ?N ?B ?R ?Q ?K))
+(defconst chess-black-pieces '(?p ?n ?b ?r ?q ?k))
(defun chess-legal-plies (position &rest keywords)
"Return a list of all legal plies in POSITION.
KEYWORDS allowed are:
+ :any return t if any piece can move at all
:color <t or nil>
:piece <piece character>
- :file <number 0 to 7> [can only be used if :piece is present]
+ :file <number 0 to 7> [:piece or :color must be present]
:index <coordinate index>
+ :target <specific target index>
+ :candidates <list of inddices>
These will constrain the plies generated to those matching the above
-criteria."
- (if (null keywords)
- (let ((plies (list t)))
- (dolist (p '(?P ?R ?N ?B ?K ?Q ?p ?r ?n ?b ?k ?q))
- (nconc plies (chess-legal-plies position :piece p)))
- (cdr plies))
- (if (memq :color keywords)
- (let ((plies (list t))
- (color (cadr (memq :color keywords))))
- (dolist (p '(?P ?R ?N ?B ?K ?Q))
- (nconc plies (chess-legal-plies position
- :piece (if color p
- (downcase p)))))
- (cdr plies))
- (let* ((piece (cadr (memq :piece keywords)))
- (color (if piece (< piece ?a)
- (chess-pos-side-to-move position)))
- (test-piece
- (upcase (or piece
- (chess-pos-piece position
- (cadr (memq :index keywords))))))
- pos plies file)
- ;; since we're looking for moves of a particular piece, do a
- ;; more focused search
- (dolist (candidate
- (cond
- ((setq pos (cadr (memq :index keywords)))
- (list pos))
- ((setq file (cadr (memq :file keywords)))
- (let (candidates)
- (dotimes (rank 8)
- (setq pos (chess-rf-to-index rank file))
- (if (chess-pos-piece-p position pos piece)
- (push pos candidates)))
- candidates))
- (t
- (chess-pos-search position piece))))
- (cond
- ;; pawn movement, which is diagonal 1 when taking, but forward
- ;; 1 or 2 when moving (the most complex piece, actually)
- ((= test-piece ?P)
- (let* ((bias (if color -1 1))
- (ahead (chess-incr-index candidate bias 0))
- (2ahead (chess-incr-index candidate (if color -2 2) 0)))
- (when (chess-pos-piece-p position ahead ? )
- (chess-ply--add bias 0)
- (if (and (= (if color 6 1) (chess-index-rank candidate))
- (chess-pos-piece-p position 2ahead ? ))
- (chess-ply--add (if color -2 2) 0)))
- (when (setq pos (chess-incr-index candidate bias -1))
- (if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos))
+criteria.
+
+NOTE: All of the returned plies will reference the same copy of the
+position object passed in."
+ (cl-check-type position chess-pos)
+ (cond
+ ((null keywords)
+ (let ((plies (list t)))
+ (dolist (p '(?P ?R ?N ?B ?K ?Q ?p ?r ?n ?b ?k ?q))
+ (nconc plies (chess-legal-plies position :piece p)))
+ (cdr plies)))
+ ((memq :any keywords)
+ (let ((chess-ply-throw-if-any t))
+ (catch 'any-found
+ (apply 'chess-legal-plies position (delq :any keywords)))))
+ ((memq :color keywords)
+ (let ((plies (list t)))
+ (dolist (p (apply #'chess-pos-search* position (if (cadr (memq :color keywords))
+ '(?P ?N ?B ?R ?Q ?K)
+ '(?p ?n ?b ?r ?q ?k))))
+ (when (cdr p)
+ (nconc plies (chess-legal-plies position
+ :piece (car p) :candidates (cdr p)))))
+ (cdr plies)))
+ (t
+ (let* ((piece (cadr (memq :piece keywords)))
+ (color (if piece (< piece ?a)
+ (chess-pos-side-to-move position)))
+ (specific-target (cadr (memq :target keywords)))
+ (test-piece
+ (upcase (or piece
+ (chess-pos-piece position
+ (cadr (memq :index keywords))))))
+ (ep (when (= test-piece ?P) (chess-pos-en-passant position)))
+ pos plies file)
+ ;; since we're looking for moves of a particular piece, do a
+ ;; more focused search
+ (dolist (candidate
+ (cond ((cadr (memq :candidates keywords)))
+ ((setq pos (cadr (memq :index keywords))) (list pos))
+ ((setq file (cadr (memq :file keywords)))
+ (let (candidates)
+ (dotimes (rank 8)
+ (setq pos (chess-rf-to-index rank file))
+ (if (chess-pos-piece-p position pos (or piece color))
+ (push pos candidates)))
+ candidates))
+ (t (chess-pos-search position piece))))
+ (cond
+ ;; pawn movement, which is diagonal 1 when taking, but forward
+ ;; 1 or 2 when moving (the most complex piece, actually)
+ ((= test-piece ?P)
+ (let* ((ahead (chess-next-index candidate (if color
+ chess-direction-north
+ chess-direction-south)))
+ (2ahead (when ahead (chess-next-index ahead (if color
+ chess-direction-north
+ chess-direction-south)))))
+ (when (chess-pos-piece-p position ahead ? )
+ (chess-ply--add ahead)
+ (if (and (= (if color 6 1) (chess-index-rank candidate))
+ 2ahead (chess-pos-piece-p position 2ahead ? ))
+ (chess-ply--add 2ahead)))
+ (when (setq pos (chess-next-index candidate
+ (if color
+ chess-direction-northeast
+ chess-direction-southwest)))
+ (if (chess-pos-piece-p position pos (not color))
+ (chess-ply--add pos)
+ ;; check for en passant capture toward kingside
+ (when (and ep (= ep (funcall (if color #'+ #'-) pos 8)))
+ (chess-ply--add pos))))
+ (when (setq pos (chess-next-index candidate
+ (if color
+ chess-direction-northwest
+ chess-direction-southeast)))
+ (if (chess-pos-piece-p position pos (not color))
+ (chess-ply--add pos)
;; check for en passant capture toward queenside
- (if (= (or (chess-pos-en-passant position) 100)
- (or (chess-incr-index pos (if color 1 -1) 0) 200))
- (chess-ply--add nil nil pos)))
- (when (setq pos (chess-incr-index candidate bias 1))
+ (when (and ep (eq ep (funcall (if color #'+ #'-) pos 8)))
+ (chess-ply--add pos))))))
+
+ ;; the rook, bishop and queen are the easiest; just look along
+ ;; rank and file and/or diagonal for the nearest pieces!
+ ((memq test-piece '(?R ?B ?Q))
+ (dolist (dir (cond
+ ((= test-piece ?R) chess-rook-directions)
+ ((= test-piece ?B) chess-bishop-directions)
+ ((= test-piece ?Q) chess-queen-directions)))
+ (setq pos (chess-next-index candidate dir))
+ (while pos
+ (if (chess-pos-piece-p position pos ? )
+ (progn
+ (chess-ply--add pos)
+ (setq pos (chess-next-index pos dir)))
(if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos))
- ;; check for en passant capture toward kingside
- (if (= (or (chess-pos-en-passant position) 100)
- (or (chess-incr-index pos (if color 1 -1) 0) 200))
- (chess-ply--add nil nil pos)))))
-
- ;; the rook, bishop and queen are the easiest; just look along
- ;; rank and file and/or diagonal for the nearest pieces!
- ((memq test-piece '(?R ?B ?Q))
- (dolist (dir (cond
- ((= test-piece ?R)
- '( (-1 0)
- (0 -1) (0 1)
- (1 0)))
- ((= test-piece ?B)
- '((-1 -1) (-1 1)
-
- (1 -1) (1 1)))
- ((= test-piece ?Q)
- '((-1 -1) (-1 0) (-1 1)
- (0 -1) (0 1)
- (1 -1) (1 0) (1 1)))))
- ;; up the current file
- (setq pos (apply 'chess-incr-index candidate dir))
- ;; jww (2002-04-11): In Fischer Random castling, the rook can
- ;; move in wacky ways
- (while pos
- (if (chess-pos-piece-p position pos ? )
- (progn
- (chess-ply--add nil nil pos)
- (setq pos (apply 'chess-incr-index pos dir)))
- (if (chess-pos-piece-p position pos (not color))
- (chess-ply--add nil nil pos))
- (setq pos nil)))))
-
- ;; the king is a trivial case of the queen, except when castling
- ((= test-piece ?K)
- (dolist (dir '((-1 -1) (-1 0) (-1 1)
- (0 -1) (0 1)
- (1 -1) (1 0) (1 1)))
- (setq pos (apply 'chess-incr-index candidate dir))
- (if (and pos
- (or (chess-pos-piece-p position pos ? )
- (chess-pos-piece-p position pos (not color))))
- (chess-ply--add nil nil pos)))
-
+ (chess-ply--add pos))
+ (setq pos nil)))))
+
+ ;; the king is a trivial case of the queen, except when castling
+ ((= test-piece ?K)
+ (dolist (dir chess-king-directions)
+ (setq pos (chess-next-index candidate dir))
+ (if (and pos (or (chess-pos-piece-p position pos ? )
+ (chess-pos-piece-p position pos (not color))))
+ (chess-ply--add pos)))
+
+ (unless (chess-search-position position candidate (not color) nil t)
(if (chess-pos-can-castle position (if color ?K ?k))
- (chess-ply--add 0 2))
+ (let ((changes (chess-ply-castling-changes position nil
+ candidate)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies)))))
+
(if (chess-pos-can-castle position (if color ?Q ?q))
- (chess-ply--add 0 -2)))
-
- ;; the knight is a zesty little piece; there may be more than
- ;; one, but at only one possible square in each direction
- ((= test-piece ?N)
- (dolist (dir '((-2 -1) (-2 1)
- (-1 -2) (-1 2)
- (1 -2) (1 2)
- (2 -1) (2 1)))
- ;; up the current file
- (if (and (setq pos (apply 'chess-incr-index candidate dir))
- (or (chess-pos-piece-p position pos ? )
- (chess-pos-piece-p position pos (not color))))
- (chess-ply--add nil nil pos))))
-
- (t (chess-error 'piece-unrecognized))))
-
- (delq nil plies)))))
+ (let ((changes (chess-ply-castling-changes position t
+ candidate)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies)))))))
+
+ ;; the knight is a zesty little piece; there may be more than
+ ;; one, but at only one possible square in each direction
+ ((= test-piece ?N)
+ (dolist (dir chess-knight-directions)
+ ;; up the current file
+ (if (and (setq pos (chess-next-index candidate dir))
+ (or (chess-pos-piece-p position pos ? )
+ (chess-pos-piece-p position pos (not color))))
+ (chess-ply--add pos))))
+
+ (t (chess-error 'piece-unrecognized))))
+
+ plies))))
(provide 'chess-ply)