diff options
| -rw-r--r-- | chess-ply.el | 131 |
1 files changed, 116 insertions, 15 deletions
diff --git a/chess-ply.el b/chess-ply.el index 80894cb..96934e7 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -220,21 +220,122 @@ maneuver." (chess-ply-any-keyword ply :draw :perpetual :repetition :stalemate :resign :checkmate)) -(defun chess-legal-plies (position) - "Return a list of all legal plies in POSITION." - (let ((color (chess-pos-side-to-move position)) plies) - (dotimes (rank 8) - (dotimes (file 8) - (let* ((to (chess-rf-to-index rank file)) - (piece (chess-pos-piece position to))) - (when (or (eq piece ? ) - (if color - (> piece ?a) - (< piece ?a))) - (dolist (candidate (chess-search-position position to color)) - (push (chess-ply-create position candidate to :valid) - plies)))))) - plies)) +(eval-when-compile + (defvar position) + (defvar candidate) + (defvar color) + (defvar plies)) +(defsubst chess-ply--add (rank-adj file-adj &optional pos) + "This is totally a shortcut." + (push (chess-ply-create position candidate + (or pos (chess-incr-index candidate + rank-adj file-adj))) + plies)) + +(defun chess-legal-plies (position piece &optional file) + "Return a list of all legal plies in POSITION. +If PIECES is non-nil, it must be a list of characters representing +pieces (with ?P or ?p for pawn). In that case, the plies will only be +those which involved moving such pieces." + (if (memq piece '(nil t)) + (let ((plies (list t))) + (dolist (p '(?P ?R ?N ?B ?K ?Q)) + (nconc plies (chess-legal-plies position + (if piece p (downcase p))))) + (cdr plies)) + (let* ((color (< piece ?a)) + (test-piece (and (char-valid-p piece) + (upcase piece))) + pos plies) + ;; since we're looking for moves of a particular piece, do a + ;; more focused search + (dolist (candidate + (if file + (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) + (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))) + (if (and (setq pos (chess-incr-index candidate bias -1)) + (chess-pos-piece-p position pos (not color))) + (chess-ply--add nil nil pos)) + (if (and (setq pos (chess-incr-index candidate bias 1)) + (chess-pos-piece-p position pos (not color))) + (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 (or (chess-pos-piece-p position pos ? ) + (chess-pos-piece-p position pos (not color))) + (chess-ply--add nil nil pos))) + + (if (chess-pos-can-castle position (if color ?K ?k)) + (chess-ply--add 0 2)) + (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 (error "Unrecognized piece identifier")))) + plies))) (provide 'chess-ply) |