diff options
| -rw-r--r-- | TODO | 22 | ||||
| -rw-r--r-- | chess-crafty.el | 18 | ||||
| -rw-r--r-- | chess-display.el | 105 | ||||
| -rw-r--r-- | chess-engine.el | 33 | ||||
| -rw-r--r-- | chess-game.el | 15 |
5 files changed, 113 insertions, 80 deletions
@@ -1,28 +1,10 @@ -delYsid: I knew there had to be a way. The old keyboard shortcutting -code (which uses chess-legal-plies) was just to slow. On modern -machines you wouldn't notice it, but on my 300 MHz laptop in battery -saving mode, even with byte-compiled files, I spent 1/4 of my time -looking at the hourglass cursor. So I kept cleaning the algorithm, -dropping the number of calls to chess-search-position (the biggest and -slowest function in chess.el) from 5400 calls down to 4300 calls. But -still it was too slow. Then I thought about it long and hard, and -realized chess-legal-plies was going about its whole job backwards. I -found a way to optimize it that resulted in dropping the number of -calls to chess-search-position down to 797!! That's 5000 fewer calls. -The new code is so fast I that when it's byte-compiled, I never see an -hourglass cursor, rarely even when un-byte-compiled in my slowest -configuration! - - Feature work remaining: annotations chatting clocks - bughouse/crazyhouse analysis/highlight tools - database interaction (chess-file.el, chess-scid.el) - ----------------------------------------------------------------------- + bughouse/crazyhouse - undoing a single move (my move) and moving again, causes chess-algebraic to get a little screwed up @@ -37,8 +19,6 @@ configuration! - SPACE to pass, then try to move (against an engine) fails saying it's not our turn to move ----------------------------------------------------------------------- - - Add support for adjournments; also, implement this is such a way that an e-mail or postal game is basically a game that's adjourned after every move diff --git a/chess-crafty.el b/chess-crafty.el index 72b866e..be1e25b 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -17,6 +17,10 @@ :type 'file :group 'chess-crafty) +(defvar chess-crafty-evaluation nil) + +(make-variable-buffer-local 'chess-crafty-evaluation) + (defvar chess-crafty-regexp-alist (list (cons (concat "\\(White\\|Black\\)\\s-*([0-9]+):\\s-+\\(" @@ -25,6 +29,11 @@ (lambda () (funcall chess-engine-response-handler 'move (chess-engine-convert-algebraic (match-string 2) t))))) + (cons "total evaluation\\.+\\s-+\\([-+0-9.]+\\)" + (function + (lambda () + (setq chess-crafty-evaluation + (string-to-number (match-string 1)))))) (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)" (function (lambda () @@ -52,6 +61,15 @@ (chess-engine-send nil (format "setboard %s\n" (chess-pos-to-string (car args))))) + ((eq event 'evaluate) + (setq chess-crafty-evaluation nil) + (chess-engine-send nil "display general\nscore\ndisplay nogeneral\n") + (let ((limit 50)) + (while (and (null chess-crafty-evaluation) + (> (setq limit (1- limit)) 0)) + (sit-for 0 100 t)) + chess-crafty-evaluation)) + ((eq event 'setup-game) (let ((file (chess-with-temp-file (insert (chess-game-to-string (car args)) ?\n)))) diff --git a/chess-display.el b/chess-display.el index 838e67d..67eaa84 100644 --- a/chess-display.el +++ b/chess-display.el @@ -13,20 +13,28 @@ "Common code used by chess displays." :group 'chess) -(defcustom chess-display-separate-frame (display-multi-frame-p) - "If non-nil, chessboard display use their own frame." - :type 'boolean - :group 'chess-images) - (defcustom chess-display-popup t "If non-nil, popup displays whenever a significant event occurs." :type 'boolean - :group 'chess-ics1) + :group 'chess-display) (defcustom chess-display-highlight-legal nil "If non-nil, highlight legal target squares when a piece is selected." :type 'boolean - :group 'chess-ics1) + :group 'chess-display) + +(defcustom chess-display-mode-line-format " %C %N. %M" + "The format of a chess display's modeline. +Special characters include: + + %C The color to move, White or Black; if the game is finished, + this will instead be the completion string + %N Current game sequence + %M Current algebraic move text (prefixed by ... when White) + %E Current position evaluation, if engine supports it + (negative numbers favor black) [NOT WORKING YET]" + :type 'string + :group 'chess-display) ;;; Code: @@ -236,7 +244,6 @@ modeline." (funcall chess-display-event-handler 'draw (chess-display-position nil) (chess-display-perspective nil)) - (chess-display-set-modeline) (if (and popup (not chess-display-no-popup) (chess-display-main-p nil)) (chess-display-popup nil)))) @@ -328,6 +335,9 @@ See `chess-display-type' for the different kinds of displays." ((eq event 'destroy) (chess-display-detach-game nil)) + ((eq event 'post-move) + (chess-display-update-modeline)) + ((eq event 'pass) (let ((my-color (chess-game-data game 'my-color))) (chess-game-set-data game 'my-color (not my-color)) @@ -459,36 +469,54 @@ The key bindings available in this mode are: (mode-stalemate . "STALEMATE") (mode-drawn . "DRAWMN"))) -(defun chess-display-set-modeline () +(defun chess-display-update-modeline () "Set the modeline to reflect the current game position." - (let ((color (chess-pos-side-to-move (chess-display-position nil))) - (index chess-display-index)) - (if (= index 0) - (setq chess-display-mode-line - (format " %s %s" (if color (chess-string 'mode-white) - (chess-string 'mode-black)) - (chess-string 'mode-start))) - (let ((ply (chess-game-ply chess-display-game (1- index)))) - (setq chess-display-mode-line - (concat - " " - (let ((final (chess-ply-final-p ply))) - (cond - ((eq final :checkmate) (chess-string 'mode-checkmate)) - ((eq final :resign) (chess-string 'mode-resigned)) - ((eq final :stalemate) (chess-string 'mode-stalemate)) - ((eq final :draw) (chess-string 'mode-drawn)) - (t - (if color (chess-string 'mode-white) - (chess-string 'mode-black))))) - (if index - (concat " " (int-to-string - (if (> index 1) - (/ index 2) (1+ (/ index 2)))))) - (if ply - (concat ". " (if color "... ") - (or (chess-ply-to-algebraic ply) - "???"))))))))) + (let* ((mode-line (concat chess-display-mode-line-format)) + (color (chess-pos-side-to-move (chess-display-position nil))) + (index chess-display-index) + (ply (chess-game-ply chess-display-game (1- index))) + (case-fold-search nil)) + (while (string-match "%\\([A-Za-z0-9]\\|([^)]+)\\)" mode-line) + (let ((code (match-string-no-properties 1 mode-line))) + (if (= ?\( (aref code 0)) + (setq code (eval code)) + (cond + ((string= code "C") + (setq code + (let ((final (chess-ply-final-p ply))) + (cond + ((eq final :checkmate) (chess-string 'mode-checkmate)) + ((eq final :resign) (chess-string 'mode-resigned)) + ((eq final :stalemate) (chess-string 'mode-stalemate)) + ((eq final :draw) (chess-string 'mode-drawn)) + (t + (if color (chess-string 'mode-white) + (chess-string 'mode-black))))))) + + ((string= code "N") + (if (= index 0) + "START" + (setq code (int-to-string + (chess-game-seq chess-display-game))))) + + ((string= code "M") + (setq code (concat (if color "... ") + (or (chess-ply-to-algebraic ply) "???")))) + + ((string= code "E") + ;; jww (2002-04-14): This code is encountering some nasty + ;; race conditions + (let ((evaluation (save-match-data + (chess-game-run-hooks chess-display-game + 'evaluate)))) + (setq code (if evaluation + (concat "(" (number-to-string evaluation) ")") + "(thinking)")))) + + (t + (setq code "")))) + (setq mode-line (replace-match code t t mode-line)))) + (setq chess-display-mode-line mode-line))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -499,7 +527,8 @@ The key bindings available in this mode are: "Just redraw the current display." (interactive) (erase-buffer) - (chess-display-update nil)) + (chess-display-update nil) + (chess-display-update-modeline)) (defsubst chess-display-active-p () "Return non-nil if the displayed chessboard reflects an active game. diff --git a/chess-engine.el b/chess-engine.el index d0a9951..4d9613b 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -144,14 +144,14 @@ ((eq event 'setup-game) (when (car args) ;; we don't want the `setup-game' event coming back to us - (let ((chess-engine-handling-event t)) - (let ((chess-game-inhibit-events t)) - (chess-engine-set-game nil (car args)) - (chess-game-set-data chess-engine-game 'active t) - (if (string= chess-full-name - (chess-game-tag chess-engine-game "White")) - (chess-game-set-data chess-engine-game 'my-color t) - (chess-game-set-data chess-engine-game 'my-color nil)))) + (let ((chess-engine-handling-event t) + (chess-game-inhibit-events t)) + (chess-engine-set-game nil (car args)) + (chess-game-set-data chess-engine-game 'active t) + (if (string= chess-full-name + (chess-game-tag chess-engine-game "White")) + (chess-game-set-data chess-engine-game 'my-color t) + (chess-game-set-data chess-engine-game 'my-color nil))) t)) ((eq event 'quit) @@ -406,15 +406,16 @@ (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 - (chess-with-current-buffer engine - (apply chess-engine-event-handler event args)) - - (cond - ((eq event 'shutdown) - (chess-engine-destroy engine)) + (let (result) + (chess-with-current-buffer engine + (setq result (apply chess-engine-event-handler event args))) + (cond + ((eq event 'shutdown) + (chess-engine-destroy engine)) - ((eq event 'destroy) - (chess-engine-detach-game engine))))) + ((eq event 'destroy) + (chess-engine-detach-game engine))) + result))) (defun chess-engine-sentinal (proc event) (when (buffer-live-p (process-buffer proc)) diff --git a/chess-game.el b/chess-game.el index c3d281a..9832372 100644 --- a/chess-game.el +++ b/chess-game.el @@ -59,8 +59,9 @@ matches." (defsubst chess-game-run-hooks (game &rest args) "Return the tags alist associated with GAME." (unless chess-game-inhibit-events - (dolist (hook (chess-game-hooks game)) - (apply (car hook) game (cdr hook) args)))) + (let (result) + (dolist (hook (chess-game-hooks game) result) + (setq result (apply (car hook) game (cdr hook) args)))))) (defsubst chess-game-tags (game) @@ -142,9 +143,12 @@ matches." "Return the GAME's current position index." (1- (length (chess-game-plies game)))) -(defsubst chess-game-seq (game) +(defun chess-game-seq (game) "Return the current GAME sequence." - (1+ (/ (chess-game-index game) 2))) + (let ((index (chess-game-index game))) + (if (> index 1) + (/ index 2) + (1+ (/ index 2))))) (defsubst chess-game-side-to-move (game) (chess-pos-side-to-move (chess-game-pos game))) @@ -230,7 +234,8 @@ progress (nil), if it is drawn, resigned, mate, etc." (chess-game-run-hooks game 'move current-ply)))) (t - (chess-game-run-hooks game 'move current-ply))))) + (chess-game-run-hooks game 'move current-ply) + (chess-game-run-hooks game 'post-move))))) (defsubst chess-game-end (game keyword) "End the current game, by resignation, draw, etc." |