diff options
Diffstat (limited to 'chess-pos.el')
| -rw-r--r-- | chess-pos.el | 70 |
1 files changed, 36 insertions, 34 deletions
diff --git a/chess-pos.el b/chess-pos.el index 7249399..6c89e15 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -160,7 +160,7 @@ Also, EPD evaluation numbers/strings can be set here." (defun chess-pos-copy (position) "Create a new chess position, set at the starting position. If BLANK is non-nil, all of the squares will be empty. -The current side-to-move is always white." +The current side-to-move always starts as white." (let ((copy (make-vector 72 nil)) elem) (dotimes (i 71) (setq elem (aref position i)) @@ -197,17 +197,15 @@ The current side-to-move is always white." (defsubst chess-index-rank (index) (/ index 8)) (defsubst chess-index-file (index) (mod index 8)) -(defun chess-add-index (index rank-move file-move) +(defsubst chess-incr-index (index rank-move file-move) "Create a new INDEX from an old one, by adding rank-move and file-move." - (let* ((rank (chess-index-rank index)) - (file (chess-index-file index)) - (newrank (+ rank rank-move)) - (newfile (+ file file-move))) + (let ((newrank (+ (chess-index-rank index) rank-move)) + (newfile (+ (chess-index-file index) file-move))) (if (and (>= newrank 0) (< newrank 8) (>= newfile 0) (< newfile 8)) (chess-rf-to-index newrank newfile)))) -(defun chess-pos-piece-p (position index piece-or-color) +(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." @@ -218,7 +216,7 @@ color will do." ((eq piece-or-color nil) (> p ?a)) (t (= p piece-or-color))))) -(defun chess-pos-search (position piece-or-color) +(defsubst chess-pos-search (position piece-or-color) "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." @@ -270,7 +268,7 @@ trying to move a blank square." (chess-pos-set-piece position to piece)) (setq ch (cddr ch))))) - ;; now fix up the position + ;; now fix up the resulting position (let ((color (chess-pos-side-to-move position))) ;; once a piece is moved, en passant is no longer available @@ -285,15 +283,14 @@ trying to move a blank square." (chess-pos-set-can-castle position (if color ?K ?k) nil) (chess-pos-set-can-castle position (if color ?Q ?q) nil)) - ((and (= piece ?r) - (equal (car changes) - (chess-rf-to-index (if color 7 0) 0))) - (chess-pos-set-can-castle position (if color ?Q ?q) nil)) - - ((and (= piece ?r) - (equal (car changes) - (chess-rf-to-index (if color 7 0) 7))) - (chess-pos-set-can-castle position (if color ?K ?k) nil)) + ((= piece ?r) + (let ((king (car (chess-pos-search position (if color ?K ?k))))) + (if (and (chess-pos-can-castle position (if color ?K ?k)) + (< (chess-index-file (car changes)) king)) + (chess-pos-set-can-castle position (if color ?K ?k) nil) + (if (and (chess-pos-can-castle position (if color ?Q ?q)) + (> (chess-index-file (car changes)) king)) + (chess-pos-set-can-castle position (if color ?Q ?q) nil))))) ((and (= piece ?p) (> (abs (- (chess-index-rank (cadr changes)) @@ -339,6 +336,8 @@ indices which indicate where a piece may have moved from." (< piece ?a) piece)) (bias (if color -1 1)) + (test-piece (and (char-valid-p piece) + (upcase piece))) p pos candidates) (cond ;; if the piece is `t', it means to find the candidates resulting @@ -354,56 +353,58 @@ indices which indicate where a piece may have moved from." ;; pawn movement, which is diagonal 1 when taking, but forward ;; 1 or 2 when moving (the most complex piece, actually) - ((= (upcase piece) ?P) + ((= test-piece ?P) (let ((p (chess-pos-piece position target))) (if (if (= p ? ) ;; check for en passant (and (= (chess-index-rank target) (if color 2 5)) - (setq pos (chess-add-index target bias 0)) + (setq pos (chess-incr-index target bias 0)) (chess-pos-piece-p position pos (if color ?p ?P)) ;; make this fail if no en-passant is possible (= (or (chess-pos-en-passant position) 100) target) (setq candidates (list pos))) (if color (> p ?a) (< p ?a))) (let ((cands (list t))) - (setq pos (chess-add-index target (- bias) -1)) + (setq pos (chess-incr-index target (- bias) -1)) (if (and pos (chess-pos-piece-p position pos piece)) (nconc cands (list pos))) - (setq pos (chess-add-index target (- bias) 1)) + (setq pos (chess-incr-index target (- bias) 1)) (if (and pos (chess-pos-piece-p position pos piece)) (nconc cands (list pos))) (if candidates (nconc candidates (cdr cands)) (setq candidates (cdr cands)))) - (if (setq pos (chess-add-index target (- bias) 0)) + (if (setq pos (chess-incr-index target (- bias) 0)) (if (chess-pos-piece-p position pos piece) (setq candidates (list pos)) (when (and (chess-pos-piece-p position pos ? ) (= (if color 4 3) (chess-index-rank target))) - (setq pos (chess-add-index pos (- bias) 0)) + (setq pos (chess-incr-index pos (- bias) 0)) (if (and pos (chess-pos-piece-p position pos piece)) (setq candidates (list pos))))))))) ;; the rook, bishop and queen are the easiest; just look along ;; rank and file and/or diagonal for the nearest pieces! - ((memq (upcase piece) '(?R ?B ?Q)) + ((memq test-piece '(?R ?B ?Q)) (setq candidates (list t)) (dolist (dir (cond - ((= (upcase piece) ?R) + ((= test-piece ?R) '( (-1 0) (0 -1) (0 1) (1 0))) - ((= (upcase piece) ?B) + ((= test-piece ?B) '((-1 -1) (-1 1) (1 -1) (1 1))) - ((= (upcase piece) ?Q) + ((= 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-add-index target dir)) + (setq pos (apply 'chess-incr-index target 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 piece) (progn @@ -411,20 +412,21 @@ indices which indicate where a piece may have moved from." (setq pos nil)) (if (not (chess-pos-piece-p position pos ? )) (setq pos nil) - (setq pos (apply 'chess-add-index pos dir)))))) + (setq pos (apply 'chess-incr-index pos dir)))))) (setq candidates (cdr candidates))) ;; the king is a trivial case of the queen, except when castling - ((= (upcase piece) ?K) + ((= test-piece ?K) (let ((dirs '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))) (while dirs ;; up the current file - (setq pos (apply 'chess-add-index target (car dirs))) + (setq pos (apply 'chess-incr-index target (car dirs))) (if (and pos (chess-pos-piece-p position pos piece)) (setq candidates (list pos) dirs nil) (setq dirs (cdr dirs))))) + (let ((rank (if color 7 0))) ;; if we can still castle, then the king and rook are in their ;; squares; also, make sure that the user is not attempting to @@ -452,14 +454,14 @@ indices which indicate where a piece may have moved from." ;; the knight is a zesty little piece; there may be more than ;; one, but at only one possible square in each direction - ((= (upcase piece) ?N) + ((= test-piece ?N) (setq candidates (list t)) (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-add-index target dir)) + (if (and (setq pos (apply 'chess-incr-index target dir)) (chess-pos-piece-p position pos piece)) (nconc candidates (list pos)))) (setq candidates (cdr candidates))) |