diff options
| -rw-r--r-- | TODO | 5 | ||||
| -rw-r--r-- | chess-clock.el | 82 | ||||
| -rw-r--r-- | chess-display.el | 116 | ||||
| -rw-r--r-- | chess-game.el | 2 | ||||
| -rw-r--r-- | chess-module.el | 2 | ||||
| -rw-r--r-- | chess-ply.el | 8 |
6 files changed, 141 insertions, 74 deletions
@@ -11,6 +11,11 @@ - the game should go inactive once I lose by stalemate/checkmate +- when a clock runs down, indicate this in the modeline, and all the + user to call-flag in order to win on time + +- parse out the time strings from ICS + - detect draw/resign/abort/retract, etc., from ICS and common engines - in chess-engine-filter and chess-ics-filter, if an error is diff --git a/chess-clock.el b/chess-clock.el new file mode 100644 index 0000000..3c8208a --- /dev/null +++ b/chess-clock.el @@ -0,0 +1,82 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Implements a chess clock +;; +;; $Revision$ + +(defvar chess-clock-last-time nil) +(defvar chess-clock-timer nil) + +(make-variable-buffer-local 'chess-clock-last-time) +(make-variable-buffer-local 'chess-clock-timer) + +(defsubst chess-clock-add-seconds (time seconds) + "To TIME, add SECONDS. Return result as a time value." + (let* ((secint (truncate seconds)) + (hi (/ secint 65536)) + (lo (% secint 65536)) + (calc (+ (cadr time) lo))) + (if (< calc 65536) + (list (+ (car time) hi) calc) + (list (+ (car time) (1+ hi)) (% calc 65536))))) + +(defsubst chess-clock-time-to-seconds (time) + "Convert TIME to a floating point number." + (+ (* (car time) 65536.0) + (cadr time) + (/ (or (car (cdr (cdr time))) 0) 1000000.0))) + +(defsubst chess-clock-time-diff (t1 t2) + "Return the difference in seconds between T1 and T2." + (- (chess-clock-time-to-seconds t1) + (chess-clock-time-to-seconds t2))) + +(defun chess-clock-handler (game event &rest args) + (cond + ((eq event 'initialize) + (unless (chess-game-data game 'white-remaining) + (chess-game-set-data game 'white-remaining (float (car args)))) + (unless (chess-game-data game 'black-remaining) + (chess-game-set-data game 'black-remaining (float (car args)))) + (setq chess-clock-timer + (run-with-timer 0 1 'chess-clock-tick-tock (current-buffer))) + t) + + ((eq event 'post-undo) + (let ((last-ply (car (last (chess-game-plies game) 2)))) + (chess-game-set-data game 'white-remaining + (chess-ply-keyword last-ply :white)) + (chess-game-set-data game 'black-remaining + (chess-ply-keyword last-ply :black)))) + + ((eq event 'move) + (when (> (chess-game-index game) 0) + (let ((last-ply (car (last (chess-game-plies game) 2)))) + (nconc last-ply + (list :white (chess-game-data game 'white-remaining) + :black (chess-game-data game 'black-remaining)))))) + + ((eq event 'destroy) + (cancel-timer chess-clock-timer)))) + +(defvar chess-clock-tick-tocking nil) + +(defun chess-clock-tick-tock (module) + (unless chess-clock-tick-tocking + (let ((chess-clock-tick-tocking t)) + (with-current-buffer module + (let ((last-time chess-clock-last-time) counter) + (setq chess-clock-last-time (current-time)) + (when (> (chess-game-index chess-module-game) 0) + (if (chess-pos-side-to-move (chess-game-pos chess-module-game)) + (setq counter 'white-remaining) + (setq counter 'black-remaining)) + (chess-game-set-data + chess-module-game counter + (- (chess-game-data chess-module-game counter) + (chess-clock-time-diff chess-clock-last-time last-time)))))) + (force-mode-line-update)))) + +(provide 'chess-clock) + +;;; chess-clock.el ends here diff --git a/chess-display.el b/chess-display.el index 96602fc..6c1e6d1 100644 --- a/chess-display.el +++ b/chess-display.el @@ -24,16 +24,50 @@ :type 'boolean :group 'chess-display) -(defcustom chess-display-mode-line-format " %C %M" +(chess-message-catalog 'english + '((mode-white . "White") + (mode-black . "Black") + (mode-start . "START") + (mode-checkmate . "CHECKMATE") + (mode-resigned . "RESIGNED") + (mode-stalemate . "STALEMATE") + (mode-drawn . "DRAWMN"))) + +(defcustom chess-display-mode-line-format + '(" " + (:eval (let ((final (chess-ply-final-p + (chess-game-ply chess-module-game + chess-display-index)))) + (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 (chess-game-side-to-move chess-module-game) + (chess-string 'mode-white) + (chess-string 'mode-black)))))) + " " + (:eval (if (= chess-display-index 0) + (chess-string 'mode-start) + (concat (int-to-string (chess-game-seq chess-module-game)) + ". " + (if (chess-game-side-to-move chess-module-game) + "... ") + (chess-ply-to-algebraic + (chess-game-ply chess-module-game + (1- chess-display-index)))))) + (:eval (let ((white (chess-game-data chess-module-game + 'white-remaining)) + (black (chess-game-data chess-module-game + 'black-remaining))) + (if (and white black) + (format " W %02d:%02d B %02d:%02d" + (/ (floor white) 60) (% (floor white) 60) + (/ (floor black) 60) (% (floor black) 60)))))) "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 - %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 +See `mode-line-format' for syntax details." + :type 'sexp :group 'chess-display) ;;; Code: @@ -48,14 +82,12 @@ Special characters include: (defvar chess-display-event-handler nil) (defvar chess-display-no-popup nil) (defvar chess-display-edit-mode nil) -(defvar chess-display-mode-line "") (make-variable-buffer-local 'chess-display-index) (make-variable-buffer-local 'chess-display-perspective) (make-variable-buffer-local 'chess-display-event-handler) (make-variable-buffer-local 'chess-display-no-popup) (make-variable-buffer-local 'chess-display-edit-mode) -(make-variable-buffer-local 'chess-display-mode-line) (defmacro chess-with-current-buffer (buffer &rest body) `(let ((buf ,buffer)) @@ -176,7 +208,7 @@ also view the same game." (funcall chess-display-event-handler 'draw (chess-display-position nil) (chess-display-perspective nil)) - (chess-display-update-modeline) + (force-mode-line-update) (if (and popup (not chess-display-no-popup) (chess-module-leader-p nil)) (chess-display-popup nil)))) @@ -239,7 +271,7 @@ that is supported by most displays, and is the default mode." :group 'chess-display) (defcustom chess-display-momentous-events - '(orient update setup-game pass move resign) + '(orient post-undo 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." @@ -377,63 +409,7 @@ The key bindings available in this mode are: (use-local-map chess-display-mode-map) (buffer-disable-undo) (setq buffer-auto-save-file-name nil - mode-line-format 'chess-display-mode-line)) - -(chess-message-catalog 'english - '((mode-white . "White") - (mode-black . "Black") - (mode-start . "START") - (mode-checkmate . "CHECKMATE") - (mode-resigned . "RESIGNED") - (mode-stalemate . "STALEMATE") - (mode-drawn . "DRAWMN"))) - -(defun chess-display-update-modeline () - "Set the modeline to reflect the current game position." - (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-module-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 "M") - (if (= index 0) - (setq code (chess-string 'mode-start)) - (setq code (concat (int-to-string - (chess-game-seq chess-module-game)) - ". "(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-module-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))) + mode-line-format 'chess-display-mode-line-format)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; diff --git a/chess-game.el b/chess-game.el index 1fcdb8b..2697aec 100644 --- a/chess-game.el +++ b/chess-game.el @@ -180,7 +180,7 @@ matches." (chess-error 'undo-limit-reached)) (let ((chess-game-inhibit-events t)) (chess-game-set-plies game (nbutlast (chess-game-plies game) count))) - (chess-game-run-hooks game 'update)) + (chess-game-run-hooks game 'post-undo count)) (defsubst chess-game-over-p (game) diff --git a/chess-module.el b/chess-module.el index 47b5ff0..f176b66 100644 --- a/chess-module.el +++ b/chess-module.el @@ -83,7 +83,7 @@ (chess-with-current-buffer module (setq chess-module-leader nil))) -(defun chess-module-destroy (module) +(defun chess-module-destroy (&optional module) (let ((buf (or module (current-buffer)))) (when (buffer-live-p buf) (with-current-buffer buf diff --git a/chess-ply.el b/chess-ply.el index b9141c7..9830ed1 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -71,8 +71,12 @@ (defun chess-ply-keyword (ply keyword) (let ((item (memq keyword (chess-ply-changes ply)))) (if item - (if (memq keyword '(:which :promote)) - (cdr item) + ;; these are special keywords which use a value argument; + ;; `which' is for disambiguating algebraic moves, `promote' + ;; indicates the piece to promote to, `white' is white's + ;; remaining time in seconds, and similarly for `black' + (if (memq keyword '(:which :promote :white :black)) + (cadr item) t)))) (defsubst chess-ply-source (ply) |