diff options
| -rw-r--r-- | PLAN | 10 | ||||
| -rw-r--r-- | chess-pos.el | 40 | ||||
| -rw-r--r-- | chess-ucb.el | 85 |
3 files changed, 76 insertions, 59 deletions
@@ -1,6 +1,15 @@ polish: chess-chat, chess-kibitz translate: chess-german +chess +- clean up this code; let people override the chess-default-* lists + +chess-pos +- in chess-pos-can-castle, the return value should be nil, or the + position of the rook to be used when castling on that side +- create chess-pos-legal-move, which returns non-nil if a specific + move can be made; this makes the castling code much easier to write + chess-ply - When creating the next position, set the annotations to point to the keywords of the ply that led to that position; in fact, just point @@ -9,6 +18,7 @@ chess-ply - Thus there will be a mirror set of chess-pos-has-keyword, etc., functions - Need to detect games drawn by three-fold repetition +- Rename chess-ply-create-castle to chess-ply-castling-changes chess-display - there is no way to call flag right now diff --git a/chess-pos.el b/chess-pos.el index d0b6dd5..46a4c1b 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -683,25 +683,27 @@ assures that the resulting position is valid." (piece (chess-pos-piece position (car candidates))) other-piece last-cand king-pos) (while cand - ;; determine the resulting position - (chess-pos-set-piece position (car cand) ? ) - (setq other-piece (chess-pos-piece position target)) - (chess-pos-set-piece position target piece) - ;; find the king (only once if the king isn't moving) - (if (or (null king-pos) - (memq piece '(?K ?k))) - (setq king-pos (chess-pos-king-index position color))) - ;; can anybody from the opposite side reach him? if so, drop - ;; the candidate - (if (catch 'in-check - (chess-search-position position king-pos (not color) t)) - (if last-cand - (setcdr last-cand (cdr cand)) - (setq candidates (cdr candidates))) - (setq last-cand cand)) - ;; return the position to its original state - (chess-pos-set-piece position target other-piece) - (chess-pos-set-piece position (car cand) piece) + (unwind-protect + (progn + ;; determine the resulting position + (chess-pos-set-piece position (car cand) ? ) + (setq other-piece (chess-pos-piece position target)) + (chess-pos-set-piece position target piece) + ;; find the king (only once if the king isn't moving) + (if (or (null king-pos) + (memq piece '(?K ?k))) + (setq king-pos (chess-pos-king-index position color))) + ;; can anybody from the opposite side reach him? if so, + ;; drop the candidate + (if (catch 'in-check + (chess-search-position position king-pos (not color) t)) + (if last-cand + (setcdr last-cand (cdr cand)) + (setq candidates (cdr candidates))) + (setq last-cand cand))) + ;; return the position to its original state + (chess-pos-set-piece position target other-piece) + (chess-pos-set-piece position (car cand) piece)) ;; try the next candidate (setq cand (cdr cand))) candidates)) diff --git a/chess-ucb.el b/chess-ucb.el index 7d35152..5819f20 100644 --- a/chess-ucb.el +++ b/chess-ucb.el @@ -18,6 +18,8 @@ :type 'file :group 'chess-ucb) +(defvar chess-ucb-handling-event nil) + (defvar chess-ucb-regexp-alist (list (cons "^M\\(..\\)\\(..\\)\\(/\\([QRNB]\\)\\)?\r\n" @@ -29,55 +31,58 @@ (promote (match-string 4))) (if promote (setq move (concat move "=" promote))) + (setq move (chess-engine-convert-algebraic move)) ;; I don't use the usual engine logic for this, since ;; technically the UCB is just an input interface, not a ;; true engine. - (chess-game-move game - (chess-engine-convert-algebraic move)))))))) + (let ((chess-ucb-handling-event t)) + (chess-game-move game move)))))))) (defun chess-ucb-handler (game event &rest args) - (cond - ((eq event 'initialize) - (when (file-exists-p chess-ucb-device) - ;; jww (2002-04-25): cat is not bidirectional, so I need - ;; something like "nc" that can talk with characters devices - ;; at 9600 8N1. - (start-process "*chess-ucb*" (current-buffer) - (executable-find "cat") chess-ucb-device) - t)) + (unless chess-ucb-handling-event + (cond + ((eq event 'initialize) + (when (file-exists-p chess-ucb-device) + ;; jww (2002-04-25): cat is not bidirectional, so I need + ;; something like "nc" that can talk with characters devices + ;; at 9600 8N1. + (start-process "*chess-ucb*" (current-buffer) + (executable-find "cat") chess-ucb-device) + t)) - ((memq event 'orient) - (chess-engine-send nil "N\r\n") - (chess-engine-set-position nil) + ((memq event 'orient) + (chess-engine-send nil "N\r\n") + (chess-engine-set-position nil) - ;; jww (2002-04-25): What happens if we're orienting to a - ;; non-standard starting position? How do we inform the UCB of - ;; the new position? If it doesn't test move legality, I suppose - ;; we could just move all the pieces around one by one... - (unless (eq chess-starting-position (chess-engine-position nil)) - nil)) + ;; jww (2002-04-25): What happens if we're orienting to a + ;; non-standard starting position? How do we inform the UCB of + ;; the new position? If it doesn't test move legality, I + ;; suppose we could just move all the pieces around one by + ;; one... + (unless (eq chess-starting-position (chess-engine-position nil)) + nil)) - ((eq event 'undo) - (dotimes (i (car args)) - (chess-engine-send nil "T\r\n")) - ;; prevent us from handling the `undo' event which this triggers - (let ((chess-engine-handling-event t)) - (chess-game-undo game (car args)))) + ((eq event 'undo) + (dotimes (i (car args)) + (chess-engine-send nil "T\r\n")) + ;; prevent us from handling the `undo' event which this triggers + (let ((chess-engine-handling-event t)) + (chess-game-undo game (car args)))) - ((eq event 'move) - (let ((move (chess-ply-to-algebraic (car args) t))) - (cond - ((chess-ply-keyword (car args) :en-passant) - (setq move (concat move "ep"))) - ((chess-ply-keyword (car args) :castle) - (if (chess-pos-side-to-move (chess-ply-pos (car args))) - (setq move "e1-g1") - (setq move "e8-g8"))) - ((chess-ply-keyword (car args) :long-castle) - (if (chess-pos-side-to-move (chess-ply-pos (car args))) - (setq move "e1-c1") - (setq move "e8-c8")))) - (chess-engine-send nil (format "M%s\r\n" move)))))) + ((eq event 'move) + (let ((move (chess-ply-to-algebraic (car args) t))) + (cond + ((chess-ply-keyword (car args) :en-passant) + (setq move (concat move "ep"))) + ((chess-ply-keyword (car args) :castle) + (if (chess-pos-side-to-move (chess-ply-pos (car args))) + (setq move "e1-g1") + (setq move "e8-g8"))) + ((chess-ply-keyword (car args) :long-castle) + (if (chess-pos-side-to-move (chess-ply-pos (car args))) + (setq move "e1-c1") + (setq move "e8-c8")))) + (chess-engine-send nil (format "M%s\r\n" move))))))) (provide 'chess-ucb) |