;;; Code:
(require 'chess-message)
-(require 'chess-fen)
-(eval-when-compile
- (require 'cl-lib)
- (cl-proclaim '(optimize (speed 3) (safety 2))))
+(require 'cl-lib)
+
+;; Elides cl-check-type and cl-assert
+(eval-when-compile (cl-proclaim '(optimize (speed 3) (safety 2))))
(defgroup chess-pos nil
"Routines for manipulating chess positions."
nil]
"Starting position of a regular chess game.")
+(defsubst chess-pos-p (position)
+ "Return non-nil if POSITION is a chess position object."
+ (and (vectorp position) (= (length position) 75)))
+
(chess-message-catalog 'english
'((chess-nag-1 . "good move [traditional \"!\"]")
(chess-nag-2 . "poor move [traditional \"?\"]")
(defsubst chess-pos-piece (position index)
"Return the piece on POSITION at INDEX."
- (cl-assert (vectorp position))
- (cl-assert (and (>= index 0) (< index 64)))
+ (cl-check-type position chess-pos)
+ (cl-check-type index (integer 0 63))
(aref position index))
(defsubst chess-pos-piece-p (position index piece-or-color)
"Return non-nil if at POSITION/INDEX there is the given PIECE-OR-COLOR.
If PIECE-OR-COLOR is t for white or nil for black, any piece of that
color will do."
- (cl-assert (vectorp position))
- (cl-assert (and (>= index 0) (< index 64)))
- (cl-assert (memq piece-or-color
- '(t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+ (cl-check-type position chess-pos)
+ (cl-check-type index (integer 0 63))
+ (cl-check-type piece-or-color (member t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p))
(let ((p (chess-pos-piece position index)))
(cond
((= p ? ) (eq p piece-or-color))
(cl-check-type file (integer 0 7))
(+ (* 8 rank) file))
-(defsubst chess-coord-to-index (coord)
- "Convert a COORD string into an index value."
- (cl-assert (stringp coord))
- (cl-assert (= (length coord) 2))
- (+ (* 8 (- 7 (- (aref coord 1) ?1)))
- (- (aref coord 0) ?a)))
-
-(defsubst chess-index-to-coord (index)
- "Convert the chess position INDEX into a coord string."
- (cl-assert (and (>= index 0) (< index 64)))
- (concat (char-to-string (+ (mod index 8) ?a))
- (char-to-string (+ (- 7 (/ index 8)) ?1))))
-
(defsubst chess-index-rank (index)
"Return the rank component of the given INDEX."
- (cl-assert (and (>= index 0) (< index 64)))
+ (cl-check-type index (integer 0 63))
(/ index 8))
(defsubst chess-index-file (index)
"Return the file component of the given INDEX."
- (cl-assert (and (>= index 0) (< index 64)))
+ (cl-check-type index (integer 0 63))
(mod index 8))
+(defsubst chess-coord-to-index (coord)
+ "Convert a COORD string (such as \"e4\" into an index value."
+ (cl-check-type coord string)
+ (cl-assert (= (length coord) 2))
+ (chess-rf-to-index (- 7 (- (aref coord 1) ?1)) (- (aref coord 0) ?a)))
+
+(defsubst chess-index-to-coord (index)
+ "Convert the chess position INDEX into a coord string."
+ (cl-check-type index (integer 0 63))
+ (string (+ (chess-index-file index) ?a) (+ (- 7 (chess-index-rank index)) ?1)))
+
(defsubst chess-incr-index (index rank-move file-move)
"Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE."
- (cl-assert (and (>= index 0) (< index 64)))
- (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
- (cl-assert (and (>= file-move -7) (<= file-move 7)))
+ (cl-check-type index (integer 0 63))
+ (cl-check-type rank-move (integer -7 7))
+ (cl-check-type file-move (integer -7 7))
(let ((newrank (+ (chess-index-rank index) rank-move))
(newfile (+ (chess-index-file index) file-move)))
(if (and (>= newrank 0) (< newrank 8)
"Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE.
This differs from `chess-incr-index' by performing no safety checks,
in order to execute faster."
- (cl-assert (and (>= index 0) (< index 64)))
- (cl-assert (and (>= rank-move -7) (<= rank-move 7)))
- (cl-assert (and (>= file-move -7) (<= file-move 7)))
+ (cl-check-type index (integer 0 63))
+ (cl-check-type rank-move (integer -7 7))
+ (cl-check-type file-move (integer -7 7))
(chess-rf-to-index (+ (chess-index-rank index) rank-move)
(+ (chess-index-file index) file-move)))
chess-rook-directions)
"The directions a queen is allowed to move to.")
-(defvaralias 'chess-king-directions 'chess-queen-directions
+(defconst chess-king-directions chess-queen-directions
"The directions a king is allowed to move to.")
(defconst chess-sliding-white-piece-directions
"Look on POSITION anywhere for PIECE-OR-COLOR, returning all coordinates.
If PIECE-OR-COLOR is t for white or nil for black, any piece of that
color will do. See also `chess-pos-search*'."
- (cl-assert (vectorp position))
- (cl-assert (memq piece-or-color
- '(t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+ (cl-check-type position chess-pos)
+ (cl-check-type piece-or-color (member t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p))
(let (found)
(dotimes (i 64)
(if (chess-pos-piece-p position i piece-or-color)
"Look on POSITION for any of PIECES.
The result is an alist where each element looks like (PIECE . INDICES).
Pieces which did not appear in POSITION will be present in the resulting
-alist, but the `cdr' of their enties will be nil."
+alist, but the `cdr' of their entries will be nil."
(cl-assert (not (null pieces)))
(cl-assert (cl-reduce (lambda (ok piece)
(when ok
(defsubst chess-pos-set-king-index (position color index)
"Set the known index of the king on POSITION for COLOR, to INDEX.
-It is never necessary to call this function."
- (cl-assert (vectorp position))
- (cl-assert (memq color '(nil t)))
- (cl-assert (and (>= index 0) (< index 64)))
+It is never necessary to call this function manually."
+ (cl-check-type position chess-pos)
+ (cl-check-type color (member nil t))
+ (cl-check-type index (integer 0 63))
(aset position (if color 72 73) index))
(defsubst chess-pos-king-index (position color)
"Return the index on POSITION of the king.
If COLOR is non-nil, return the position of the white king, otherwise
return the position of the black king."
- (cl-assert (vectorp position))
- (cl-assert (memq color '(nil t)))
+ (cl-check-type position chess-pos)
+ (cl-check-type color (member nil t))
(or (aref position (if color 72 73))
(chess-pos-set-king-index position color
(chess-pos-search position (if color ?K ?k)))))
(defsubst chess-pos-set-piece (position index piece)
"Set the piece on POSITION at INDEX to PIECE.
PIECE must be one of K Q N B R or P. Use lowercase to set black
-pieces."
- (cl-assert (vectorp position))
- (cl-assert (and (>= index 0) (< index 64)))
- (cl-assert (memq piece '(? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+pieces. A space `? ' clears the square."
+ (cl-check-type position chess-pos)
+ (cl-check-type index (integer 0 63))
+ (cl-check-type piece (member ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p))
(aset position index piece)
- (if (= piece ?K)
- (chess-pos-set-king-index position t index)
- (if (= piece ?k)
- (chess-pos-set-king-index position nil index))))
+ (when (memq piece '(?K ?k))
+ (chess-pos-set-king-index position (< piece ?a) index)))
(defun chess-pos-can-castle (position side)
"Return whether the king on POSITION can castle on SIDE.
SIDE must be either ?K for the kingside, or ?Q for the queenside (use
lowercase to query if black can castle)."
- (cl-assert (vectorp position))
- (cl-assert (memq side '(?K ?Q ?k ?q)))
- (let* ((index (+ 65 (if (< side ?a)
- (if (= side ?K) 0 1)
- (if (= side ?k) 2 3))))
+ (cl-check-type position chess-pos)
+ (cl-check-type side (member ?K ?Q ?k ?q))
+ (let* ((index (+ 65 (pcase side (?K 0) (?Q 1) (?k 2) (?q 3))))
(value (aref position index)))
(if (or (eq value nil) (integerp value))
value
- (when (chess-pos-king-index position (< side ?a))
- (let* ((color (< side ?a))
- (long (= ?Q (upcase side)))
- (file (if long 0 7))
- (king-file (chess-index-file
- (chess-pos-king-index position color)))
- 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)))))
- (aset position index rook))))))
+ (let* ((color (< side ?a))
+ (king-index (chess-pos-king-index position color)))
+ (when king-index
+ (let* ((long (= ?Q (upcase side)))
+ (file (if long 0 7))
+ (king-file (chess-index-file king-index))
+ 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)))))
+ (aset position index rook)))))))
(defsubst chess-pos-set-can-castle (position side value)
"Set whether the king can castle on the given POSITION on SIDE.
manually. Note that all newly created positions have full castling
priveleges set, unless the position is created blank, in which case
castling priveleges are unset. See `chess-pos-copy'."
- (cl-assert (vectorp position))
- (cl-assert (memq side '(?K ?Q ?k ?q)))
- (cl-assert (memq value '(nil t)))
+ (cl-check-type position chess-pos)
+ (cl-check-type side (member ?K ?Q ?k ?q))
+ (cl-check-type value (member nil t))
(aset position (+ 65 (if (< side ?a)
(if (= side ?K) 0 1)
(if (= side ?k) 2 3))) value))
(defsubst chess-pos-en-passant (position)
"Return the index of any pawn on POSITION that can be captured en passant.
Returns nil if en passant is unavailable."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(aref position 64))
(defsubst chess-pos-set-en-passant (position index)
"Set the INDEX of any pawn on POSITION that can be captured en passant."
- (cl-assert (vectorp position))
- (cl-assert (or (eq index nil)
- (and (>= index 0) (< index 64))))
+ (cl-check-type position chess-pos)
+ (cl-check-type index (or null (integer 0 63)))
(aset position 64 index))
+(gv-define-simple-setter chess-pos-en-passant chess-pos-set-en-passant)
+
(defsubst chess-pos-status (position)
"Return whether the side to move in the POSITION is in a special state.
-nil is returned if not, otherwise one of the symbols: `check',
-`checkmate', `stalemate'."
- (cl-assert (vectorp position))
+nil is returned if not, otherwise one of the keywords: `:check',
+`:checkmate', `:stalemate'."
+ (cl-check-type position chess-pos)
(aref position 69))
(defsubst chess-pos-set-status (position value)
"Set whether the side to move in POSITION is in a special state.
VALUE should either be nil, to indicate that the POSITION is normal,
-or one of the symbols: `check', `checkmate', `stalemate'."
- (cl-assert (vectorp position))
- (cl-assert (or (eq value nil) (symbolp value)))
+or one of the keywords: `:check', `:checkmate' or `:stalemate'."
+ (cl-check-type position chess-pos)
+ (cl-check-type value (or null keyword))
(aset position 69 value))
+(gv-define-simple-setter chess-pos-status chess-pos-set-status)
+
(defsubst chess-pos-side-to-move (position)
"Return the color whose move it is in POSITION."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(aref position 70))
(defsubst chess-pos-set-side-to-move (position color)
"Set the COLOR whose move it is in POSITION."
- (cl-assert (vectorp position))
- (cl-assert (memq color '(nil t)))
+ (cl-check-type position chess-pos)
+ (cl-check-type color (member nil t))
(aset position 70 color))
+(gv-define-simple-setter chess-pos-side-to-move chess-pos-set-side-to-move)
+
(defsubst chess-pos-annotations (position)
"Return the list of annotations for this POSITION."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(aref position 71))
(defsubst chess-pos-set-annotations (position annotations)
"Set the list of ANNOTATIONS for this POSITION."
- (cl-assert (vectorp position))
- (cl-assert (listp annotations))
+ (cl-check-type position chess-pos)
+ (cl-check-type annotations list)
(aset position 71 annotations))
+(gv-define-simple-setter chess-pos-annotations chess-pos-set-annotations)
+
(defun chess-pos-add-annotation (position annotation)
"Add an ANNOTATION for this POSITION."
- (cl-assert (vectorp position))
- (cl-assert (or (stringp annotation) (listp annotation)))
+ (cl-check-type position chess-pos)
+ (cl-check-type annotation (or string list))
(let ((ann (chess-pos-annotations position)))
(if ann
(nconc ann (list annotation))
(defsubst chess-pos-epd (position opcode)
"Return the value of the given EPD OPCODE, or nil if not set."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(cl-assert opcode)
(cdr (assq opcode (chess-pos-annotations position))))
(defun chess-pos-set-epd (position opcode &optional value)
"Set the given EPD OPCODE to VALUE, or t if VALUE is not specified."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(cl-assert opcode)
(let ((entry (assq opcode (chess-pos-annotations position))))
(if entry
(defun chess-pos-del-epd (position opcode)
"Delete the given EPD OPCODE."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(cl-assert opcode)
(chess-pos-set-annotations
position (assq-delete-all opcode (chess-pos-annotations position))))
-(defun chess-pos-preceding-ply (position)
+(defsubst chess-pos-preceding-ply (position)
"Return the ply that preceds POSITION."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(aref position 74))
(defun chess-pos-set-preceding-ply (position ply)
"Set the preceding PLY for POSITION."
- (cl-assert (vectorp position))
+ (cl-check-type position chess-pos)
(cl-assert (listp ply))
(aset position 74 ply))
+(gv-define-simple-setter chess-pos-preceding-ply chess-pos-set-preceding-ply)
+
(defsubst chess-pos-copy (position)
"Copy the given chess POSITION.
If there are annotations or EPD opcodes set, these lists are copied as
well, so that the two positions do not share the same lists."
- (cl-assert (vectorp position))
- (let ((copy (vconcat position)) i)
- (setq i (chess-pos-annotations position))
- (if i (chess-pos-set-annotations copy (copy-alist i)))
+ (cl-check-type position chess-pos)
+ (let ((copy (vconcat position)))
+ (chess-pos-set-annotations copy (copy-alist (chess-pos-annotations position)))
copy))
(defsubst chess-pos-create (&optional blank)
[nil nil nil nil nil nil t nil nil nil nil])
(chess-pos-copy chess-starting-position)))
-(defsubst chess-pos-to-string (position &optional full)
- "Convert the given POSITION into a string.
-The returned string can be converted back to a position using
-`chess-pos-from-string'."
- (cl-assert (vectorp position))
- (chess-pos-to-fen position full))
-
-(defsubst chess-pos-from-string (string)
- "Convert the given STRING to a chess position.
-This string should have been created by `chess-pos-to-string'."
- (cl-assert (stringp string))
- (chess-fen-to-pos string))
-
(defconst chess-pos-piece-values
'((?p . 1)
(?n . 3)
A Pawn whose advance to the eighth rank is not blocked by an
opposing Pawn in the same file and who does not have to pass one
on an adjoining file is called a passed Pawn."
- (let ((seventh (if color 1 6)) (bias (if color -1 1)) (pawn (if color ?p ?P))
+ (let ((seventh (if color 1 6)) (pawn (if color ?p ?P))
pawns)
(dolist (index (or pawn-indices
(chess-pos-search position (if color ?P ?p))) pawns)
"Move a piece on the POSITION directly, using the indices in CHANGES.
This function does not check any rules, it only makes sure you are not
trying to move a blank square."
- (cl-assert (vectorp position))
- (cl-assert (listp changes))
- (cl-assert (> (length changes) 0))
-
+ (cl-check-type position chess-pos)
+ (cl-check-type changes (and list (not null)))
(let* ((color (chess-pos-side-to-move position))
(can-castle-kingside (chess-pos-can-castle position (if color ?K ?k)))
(can-castle-queenside (chess-pos-can-castle position (if color ?Q ?q))))
(downcase new-piece)))))
;; did we leave the position in check, mate or stalemate?
- (cond
- ((memq :check changes)
- (chess-pos-set-status position :check))
- ((memq :checkmate changes)
- (chess-pos-set-status position :checkmate))
- ((memq :stalemate changes)
- (chess-pos-set-status position :stalemate))
- (t (chess-pos-set-status position nil)))
-
- ;; return the final position
+ (chess-pos-set-status position
+ (car-safe (or (memq :check changes)
+ (memq :checkmate changes)
+ (memq :stalemate changes))))
+
position))
(chess-message-catalog 'english
'((piece-unrecognized . "Unrecognized piece identifier")))
-(eval-when-compile
- (defvar candidates)
- (defvar check-only))
-
-(defsubst chess--add-candidate (candidate)
- (if check-only
- (throw 'in-check t)
- (push candidate candidates)))
+(defmacro chess--add-candidate (candidate)
+ `(if check-only
+ (throw 'in-check t)
+ (push ,candidate candidates)))
(defconst chess-white-can-slide-to
(let ((squares (make-vector 64 nil)))
do (setq first nil)))
when ray collect ray)))
squares))
+
(defconst chess-black-can-slide-to
(let ((squares (make-vector 64 nil)))
(dotimes (index 64)
when ray collect ray)))
squares))
+(declare-function chess-ply-castling-changes "chess-ply"
+ (position &optional long king-index))
+
(defun chess-search-position (position target piece &optional
check-only no-castling)
"Look on POSITION from TARGET for a PIECE that can move there.
piece))
(test-piece (and (characterp piece)
(upcase piece)))
- p pos candidates)
+ pos candidates)
(cond
;; if the piece is `t', it means to find the candidates resulting
;; from any piece movement. This is useful for testing whether a
;; test for knights and pawns
(dolist (p (if piece '(?P ?N) '(?p ?n)))
- (mapc 'chess--add-candidate
- (chess-search-position position target p check-only no-castling)))
+ (dolist (cand (chess-search-position position target p check-only no-castling))
+ (chess--add-candidate cand)))
;; test whether the rook or king can move to the target by castling
(unless no-castling