diff options
| -rw-r--r-- | TODO | 9 | ||||
| -rw-r--r-- | chess-algebraic.el | 43 | ||||
| -rw-r--r-- | chess-announce.el | 2 | ||||
| -rw-r--r-- | chess-display.el | 21 | ||||
| -rw-r--r-- | chess-engine.el | 8 | ||||
| -rw-r--r-- | chess-game.el | 11 | ||||
| -rw-r--r-- | chess-ics.el | 126 | ||||
| -rw-r--r-- | chess-network.el | 4 | ||||
| -rw-r--r-- | chess-sound.el | 2 |
9 files changed, 112 insertions, 114 deletions
@@ -10,13 +10,14 @@ ---------------------------------------------------------------------- -- Detect draw/resign/abort/retract, etc., from ICS and common engines - -- Make use of the my-color and active data in chess-game.el to ensure - that I only do what I should be doing +- detect draw/resign/abort/retract, etc., from ICS and common engines - Why doesn't S-b produce [B] in the keyboard shortcutting? +- chess-sound announcements are broken + +- the game should go inactive once I lose by stalemate/checkmate + ---------------------------------------------------------------------- - Read-only mode needs to be a bit more vigorous. There's nothing diff --git a/chess-algebraic.el b/chess-algebraic.el index ed6f020..a1bc1e6 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -82,25 +82,28 @@ This regexp handles both long and short form.") ;; we must use our knowledge of how pieces can ;; move, to determine which piece is meant by the ;; piece indicator - (when (setq candidates - (chess-search-position position target - (if color piece - (downcase piece)))) - (if (= (length candidates) 1) - (list (car candidates) target) - (if (null source) - (error "Clarify piece to move by rank or file") - (while candidates - (if (if (>= source ?a) - (eq (chess-index-file (car candidates)) - (- source ?a)) - (eq (chess-index-rank (car candidates)) - (- 7 (- source ?1)))) - (setq which (car candidates) candidates nil) - (setq candidates (cdr candidates)))) - (if (null which) - (error "Could not determine which piece to use") - (list which target))))))))) + (if (setq candidates + (chess-search-position position target + (if color piece + (downcase piece)))) + (if (= (length candidates) 1) + (list (car candidates) target) + (if (null source) + (error "Clarify piece to move by rank or file") + (while candidates + (if (if (>= source ?a) + (eq (chess-index-file (car candidates)) + (- source ?a)) + (eq (chess-index-rank (car candidates)) + (- 7 (- source ?1)))) + (setq which (car candidates) + candidates nil) + (setq candidates (cdr candidates)))) + (if (null which) + (error "Could not determine which piece to use") + (list which target)))) + (error "There are no candidate moves for '%s'" + move)))))) (if promotion (nconc changes (list :promote (aref promotion 0)))))) @@ -155,7 +158,7 @@ If LONG is non-nil, render the move into long notation." (if (/= ? (chess-pos-piece pos to)) "x" (if long "-")) (chess-index-to-coord to) - (let ((promote (chess-ply-has-keyword ply :promote))) + (let ((promote (memq :promote (chess-ply-changes ply)))) (if promote (concat "=" (char-to-string (upcase (cadr promote)))))) diff --git a/chess-announce.el b/chess-announce.el index 95cf40c..2da0486 100644 --- a/chess-announce.el +++ b/chess-announce.el @@ -43,7 +43,7 @@ See `chess-display-type' for the different kinds of displays." ((eq event 'shutdown) (funcall (nth 2 chess-announce-functions))) - ((memq event '(move game-over)) + ((eq event 'move) (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) (pos (chess-ply-pos ply))) (unless (eq (chess-game-data game 'my-color) diff --git a/chess-display.el b/chess-display.el index 464c9df..3fe2023 100644 --- a/chess-display.el +++ b/chess-display.el @@ -359,7 +359,7 @@ that is supported by most displays, and is the default mode." :group 'chess-display) (defcustom chess-display-momentous-events - '(orient setup-game pass move game-over resign) + '(orient update setup-game pass move resign) "Events that will refresh, and cause 'main' displays to popup. These are displays for which `chess-display-set-main' has been called." @@ -384,12 +384,11 @@ See `chess-display-type' for the different kinds of displays." ((eq event 'orient) ;; Set the display's perspective to whichever color I'm - ;; playing; also set the index just to be sure - (chess-display-set-index* nil (chess-game-index game)) + ;; playing (chess-display-set-perspective* nil (chess-game-data game 'my-color)))) - (if (memq event '(orient setup-game move game-over resign)) + (if (memq event '(orient update setup-game move resign)) (chess-display-set-index* nil (chess-game-index game))) (let ((momentous (memq event chess-display-momentous-events))) @@ -527,14 +526,10 @@ The key bindings available in this mode are: " " (let ((final (chess-ply-final-p ply))) (cond - ((eq final :checkmate) - "CHECKMATE") - ((eq final :resign) - "RESIGNED") - ((eq final :stalemate) - "STALEMATE") - ((eq final :draw) - "DRAWN") + ((eq final :checkmate) "CHECKMATE") + ((eq final :resign) "RESIGNED") + ((eq final :stalemate) "STALEMATE") + ((eq final :draw) "DRAWN") (t (if color "White" "Black")))) (if index @@ -980,7 +975,7 @@ Clicking once on a piece selects it; then click on the target location." (let ((last-sel chess-display-last-selected)) ;; if they select the same square again, just deselect it (if (= (point) (car last-sel)) - (throw 'invalid t) + (error "") (let ((s-piece (chess-pos-piece position (cadr last-sel))) (t-piece (chess-pos-piece position coord)) ply) (if (and (/= t-piece ? ) diff --git a/chess-engine.el b/chess-engine.el index afa80d8..86916a1 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -420,10 +420,10 @@ function in all cases; this is merely a bandwidth-saver." (defun chess-engine-event-handler (game engine event &rest args) "Handle any commands being sent to this instance of this module." (unless chess-engine-handling-event - (if (buffer-live-p engine) - (with-current-buffer engine - (assert (eq game (chess-engine-game nil))) - (apply chess-engine-event-handler event args))) + (chess-with-current-buffer engine + (assert (eq game (chess-engine-game nil))) + (apply chess-engine-event-handler event args)) + (cond ((eq event 'shutdown) (chess-engine-destroy engine)) diff --git a/chess-game.el b/chess-game.el index f81f888..138fc36 100644 --- a/chess-game.el +++ b/chess-game.el @@ -128,7 +128,7 @@ matches." (defsubst chess-game-set-plies (game plies) "Return the tags alist associated with GAME." (setcdr (nthcdr 2 game) (list plies)) - (chess-game-run-hooks game 'setup-game)) + (chess-game-run-hooks game 'setup-game game)) (defsubst chess-game-set-start-position (game position) "Return the tags alist associated with GAME." @@ -160,15 +160,14 @@ matches." (let ((plies (chess-game-plies game))) (if plies (nconc plies (list ply)) - (chess-game-set-plies game (list ply))))) + (let ((chess-game-inhibit-events t)) + (chess-game-set-plies game (list ply)))))) (defun chess-game-undo (game count) "Undo the last COUNT plies of GAME." (if (> count (chess-game-index game)) (error "Cannot undo further") - (chess-game-set-plies game (nbutlast (chess-game-plies game) count)) - ;;(chess-game-run-hooks game 'undo count) - )) + (chess-game-set-plies game (nbutlast (chess-game-plies game) count)))) (defsubst chess-game-over-p (game) @@ -223,7 +222,7 @@ progress (nil), if it is drawn, resigned, mate, etc." (chess-game-set-tag game "Result" (if color "0-1" "1-0")) (if (chess-ply-has-keyword ply :resign) (chess-game-run-hooks game 'resign color) - (chess-game-run-hooks game 'game-over)))) + (chess-game-run-hooks game 'move current-ply)))) (t (chess-game-run-hooks game 'move current-ply))))) diff --git a/chess-ics.el b/chess-ics.el index 6b93559..908d42a 100644 --- a/chess-ics.el +++ b/chess-ics.el @@ -11,6 +11,21 @@ "Engine for interacting with Internet Chess Servers." :group 'chess-engine) +(defcustom chess-ics-server "freechess.org" + "The default ICS server to connect to." + :type 'string + :group 'chess-ics) + +(defcustom chess-ics-port 5000 + "The port to use when connecting to `chess-ics-server'." + :type 'integer + :group 'chess-ics) + +(defcustom chess-ics-handle "jwiegley" + "The default handle used when logging into `chess-ics-server'." + :type 'string + :group 'chess-ics) + (defvar chess-ics-ensure-ics12 nil) (make-variable-buffer-local 'chess-ics-ensure-ics12) @@ -29,7 +44,7 @@ who is black." (position (chess-pos-create t)) white black ply) - (assert (= (length parts) 31)) + (assert (= (length parts) 32)) ;; first, handle the layout of the position (dotimes (i 8) @@ -90,15 +105,14 @@ who is black." (setq parts (cdr parts)) ;; move in elaborated notation - (setq ply (if (string= (car parts) "none") - (chess-ply-create position) - (chess-algebraic-to-ply position (substring (car parts) 2)))) (setq parts (cdr parts)) ;; time elapsed (setq parts (cdr parts)) ;; move in algebraic notation + (setq move (unless (string= (car parts) "none") + (car parts))) (setq parts (cdr parts)) ;; unknown @@ -106,25 +120,39 @@ who is black." (setq parts (cdr parts)) (setq parts (cdr parts)) - (list ply white black))) + (list position move white black))) (defun chess-ics-handle-move () - (let ((begin (match-beginning 1)) + (let ((chess-engine-handling-event t) + (begin (match-beginning 1)) (end (match-end 1)) - (info (chess-ics12-parse (match-string 2))) + (info (chess-ics12-parse (match-string 3))) (game (chess-engine-game nil))) (assert game) - (if (> (chess-game-index game) 0) - (if (eq (chess-pos-side-to-move (chess-ply-pos (car info))) - (chess-pos-side-to-move (chess-engine-position nil))) - (chess-engine-do-move (car info))) - (chess-engine-set-start-position nil (chess-ply-pos (car info)) - (string= (cadr info) ics-handle))) - (delete-region begin end) + (unwind-protect + (if (and (chess-game-data game 'active) + (> (chess-game-index game) 0)) + (if (and (cadr info) + (eq (chess-pos-side-to-move (car info)) + (chess-game-data game 'my-color))) + (let ((last-ply (last (chess-game-plies game)))) + (setcar last-ply + (chess-algebraic-to-ply (chess-ply-pos (car last-ply)) + (cadr info) t)) + (chess-game-add-ply game (chess-ply-create (car info))) + (chess-game-run-hooks game 'update))) + (let ((chess-game-inhibit-events t) plies) + (chess-game-set-data game 'my-color (string= (nth 2 info) + chess-ics-handle)) + (chess-game-set-data game 'active t) + (chess-game-set-start-position game (car info))) + (chess-game-run-hooks game 'orient)) + (delete-region begin end)) t)) (defvar chess-ics-regexp-alist - (list (cons "\\(<12> \\(.+\\)\\)" 'chess-ics-handle-move) + (list (cons "\\(\\(\n*fics%\n*\\)?<12> \\(.+\\)\\)\n" + 'chess-ics-handle-move) (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+" (function (lambda () @@ -134,50 +162,20 @@ who is black." (defun chess-ics-handler (event &rest args) (cond ((eq event 'initialize) - (let* ((old-buffer (current-buffer)) - (address-or-alias (read-from-minibuffer - "ICS Server address or alias: ")) - (server-info-list (cdr (assoc address-or-alias - ics-servers-alist))) - (ics-address (or (car (cdr server-info-list)) - address-or-alias)) - (ics-connect-method (or (car (nthcdr 3 server-info-list)) - ics-default-connect-method)) - (server-name (or (car server-info-list) - address-or-alias)) - (ics-port (or (car (nthcdr 2 server-info-list)) - (read-from-minibuffer "ICS port: " - ics-default-port))) - (handle (read-from-minibuffer "ICS Handle: " - ics-default-handle)) - (proc (concat server-name ":" handle)) - (buffer (concat "*" proc "*"))) - - (setq ics-handle handle) - - (if (comint-check-proc buffer) - (set-buffer buffer) - (run-hooks 'ics-pre-connect-hook) - (set-buffer (make-comint proc (cons ics-address ics-port))) - (run-hooks 'ics-post-connect-hook) - (ics-mode)) - - (set (make-variable-buffer-local 'ics-last-command-time) - (ics-current-time)) - (set (make-variable-buffer-local 'ics-idle-p) nil) - (set (make-variable-buffer-local 'ics-interface-variable-set) nil) - (set (make-variable-buffer-local 'ics-wakeup-last-alarm-time) - (ics-current-time)) - (set (make-variable-buffer-local 'ics-last-highlight-end) nil) - (set (make-variable-buffer-local 'ics-last-add-buttons-end) nil) + (kill-buffer (current-buffer)) + (message "Connecting to Internet Chess Server '%s'..." chess-ics-server) - (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) - (set (make-local-variable 'comint-preoutput-filter-functions) - '(chess-ics-strip-cr)) + (let ((buf (make-comint "chess-ics" + (cons chess-ics-server chess-ics-port)))) + (message "Connecting to Internet Chess Server '%s'...done" + chess-ics-server) - (display-buffer buffer) - (kill-buffer old-buffer) + (display-buffer buf) + (set-buffer buf) + (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) + (set (make-local-variable 'comint-preoutput-filter-functions) + '(chess-ics-strip)) nil)) ((eq event 'match) @@ -187,12 +185,12 @@ who is black." ((eq event 'move) (unless chess-ics-ensure-ics12 - (comint-send-string (get-buffer-process (current-buffer)) - "set style 12\n") + (chess-engine-send nil "set style 12\n") (setq chess-ics-ensure-ics12 t)) (chess-network-handler 'move (car args))) ((eq event 'send) + (message "sending string: %s" (car args)) (comint-send-string (get-buffer-process (current-buffer)) (car args))) @@ -204,12 +202,12 @@ who is black." (if chess-engine-last-pos (goto-char chess-engine-last-pos) (goto-char (point-min))) - (beginning-of-line) - (while (not (eobp)) + (while (and (not (eobp)) + (/= (line-end-position) (point-max))) (let ((triggers chess-ics-regexp-alist)) (while triggers - ;; this could be accelerated by joining together the - ;; regexps + ;; this could be accelerated by joining + ;; together the regexps (if (and (looking-at (concat "[^\n\r]*" (caar triggers))) (funcall (cdar triggers))) (setq triggers nil) @@ -217,8 +215,8 @@ who is black." (forward-line)) (setq chess-engine-last-pos (point)))) -(defun chess-ics-strip-cr (string) - (while (string-match "\r" string) +(defun chess-ics-strip (string) + (while (string-match "[\r\a]" string) (setq string (replace-match "" t t string))) string) diff --git a/chess-network.el b/chess-network.el index 237ba43..dee0647 100644 --- a/chess-network.el +++ b/chess-network.el @@ -111,7 +111,9 @@ (chess-engine-send nil (format "chess match %s\n" chess-full-name))) ((eq event 'resign) - (chess-engine-send nil "resign\n")) + (chess-engine-send nil "resign\n") + (and (chess-engine-game nil) + (chess-game-set-data (chess-engine-game nil) 'active nil))) ((eq event 'draw) (if chess-engine-pending-offer diff --git a/chess-sound.el b/chess-sound.el index 1854679..666be6c 100644 --- a/chess-sound.el +++ b/chess-sound.el @@ -67,7 +67,7 @@ "This display module presents a standard chessboard. See `chess-display-type' for the different kinds of displays." (cond - ((memq event '(move game-over)) + ((eq event 'move) (let* ((ply (chess-game-ply game (1- (chess-game-index game)))) (pos (chess-ply-pos ply))) (if (eq (chess-game-data game 'my-color) |