diff options
| -rw-r--r-- | TODO | 10 | ||||
| -rw-r--r-- | chess-display.el | 36 | ||||
| -rw-r--r-- | chess-engine.el | 8 | ||||
| -rw-r--r-- | chess-game.el | 3 | ||||
| -rw-r--r-- | chess-images.el | 12 | ||||
| -rw-r--r-- | chess-network.el | 3 | ||||
| -rw-r--r-- | chess-ply.el | 210 |
7 files changed, 160 insertions, 122 deletions
@@ -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) |