added support for pawn promotion and en-passant captures

2 files changed, 100 insertions, 42 deletions

diff --git a/chess-ply.el b/chess-ply.el
index 643c60c..01208ea 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -66,6 +66,12 @@
   (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 (position &rest changes)
   "Create a ply from the given POSITION by applying the suppiled CHANGES.
 This function will guarantee the resulting ply is legal, and will also
@@ -98,37 +104,54 @@ maneuver."
 			       (list (chess-rf-to-index (if color 7 0) 0)
 				     (chess-rf-to-index (if color 7 0) 3)))))))
 
-	;; is the opponent's king in check/mate or stalemate now, as a
-	;; result of the changes?  NOTE: engines, whom we should
-	;; trust, may already have determine if check/checkmate
-	;; applies.
-	(unless (or (memq :check changes)
-		    (memq :checkmate changes))
-	  (let* ((next-pos (chess-ply-next-pos ply))
-		 (color (chess-pos-side-to-move next-pos))
-		 (can-move (catch 'can-move
-			     (dotimes (rank 8)
-			       (dotimes (file 8)
-				 (let* ((to (chess-rf-to-index rank file))
-					(piece (chess-pos-piece next-pos to)))
-				   (when (or (eq piece ? )
-					     (if color
-						 (> piece ?a)
-					       (< piece ?a)))
-				     (if (chess-search-position next-pos
-								to color)
-					 (throw 'can-move t)))))))))
-	    (if (chess-search-position next-pos
-				       (car (chess-pos-search
-					     next-pos (if color ?K ?k)))
-				       (not color))
-		;; yes, well is in he in checkmate?
-		(if can-move
-		    (nconc changes (list :check))
-		  (nconc changes (list :checkmate)))
-	      ;; no, but is he in stalemate?
-	      (unless can-move
-		(nconc changes (list :stalemate))))))
+	(let* ((next-pos (chess-ply-next-pos ply))
+	       (color (chess-pos-side-to-move next-pos)))
+	  ;; is the opponent's king in check/mate or stalemate now, as
+	  ;; a result of the changes?  NOTE: engines, whom we should
+	  ;; trust, may already have determine if check/checkmate
+	  ;; applies.
+	  (unless (or (memq :check changes)
+		      (memq :checkmate changes))
+	    (let ((can-move (catch 'can-move
+			      (dotimes (rank 8)
+				(dotimes (file 8)
+				  (let* ((to (chess-rf-to-index rank file))
+					 (piece (chess-pos-piece next-pos to)))
+				    (when (or (eq piece ? )
+					      (if color
+						  (> piece ?a)
+						(< piece ?a)))
+				      (if (chess-search-position next-pos
+								 to color)
+					  (throw 'can-move t)))))))))
+	      (if (chess-search-position next-pos
+					 (car (chess-pos-search
+					       next-pos (if color ?K ?k)))
+					 (not color))
+		  ;; yes, well is in he in checkmate?
+		  (if can-move
+		      (nconc changes (list :check))
+		    (nconc changes (list :checkmate)))
+		;; no, but is he in stalemate?
+		(unless can-move
+		  (nconc changes (list :stalemate))))))
+
+	  ;; 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
+	  (unless (memq :promote changes)
+	    (if (and (= ?p (downcase (chess-pos-piece next-pos
+						      (cadr 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))))))
 
 	;; return the annotated ply
 	ply))))
diff --git a/chess-pos.el b/chess-pos.el
index c558531..46f61f2 100644
--- a/chess-pos.el
+++ b/chess-pos.el
@@ -232,21 +232,56 @@ color will do."
 This function does not check any rules, it only makes sure you are not
 trying to move a blank square."
   (while changes
-    (unless (symbolp (car changes))
+    (if (symbolp (car changes))
+	(setq changes nil)
       (let* ((from (car changes))
 	     (to (cadr changes))
 	     (piece (chess-pos-piece position from)))
 	(if (= piece ? )
 	    (error "Attempted piece move from blank square %s" from))
 	(chess-pos-set-piece position from ? )
-	(chess-pos-set-piece position to piece)))
-    (setq changes (cddr changes)))
-  ;; once a piece is moved, en passant is no longer available
-  (chess-pos-set-en-passant position nil)
-  ;; toggle the side whose move it is
-  (chess-pos-set-side-to-move position
-			      (not (chess-pos-side-to-move position)))
-  position)
+	(chess-pos-set-piece position to piece))
+      (setq changes (cddr changes))))
+  (let ((color (chess-pos-side-to-move position)))
+
+    ;; once a piece is moved, en passant is no longer available
+    (chess-pos-set-en-passant position nil)
+
+    ;; if a king or rook moves, no more castling; also, if a pawn
+    ;; jumps ahead two, mark it en-passantable
+    (let ((piece (downcase (car changes))))
+      (cond
+       ((and (= piece ?k)
+	     (equal (car changes)
+		    (chess-rf-to-index (if color 7 0) 4)))
+	(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))
+
+       ((and (= piece ?p)
+	     (> (abs (- (chess-index-rank (cadr changes))
+			(chess-index-rank (car changes)))) 1))
+	(chess-pos-set-en-passant position (cadr changes)))))
+
+    ;; toggle the side whose move it is
+    (chess-pos-set-side-to-move position (not color))
+
+    ;; promote the piece if we were meant to
+    (let ((new-piece (cadr (assq :promote changes))))
+      (if new-piece
+	  (chess-pos-set-piece position (cadr changes) new-piece)))
+
+    ;; return the final position
+    position))
 
 (defun chess-search-position (position target piece)
   "Look on POSITION from TARGET for a PIECE that can move there.
@@ -286,8 +321,8 @@ indices which indicate where a piece may have moved from."
 		(and (= (chess-index-rank target) (if color 2 5))
 		     (setq pos (chess-add-index target bias 0))
 		     (chess-pos-piece-p position pos (if color ?p ?P))
-		     (and (chess-pos-en-passant position)
-			  (= (chess-pos-en-passant position) target))
+		     ;; 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)))