added support for highlighting legal plies

7 files changed, 160 insertions, 122 deletions

diff --git a/TODO b/TODO
index 7426f56..4299e96 100644
--- a/TODO
+++ b/TODO
@@ -29,25 +29,15 @@ laptop.
 
 - undo is not working with gnuchess
 
-
 - test making an en passant capture
 
-
 - the game should go inactive once I lose by stalemate/checkmate
 
 - detect draw/resign/abort/retract, etc., from ICS and common engines
 
-
-- in chess-ply-create signal an error on invalid plies describing why
-
-- for network transports, if an illegal move is encountered, report
-  this with "illegal move: REASON"
-
-
 - incorporate the .wav files from xchat's sounds that chess-sound
   currently doesn't have
 
-
 - devise a better scheme for printing messages (use a catalog?) and
   for when engines need to ask questions
 
diff --git a/chess-display.el b/chess-display.el
index 5fd3fc4..7cd5bd3 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -25,6 +25,11 @@
   :type 'boolean
   :group 'chess-ics1)
 
+(defcustom chess-display-highlight-legal nil
+  "If non-nil, highlight legal target squares when a piece is selected."
+  :type 'boolean
+  :group 'chess-ics1)
+
 ;;; Code:
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -138,8 +143,10 @@ makes moves, or any other changes to the underlying game."
 
 (defun chess-display-set-ply (display ply)
   (chess-with-current-buffer display
-    ;; jww (2002-04-13): NYI
-    ))
+    (setq chess-game-index 1)
+    (chess-game-set-plies chess-display-game
+			  (list ply (chess-ply-create
+				     (chess-ply-next-pos ply))))))
 
 (defun chess-display-ply (display)
   (chess-with-current-buffer display
@@ -152,8 +159,8 @@ the user able to scroll back and forth through the moves in the
 variation.  Any moves made on the board will extend/change the
 variation that was passed in."
   (chess-with-current-buffer display
-    ;; jww (2002-04-13): NYI
-    ))
+    (setq chess-game-index (or index (chess-var-index variation)))
+    (chess-game-set-plies chess-display-game variation)))
 
 (defun chess-display-variation (display)
   (chess-with-current-buffer display
@@ -250,8 +257,15 @@ that is supported by most displays, and is the default mode."
       (dolist (arg args)
 	(if (or (symbolp arg) (stringp arg))
 	    (setq mode arg)
-	  (funcall chess-display-event-handler
-		   'highlight arg mode))))))
+	  (funcall chess-display-event-handler 'highlight arg mode))))))
+
+(defun chess-display-highlight-legal (display pos)
+  "Highlight all legal move targets from POS."
+  (chess-with-current-buffer display
+    (dolist (ply (chess-legal-plies (chess-display-position nil)
+				    :index pos))
+      (chess-display-highlight nil "pale green"
+			       (chess-ply-target ply)))))
 
 (defun chess-display-popup (display)
   "Popup the given DISPLAY, so that it's visible to the user."
@@ -392,11 +406,9 @@ See `chess-display-type' for the different kinds of displays."
       (define-key map [(button2)] 'chess-display-mouse-select-piece))
      (t
       (define-key map [down-mouse-1] 'chess-display-mouse-select-piece)
-      (define-key map [mouse-1] 'chess-display-mouse-select-piece)
       (define-key map [drag-mouse-1] 'chess-display-mouse-select-piece)
 
       (define-key map [down-mouse-2] 'chess-display-mouse-select-piece)
-      (define-key map [mouse-2] 'chess-display-mouse-select-piece)
       (define-key map [drag-mouse-2] 'chess-display-mouse-select-piece)))
 
     (define-key map [menu-bar files] 'undefined)
@@ -945,6 +957,10 @@ Clicking once on a piece selects it; then click on the target location."
 					       'my-color)
 			      (chess-pos-side-to-move position))))
 		(error "It is not your turn to move"))
+	       ((and (= chess-display-index
+			(chess-game-index chess-display-game))
+		     (chess-game-over-p chess-display-game))
+		(error "This game is over"))
 	       ((eq piece ? )
 		(error "You cannot select an empty square"))
 	       ((if (chess-pos-side-to-move position)
@@ -952,7 +968,9 @@ Clicking once on a piece selects it; then click on the target location."
 		  (< piece ?a))
 		(error "You cannot move your opponent's pieces")))
 	      (setq chess-display-last-selected (list (point) coord))
-	      (chess-display-highlight nil coord 'selected)))
+	      (chess-display-highlight nil coord)
+	      (if chess-display-highlight-legal
+		  (chess-display-highlight-legal nil coord))))
 	(error
 	 (setq chess-display-last-selected nil)
 	 (chess-display-update nil)
diff --git a/chess-engine.el b/chess-engine.el
index a207c34..f05ff56 100644
--- a/chess-engine.el
+++ b/chess-engine.el
@@ -57,8 +57,7 @@
 
 (defsubst chess-engine-convert-algebraic (move &optional trust-check)
   (or (chess-algebraic-to-ply (chess-engine-position nil) move trust-check)
-      (ignore
-       (message "Received invalid move string: %s" move))))
+      (chess-engine-command nil 'illegal)))
 
 (defsubst chess-engine-convert-fen (fen)
   (or (chess-fen-to-pos fen)
@@ -234,7 +233,10 @@
 
       (setq chess-engine-pending-offer nil
 	    chess-engine-pending-arg nil)
-      t))))
+      t))
+
+   ((eq event 'illegal)
+    (message "Your opponent states your last command was illegal"))))
 
 (defun chess-engine-create (game module &optional response-handler
 				 &rest handler-ctor-args)
diff --git a/chess-game.el b/chess-game.el
index cae650f..3214eb2 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -207,8 +207,7 @@ progress (nil), if it is drawn, resigned, mate, etc."
 	(position (chess-ply-pos ply)))
     (if (chess-ply-final-p current-ply)
 	(error "Cannot add moves to a completed game"))
-    (unless (equal position (chess-ply-pos current-ply))
-      (error "Positions do not match"))
+    (assert (equal position (chess-ply-pos current-ply)))
     (chess-ply-set-changes current-ply changes)
     (chess-game-add-ply game (chess-ply-create
 			      (chess-ply-next-pos current-ply)))
diff --git a/chess-images.el b/chess-images.el
index 5ab618d..ff90c49 100644
--- a/chess-images.el
+++ b/chess-images.el
@@ -260,9 +260,15 @@ Common modes are:
 		(point)))
 	 (highlight (copy-alist (get-text-property pos 'display))))
     (setcar (last highlight)
-	    (list (cons "light_square" chess-images-highlight-color)
-		  (cons "dark_square" chess-images-highlight-color)
-		  (cons "background" chess-images-highlight-color)))
+	    (list (cons "light_square" (if (eq mode :selected)
+					   chess-images-highlight-color
+					 mode))
+		  (cons "dark_square" (if (eq mode :selected)
+					  chess-images-highlight-color
+					mode))
+		  (cons "background" (if (eq mode :selected)
+					 chess-images-highlight-color
+				       mode))))
     (put-text-property pos (1+ pos) 'display highlight)))
 
 (defun chess-images-alter-size (test)
diff --git a/chess-network.el b/chess-network.el
index c5e92c9..b4456d8 100644
--- a/chess-network.el
+++ b/chess-network.el
@@ -142,6 +142,9 @@
    ((eq event 'retract)
     (chess-engine-send nil "retract\n"))
 
+   ((eq event 'illegal)
+    (chess-engine-send nil "illegal\n"))
+
    ((eq event 'move)
     (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
     (if (chess-game-over-p chess-engine-game)
diff --git a/chess-ply.el b/chess-ply.el
index 96934e7..7e44a04 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -232,110 +232,130 @@ maneuver."
 						    rank-adj file-adj)))
 	plies))
 
-(defun chess-legal-plies (position piece &optional file)
+(defun chess-legal-plies (position &rest keywords)
   "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))
+KEYWORDS allowed are:
+
+  :color <t or nil>
+  :piece <piece character>
+  :file <number 0 to 7> [can only be used if :piece is present]
+  :index <coordinate index>
+
+These will constrain the plies generated to those matching the above
+criteria."
+  (if (null keywords)
       (let ((plies (list t)))
-	(dolist (p '(?P ?R ?N ?B ?K ?Q))
-	  (nconc plies (chess-legal-plies position
-					  (if piece p (downcase p)))))
+	(dolist (p '(?P ?R ?N ?B ?K ?Q ?p ?r ?n ?b ?k ?q))
+	  (nconc plies (chess-legal-plies position 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
+    (if (memq :color keywords)
+	(let ((plies (list t))
+	      (color (cadr (memq :color keywords))))
+	  (dolist (p '(?P ?R ?N ?B ?K ?Q))
+	    (nconc plies (chess-legal-plies position
+					    (if color p (downcase p)))))
+	  (cdr plies))
+      (let* ((piece (cadr (memq :piece keywords)))
+	     (color (if piece (< piece ?a)
+		      (chess-pos-side-to-move position)))
+	     (test-piece (if piece (upcase piece)
+			   (chess-pos-piece position
+					    (cadr (memq :index keywords)))))
+	     pos plies file)
+	;; since we're looking for moves of a particular piece, do a
+	;; more focused search
+	(dolist (candidate
+		 (cond
+		  ((setq pos (cadr (memq :index keywords)))
+		   (list pos))
+		  ((setq file (cadr (memq :file keywords)))
 		   (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)
+		     candidates))
+		  (t
+		   (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)))))
-	    ;; 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)))
+			   (1 -1)  (1 0)  (1 1)))
+	      (setq pos (apply 'chess-incr-index candidate dir))
+	      (if (and pos
+		       (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)