totally rewrote chess-legal-plies to be vastly more efficient

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)