- Feature work remaining
-
- 2.0 annotations
- chatting
-
- 2.x display/database tie-in
- analysis/highlight tools
- bughouse/crazyhouse
-
-----------------------------------------------------------------------
-
Hotlist
-- TAB in chess-pgn-mode at move 1 thinks O-O and O-O-O are legal
- moves.
-
- Follow what `edit-env' does, in order to make chess-query.el
-- Make a command binding (for reading NG articles and such) which will
- assume there is a PGN game under point and will read it as such and
- jump to the move before cursor; right now, C-c C-c in chess-pgn
- requires that the buffer be in pgn-mode
-
-- Move chess-assert-can-move into chess-display-move
-
-- Allow an "index N" command to the network protocol, so two people
- can review a game together
-
-- Make ( create variations in a display, and { begin an annotation. "
- or ; will begin a chat string.
-
-- Have C-p and C-n move forward and backward plies, and C-f and C-b
- move into and out of variations
-
-- Make chess-display-create use require, not chess.el
-
-- PGN files aren't sendable via IRC yet; I will have to convert ^J
- into ^K or something.
-
-- Polish chess-input.el
+- Make ( create variations in a display, and C-f and C-b move into and
+ out of them
- Find a way that regexp-alist entries that only need to fire once are
only scanned once.
-- Make any game-modifying commands in a display use C-c C-?
-
-- Complete the ICS12 parser, based on Mario's comments
-
- Add support for ICS observing
- Use server-side sockets in chess-network, if Emacs supports it
- Still need to test many areas: position editing
-- Add chess-game-strip-annotations, for removing all annotations from
- a game object
-
-- Let the user specify a default size for the chess-images display
-
-- Resize the chess board on a window resize event, if possible.
-
- In chess-ics.el, setup a completion function based on handles
- Break chess-legal-plies into two parts, one of which would be the
- Have elp.el not instrument defsubst functions; it obscures the
results too much
-- Mario reports that using chess-plain and chess-link, he ends up with
- impossible positions being displayed (with too many pieces, bishops
- of the same color, etc).
-
----------------------------------------------------------------------
To-do List
----------------------------------------------------------------------
- Training features
+ Training
+
+- Write a scripted chess-tutorial.
- Allow the opponent to give hints.
defense/attack/both, etc. Basically, everything that can be known
about the current board, and one move ahead (on both sides).
+----------------------------------------------------------------------
+
+ Other variations
+
+Need a way to play bughouse/crazyhouse games.
+
----------------------------------------------------------------------
BEFORE FINAL RELEASE
--- /dev/null
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Implements chess chat, which is very much like kibitzing, but not
+;; saved. RET is used to send each chat line.
+;;
+
+(defvar chess-chat-input-last nil)
+
+(make-variable-buffer-local 'chess-chat-input-last)
+
+(define-derived-mode chess-chat-mode text-mode "Chat"
+ "A mode for editing chess annotations."
+ (set-buffer-modified-p nil)
+ (setq chess-chat-input-last (copy-marker (point-max) t))
+ (let ((map (current-local-map)))
+ (define-key map [return] 'chess-chat-send)
+ (define-key map [(control ?m)] 'chess-chat-send)))
+
+(defun chess-chat-send ()
+ (interactive)
+ (chess-game-run-hooks chess-module-game 'chat
+ (buffer-substring-no-properties
+ chess-chat-input-last (point-max)))
+ (set-marker chess-chat-input-last (point-max))
+ (set-buffer-modified-p nil))
+
+(defun chess-chat-handler (game event &rest args)
+ (cond
+ ((eq event 'initialize)
+ (kill-buffer (current-buffer))
+ (set-buffer (generate-new-buffer "*Chat*"))
+ (chess-chat-mode)
+ t)
+
+ ((eq event 'switch-to-chat)
+ (switch-to-buffer-other-window (current-buffer)))
+
+ ((eq event 'chat)
+ (chess-chat-handler 'switch-to-chat)
+ (save-excursion
+ (goto-char chess-chat-input-last)
+ (insert (car args))))))
+
+(provide 'chess-chat)
+
+;;; chess-chat.el ends here
(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 (or (car args) 0))))
- (unless (chess-game-data game 'black-remaining)
- (chess-game-set-data game 'black-remaining (float (or (car args) 0))))
- (setq chess-clock-timer
- (run-with-timer 0 1 'chess-clock-tick-tock (current-buffer)))
+ (unless (or (null (car args))
+ (chess-game-data game 'white-remaining))
+ (chess-game-set-data game 'white-remaining (float (car args)))
+ (chess-game-set-data game 'black-remaining (float (car args))))
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))))
+ (let* ((last-ply (car (last (chess-game-plies game) 2)))
+ (white (chess-ply-keyword last-ply :white))
+ (black (chess-ply-keyword last-ply :black)))
+ (when (and white black)
+ (chess-game-set-data game 'white-remaining white)
+ (chess-game-set-data game 'black-remaining black))))
((eq event 'move)
- (when (> (chess-game-index game) 0)
- (let ((last-ply (car (last (chess-game-plies game) 2))))
- (chess-ply-set-keyword last-ply :white
- (chess-game-data game 'white-remaining))
- (chess-ply-set-keyword last-ply :black
- (chess-game-data game 'black-remaining)))))
+ (let ((white (chess-game-data game 'white-remaining))
+ (black (chess-game-data game 'black-remaining)))
+ (when (and white black (> (chess-game-index game) 0))
+ (setq chess-clock-timer
+ (run-with-timer 0 1 'chess-clock-tick-tock (current-buffer)))
+ (let ((last-ply (car (last (chess-game-plies game) 2))))
+ (chess-ply-set-keyword last-ply :white white)
+ (chess-ply-set-keyword last-ply :black black))))
+ (if (chess-game-over-p game)
+ (chess-clock-handler game 'destroy)))
- ((eq event 'destroy)
- (cancel-timer chess-clock-timer))))
+ ((eq event 'set-data)
+ (if (and (eq (car args) 'active)
+ (null (chess-game-data game 'active)))
+ (chess-clock-handler game 'destroy)))
+
+ ((memq event '(destroy resign drawn))
+ (when chess-clock-timer
+ (cancel-timer chess-clock-timer)
+ (setq chess-clock-timer)))))
(defvar chess-clock-tick-tocking nil)
((eq event 'pass)
(chess-engine-send nil "go\n"))
- ((eq event 'resign)
- (chess-engine-send nil "resign\n"))
-
((eq event 'draw)
(chess-message 'draw-offer-declined))
(chess-game-undo game (car args))))
((eq event 'move)
- (if (= 1 (chess-game-index game))
- (chess-game-set-tag game "Black" chess-engine-opponent-name))
+ (if (= 0 (chess-game-index game))
+ (chess-game-set-tag game "White" chess-engine-opponent-name)
+ (if (= 1 (chess-game-index game))
+ (chess-game-set-tag game "Black" chess-engine-opponent-name)))
+
(chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
+
(if (chess-game-over-p game)
(chess-game-set-data game 'active nil)))))
;; Play against crafty!
;;
-(require 'chess-engine)
(require 'chess-common)
(defgroup chess-crafty nil
(defcustom chess-display-mode-line-format
'(" " chess-display-side-to-move " "
chess-display-move-text " "
- (: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) (% (abs (floor white)) 60)
- (/ (floor black) 60) (% (abs (floor black)) 60)))))
+ (:eval (chess-display-clock-string))
"(" (:eval (chess-game-tag chess-module-game "White")) "-"
(:eval (chess-game-tag chess-module-game "Black")) ", "
(:eval (chess-game-tag chess-module-game "Site"))
(defun chess-display-create (game style perspective)
"Create a chess display, for displaying chess objects."
- (let ((chess-display-style style))
- (chess-module-create 'chess-display game "*Chessboard*" perspective)))
+ (if (require style nil t)
+ (let ((chess-display-style style))
+ (chess-module-create 'chess-display game "*Chessboard*"
+ perspective))))
(defalias 'chess-display-destroy 'chess-module-destroy)
(defun chess-display-set-ply (display ply)
(chess-with-current-buffer display
- (chess-display-set-index* nil 1)
+ (let ((chess-game-inhibit-events t))
+ (chess-display-set-index nil 1))
(chess-game-set-plies chess-module-game
(list ply (chess-ply-create*
(chess-ply-next-pos ply))))))
variation. Any moves made on the board will extend/change the
variation that was passed in."
(chess-with-current-buffer display
- (chess-display-set-index* nil (or index (chess-var-index variation)))
+ (let ((chess-game-inhibit-events t))
+ (chess-display-set-index nil (or index (chess-var-index variation))))
(chess-game-set-plies chess-module-game variation)))
(defun chess-display-variation (display)
(defalias 'chess-display-game 'chess-module-game)
-(defun chess-display-set-index* (display index)
+(defun chess-display-clock-string ()
+ (let ((white (chess-game-data chess-module-game 'white-remaining))
+ (black (chess-game-data chess-module-game 'black-remaining)))
+ (if (and (not (and white black))
+ (> chess-display-index 0))
+ (let ((last-ply (chess-game-ply chess-module-game
+ (1- chess-display-index))))
+ (setq white (chess-ply-keyword last-ply :white)
+ black (chess-ply-keyword last-ply :black))))
+ (if (and white black)
+ (format "W %02d:%02d B %02d:%02d "
+ (/ (floor white) 60) (% (abs (floor white)) 60)
+ (/ (floor black) 60) (% (abs (floor black)) 60)))))
+
+(defun chess-display-set-index (display index)
(chess-with-current-buffer display
(unless (or (not (integerp index))
(< index 0)
(> index (chess-game-index chess-module-game)))
- ;; setup the mode-line variables as well
- (setq chess-display-index index
- chess-display-move-text
- (if (= index 0)
- (chess-string 'mode-start)
- (concat (int-to-string (if (> index 1)
- (if (= (mod index 2) 0)
- (/ index 2)
- (1+ (/ index 2)))
- 1))
- ". " (and (= 0 (mod index 2)) "... ")
- (chess-ply-to-algebraic
- (chess-game-ply chess-module-game (1- index)))))
- chess-display-side-to-move
- (let ((status (chess-game-status chess-module-game index)))
- (cond
- ((eq status :resign) (chess-string 'mode-resigned))
- ((eq status :draw) (chess-string 'mode-drawn))
- ((eq status :checkmate) (chess-string 'mode-checkmate))
- ((eq status :stalemate) (chess-string 'mode-stalemate))
- (t
- (if (chess-pos-side-to-move (chess-display-position nil))
- (chess-string 'mode-white)
- (chess-string 'mode-black)))))))))
+ (chess-game-run-hooks chess-module-game 'set-index index))))
-(defun chess-display-set-index (display index)
+(defun chess-display-set-index* (display index)
(chess-with-current-buffer display
- (chess-display-set-index* nil index)
- (chess-display-update nil t)))
+ (setq chess-display-index index
+ chess-display-move-text
+ (if (= index 0)
+ (chess-string 'mode-start)
+ (concat (int-to-string (if (> index 1)
+ (if (= (mod index 2) 0)
+ (/ index 2)
+ (1+ (/ index 2)))
+ 1))
+ ". " (and (= 0 (mod index 2)) "... ")
+ (chess-ply-to-algebraic
+ (chess-game-ply chess-module-game (1- index)))))
+ chess-display-side-to-move
+ (let ((status (chess-game-status chess-module-game index)))
+ (cond
+ ((eq status :resign) (chess-string 'mode-resigned))
+ ((eq status :draw) (chess-string 'mode-drawn))
+ ((eq status :checkmate) (chess-string 'mode-checkmate))
+ ((eq status :stalemate) (chess-string 'mode-stalemate))
+ (t
+ (if (or chess-pos-always-white
+ (chess-game-side-to-move chess-module-game index))
+ (chess-string 'mode-white)
+ (chess-string 'mode-black))))))
+ (force-mode-line-update)))
(defsubst chess-display-index (display)
(chess-with-current-buffer display
(funcall chess-display-event-handler 'draw
(chess-display-position nil)
(chess-display-perspective nil))
- (force-mode-line-update)
(if (and popup (not chess-display-no-popup)
(chess-module-leader-p nil))
(chess-display-popup nil))))
The position of PLY must match the currently displayed position.
If only START is given, it must be in algebraic move notation."
(chess-with-current-buffer display
+ (if (and (chess-display-active-p)
+ ;; `active' means we're playing against an engine
+ (chess-game-data chess-module-game 'active)
+ (not (eq (chess-game-data chess-module-game 'my-color)
+ (chess-game-side-to-move chess-module-game))))
+ (chess-error 'not-your-move)
+ (if (and (= chess-display-index
+ (chess-game-index chess-module-game))
+ (chess-game-over-p chess-module-game))
+ (chess-error 'game-is-over)))
;; jww (2002-03-28): This should beget a variation within the
;; game, or alter the game, just as SCID allows
(if (= chess-display-index (chess-game-index chess-module-game))
(let ((chess-display-handling-event t))
- (if (= chess-display-index 0)
- (chess-game-set-tag chess-module-game "White"
- chess-full-name))
(chess-display-paint-move nil ply)
- (chess-game-move chess-module-game ply))
+ (chess-game-move chess-module-game ply)
+ (chess-display-set-index* nil (chess-game-index chess-module-game)))
(error "What to do here?? NYI"))))
-(defun chess-assert-can-move (position)
- (if (and (chess-display-active-p)
- ;; `active' means we're playing against an engine
- (chess-game-data chess-module-game 'active)
- (not (eq (chess-game-data chess-module-game 'my-color)
- (chess-pos-side-to-move position))))
- (chess-error 'not-your-move)
- (if (and (= chess-display-index
- (chess-game-index chess-module-game))
- (chess-game-over-p chess-module-game))
- (chess-error 'game-is-over))))
-
(defun chess-display-highlight (display &rest args)
"Highlight the square at INDEX on the current position.
The given highlighting MODE is used, or the default if the style you
;; Event handler
;;
-(defcustom chess-display-interesting-events nil
+(defcustom chess-display-interesting-events
+ '(set-index)
"Events which will cause a display refresh."
:type '(repeat symbol)
:group 'chess-display)
(chess-game-set-data game 'my-color (not my-color))
(chess-display-set-perspective* nil (not my-color))))
+ ((eq event 'set-index)
+ (chess-display-set-index* nil (car args)))
+
((eq event 'orient)
(let ((my-color (chess-game-data game 'my-color)))
;; Set the display's perspective to whichever color I'm
;; playing
(chess-display-set-perspective* nil my-color))))
- (let ((momentous (memq event chess-display-momentous-events)))
- (if momentous
- (chess-display-set-index* nil (chess-game-index game)))
- (if (or momentous (memq event chess-display-interesting-events))
+ (if (memq event chess-display-momentous-events)
+ (progn
+ (chess-display-set-index* nil (chess-game-index game))
(if (eq event 'move)
(progn
(chess-display-paint-move nil (car args))
(chess-display-popup nil))
- (chess-display-update nil momentous)))))))
+ (chess-display-update nil t)))
+ (if (memq event chess-display-interesting-events)
+ (chess-display-update nil))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(define-key map [(meta ?w)] 'chess-display-kill-board)
(define-key map [(control ?l)] 'chess-display-redraw)
+ (define-key map [(control ?n)] 'chess-display-move-forward)
+ (define-key map [(control ?p)] 'chess-display-move-backward)
map)
"The mode map used in read-only display buffers.")
(define-key map [(control ?c) (control ?t)] 'chess-display-undo)
(define-key map [?X] 'chess-display-quit)
+ (define-key map [?\{] 'chess-display-annotate)
+ (define-key map [?\"] 'chess-display-chat)
+ (define-key map [?\'] 'chess-display-chat)
+
(define-key map [(control ?r)] 'chess-display-search-backward)
(define-key map [(control ?s)] 'chess-display-search-forward)
(define-key map [(control ?y)] 'chess-display-yank-board)
?r ?n ?b ?q ?k
?R ?N ?B ?Q ?K
?o ?O ?x))
- (define-key map (vector key) 'chess-keyboard-shortcut))
- (define-key map [backspace] 'chess-keyboard-shortcut-delete)
+ (define-key map (vector key) 'chess-input-shortcut))
+ (define-key map [backspace] 'chess-input-shortcut-delete)
(define-key map [(control ?m)] 'chess-display-select-piece)
(define-key map [return] 'chess-display-select-piece)
The key bindings available in this mode are:
\\{chess-display-mode-map}"
(interactive)
- (setq major-mode 'chess-display-mode mode-name "Chessboard")
+ (setq major-mode 'chess-display-mode
+ mode-name "Chessboard")
(use-local-map chess-display-mode-map)
(buffer-disable-undo)
(setq buffer-auto-save-file-name nil
mode-line-format 'chess-display-mode-line-format)
+ (setq chess-input-position-function
+ (function
+ (lambda ()
+ (chess-display-position nil))))
(setq chess-input-move-function 'chess-display-move))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(yes-or-no-p (chess-string 'want-to-quit)))
(chess-module-destroy nil)))
+(defun chess-display-annotate ()
+ (interactive)
+ (chess-game-run-hooks chess-module-game 'switch-to-annotations))
+
+(defun chess-display-chat ()
+ (interactive)
+ (chess-game-run-hooks chess-module-game 'switch-to-chat))
+
(defun chess-display-manual-move (move)
"Move a piece manually, using chess notation."
(interactive
(throw 'message (chess-string 'move-not-legal)))
(chess-display-move nil ply (car last-sel) (point))))
(setq chess-display-last-selected nil))
- (chess-assert-can-move position)
(let ((piece (chess-pos-piece position coord)))
(cond
((eq piece ? )
t))
((eq event 'illegal)
- (chess-message 'opp-illegal)))))
+ (chess-message 'opp-illegal))
+
+ ((eq event 'kibitz)
+ (let ((chess-engine-handling-event t))
+ (chess-game-run-hooks game 'kibitz (car args))))
+
+ ((eq event 'chat)
+ (let ((chess-engine-handling-event t))
+ (chess-game-run-hooks game 'chat (car args)))))))
(defun chess-engine-create (module game &optional response-handler
&rest handler-ctor-args)
(setq i (1+ i)))
(t
(setq error t)))
- (setq i (1+ i) c (aref fen i)))
+ (setq i (1+ i) c (and (< i l) (aref fen i))))
(unless error
position)))
(1+ (/ index 2)))
1)))
-(defsubst chess-game-side-to-move (game)
- (chess-pos-side-to-move (chess-game-pos game)))
+(defsubst chess-game-side-to-move (game &optional index)
+ (= (mod (or index (chess-game-index game)) 2) 0))
(defun chess-game-ply (game &optional index)
"Return the position related to GAME's INDEX position."
(chess-game-run-hooks game 'post-undo count))
+(defun chess-game-strip-annotations (game)
+ "Strip all annotations from the given GAME."
+ (dotimes (i (chess-game-index game))
+ (let ((position (chess-game-pos game i)))
+ (chess-pos-set-annotations position nil))))
+
+
(defsubst chess-game-over-p (game)
"Return the position related to GAME's INDEX position."
(let ((last-ply (car (last game 2))))
;; Play against gnuchess!
;;
-(require 'chess-engine)
(require 'chess-common)
(defgroup chess-gnuchess nil
piece))))
(setq parts (cdr parts)))
- ;; next, the "side to move
+ ;; next, the "side to move"
(chess-pos-set-side-to-move position (string= (car parts) "W"))
(setq parts (cdr parts))
;; the chess board file (numbered 0--7 for a--h) in which the
;; double push was made
(let ((index (string-to-number (car parts))))
- (when (> index 0)
+ (when (>= index 0)
(chess-pos-set-en-passant
position (chess-rf-to-index
(if (chess-pos-side-to-move position) 3 4) index))))
(chess-pos-set-can-castle position ?q t))
(setq parts (cdr parts))
- ;; jww (2002-04-11): How is check indicated?
-
;; the number of moves made since the last irreversible move. (0
;; if last move was irreversible. If the value is >= 100, the
;; game can be declared a draw due to the 50 move rule.)
(setq parts (cdr parts))
;; white player, black player
- (setq white (car parts))
- (setq parts (cdr parts))
- (setq black (car parts))
- (setq parts (cdr parts))
+ (setq white (car parts) parts (cdr parts))
+ (setq black (car parts) parts (cdr parts))
;; my relation to this game:
;; -3 isolated position, such as for "ref 3" or the "sposition"
;; numbering -- White's and Black's first moves are both 1, etc.)
(setq parts (cdr parts))
- ;; move in elaborated notation
+ ;; move in long alegebraic notation
(setq parts (cdr parts))
;; time taken to make previous move "(min:sec)".
(setq parts (cdr parts))
- ;; move in algebraic notation
+ ;; move in short algebraic notation (SAN)
(setq move (unless (string= (car parts) "none")
(car parts)))
(setq parts (cdr parts))
;; White at bottom.
(setq parts (cdr parts))
+ ;; jww (2002-04-18): what do these two mean?
(setq parts (cdr parts))
(setq parts (cdr parts))
:set 'chess-images-clear-image-cache
:group 'chess-images)
+(defcustom chess-images-default-size nil
+ "The default pixel width to use for chess pieces.
+If this width is not available, then next smallest will be chosen.
+If there is none smaller, then the best size available will be chosen.
+If `chess-images-default-size' is nil (the default), then the best
+width for the current display is calculated used."
+ :type '(choice integer (const :tag "Best fit" nil))
+ :group 'chess-images)
+
(defcustom chess-images-background-image "blank"
"The name of the file used for background squares.
This file is optional. If there is no file available by this name, a
"The names and index values of the different pieces.")
(chess-message-catalog 'english
- '((no-images-fallback . "Could not find suitable chess images")))
+ '((no-images-fallback . "Could not find any suitable or properly sized chess images")))
(defun chess-images-handler (event &rest args)
(cond
((eq event 'highlight)
(apply 'chess-images-highlight args))))
-(defun chess-images-initialize ()
- (let ((map (current-local-map)))
- (define-key map [?^] 'chess-images-increase-size)
- (define-key map [?V] 'chess-images-decrease-size)
- (define-key map [?P] 'chess-images-set-directory))
-
+(defun chess-images-determine-size ()
(let ((display (and (stringp chess-images-separate-frame)
chess-images-separate-frame)))
(setq cursor-type nil
(x-display-pixel-width display)
(display-pixel-width)) 20)))))
+(defun chess-images-initialize ()
+ (let ((map (current-local-map)))
+ (define-key map [?^] 'chess-images-increase-size)
+ (define-key map [?V] 'chess-images-decrease-size)
+ (define-key map [?P] 'chess-images-set-directory))
+ (chess-images-determine-size))
+
(chess-message-catalog 'english
'((no-images . "Cannot find any piece images; check `chess-images-directory'")))
mode))))
(put-text-property pos (1+ pos) 'display highlight)))
+(chess-message-catalog 'english
+ '((redrawing-frame . "Redrawing chess display with different size...")
+ (redrawing-frame-done . "Redrawing chess display with different size...done")))
+
+(defun chess-images-change-size (size)
+ (let* ((buffer (current-buffer))
+ (window (get-buffer-window buffer))
+ (frame (and window (window-frame window))))
+ (setq chess-images-size size
+ chess-images-cache nil )
+ (if frame
+ (delete-frame frame t))
+ (chess-message 'redrawing-frame)
+ (chess-display-update buffer t)
+ (chess-message 'redrawing-frame-done)))
+
+(defun chess-images-resize ()
+ "Resize the chessboard based on the frame or window's new size."
+ (chess-images-determine-size)
+ (if chess-images-size
+ (chess-images-change-size chess-images-size)
+ (chess-message 'no-images-fallback)))
+
(defun chess-images-alter-size (test)
(let ((sizes chess-images-sizes))
(if (eq test '<)
(while sizes
(if (funcall test (car sizes) chess-images-size)
(progn
- (setq chess-images-size (car sizes)
- chess-images-cache nil
- sizes nil)
- ;; jww (2002-04-09): need to create a new frame here!
- (chess-display-update nil))
+ (chess-images-change-size (car sizes))
+ (setq sizes nil))
(setq sizes (cdr sizes))))))
(defun chess-images-increase-size ()
(defun chess-images-best-size (&optional height width)
"Return the piece size that works best for a window of HEIGHT."
- (let* ((size (min (- (/ (or height (frame-pixel-height)) 8)
- (or chess-images-border-width 0))
- (- (/ (or width (frame-pixel-width)) 8)
- (or chess-images-border-width 0))))
+ (let* ((size (or chess-images-default-size
+ (min (- (/ (or height (frame-pixel-height)) 8)
+ (or chess-images-border-width 0))
+ (- (/ (or width (frame-pixel-width)) 8)
+ (or chess-images-border-width 0)))))
(sizes (chess-images-sizes))
(last (car sizes)))
(while sizes
(setq sizes nil)
(setq last (car sizes)
sizes (cdr sizes))))
- last))
+ (or last (and chess-images-default-size
+ (let (chess-images-default-size)
+ (chess-images-best-size height width))))))
(defun chess-images-set-directory (directory)
"Increase the size of the pieces on the board."
;; only way to move your pieces around!
;;
-(defvar chess-move-string "")
-(defvar chess-legal-moves-pos nil)
-(defvar chess-legal-moves nil)
+(defvar chess-input-move-string "")
+(defvar chess-input-moves-pos nil)
+(defvar chess-input-moves nil)
+(defvar chess-input-position-function nil)
(defvar chess-input-move-function nil)
-(make-variable-buffer-local 'chess-move-string)
-(make-variable-buffer-local 'chess-legal-moves-pos)
-(make-variable-buffer-local 'chess-legal-moves)
+(make-variable-buffer-local 'chess-input-move-string)
+(make-variable-buffer-local 'chess-input-moves-pos)
+(make-variable-buffer-local 'chess-input-moves)
+(make-variable-buffer-local 'chess-input-position-function)
(make-variable-buffer-local 'chess-input-move-function)
(chess-message-catalog 'english
'((not-your-move . "It is not your turn to move")
(game-is-over . "This game is over")))
-(defun chess-keyboard-test-move (move-ply)
+(defun chess-input-test-move (move-ply)
"Return the given MOVE if it matches the user's current input."
(let* ((move (cdr move-ply))
(i 0) (x 0) (l (length move))
- (xl (length chess-move-string))
+ (xl (length chess-input-move-string))
(match t))
- (unless (or (and (equal (downcase chess-move-string) "ok")
+ (unless (or (and (equal (downcase chess-input-move-string) "ok")
(string-match "\\`O-O[+#]?\\'" move))
- (and (equal (downcase chess-move-string) "oq")
+ (and (equal (downcase chess-input-move-string) "oq")
(string-match "\\`O-O-O[+#]?\\'" move)))
(while (and (< i l) (< x xl))
(let ((move-char (aref move i))
- (entry-char (aref chess-move-string x)))
+ (entry-char (aref chess-input-move-string x)))
(if (and (= move-char ?x)
(/= entry-char ?x))
(setq i (1+ i))
(if match
move-ply)))
-(defsubst chess-keyboard-display-moves (&optional move-list)
- (if (> (length chess-move-string) 0)
- (message "[%s] %s" chess-move-string
+(defsubst chess-input-display-moves (&optional move-list)
+ (if (> (length chess-input-move-string) 0)
+ (message "[%s] %s" chess-input-move-string
(mapconcat 'cdr
(or move-list
- (delq nil (mapcar 'chess-keyboard-test-move
- (cdr chess-legal-moves))))
+ (delq nil (mapcar 'chess-input-test-move
+ (cdr chess-input-moves))))
" "))))
-(defun chess-keyboard-shortcut-delete ()
+(defun chess-input-shortcut-delete ()
(interactive)
- (when (and chess-move-string
- (stringp chess-move-string)
- (> (length chess-move-string) 0))
- (setq chess-move-string
- (substring chess-move-string 0 (1- (length chess-move-string))))
- (chess-keyboard-display-moves)))
+ (when (and chess-input-move-string
+ (stringp chess-input-move-string)
+ (> (length chess-input-move-string) 0))
+ (setq chess-input-move-string
+ (substring chess-input-move-string 0 (1- (length chess-input-move-string))))
+ (chess-input-display-moves)))
-(defun chess-keyboard-shortcut (&optional display-only)
+(defun chess-input-shortcut (&optional display-only)
(interactive)
- (let* ((position (chess-display-position nil))
+ (let* ((position (funcall chess-input-position-function))
(color (chess-pos-side-to-move position))
char)
- (chess-assert-can-move position)
- (unless (memq last-command '(chess-keyboard-shortcut
- chess-keyboard-shortcut-delete))
- (setq chess-move-string nil))
+ (unless (memq last-command '(chess-input-shortcut
+ chess-input-shortcut-delete))
+ (setq chess-input-move-string nil))
(unless display-only
- (setq chess-move-string
- (concat chess-move-string (char-to-string last-command-char))))
- (unless (and chess-legal-moves
- (eq position chess-legal-moves-pos)
- (or (> (length chess-move-string) 1)
- (eq (car chess-legal-moves) last-command-char)))
+ (setq chess-input-move-string
+ (concat chess-input-move-string (char-to-string last-command-char))))
+ (unless (and chess-input-moves
+ (eq position chess-input-moves-pos)
+ (or (> (length chess-input-move-string) 1)
+ (eq (car chess-input-moves) last-command-char)))
(setq char (if (eq (downcase last-command-char) ?o) ?k
last-command-char)
- chess-legal-moves-pos position
- chess-legal-moves
+ chess-input-moves-pos position
+ chess-input-moves
(cons char
(sort
(mapcar
(function
(lambda (left right)
(string-lessp (cdr left) (cdr right)))))))))
- (let ((moves (delq nil (mapcar 'chess-keyboard-test-move
- (cdr chess-legal-moves)))))
+ (let ((moves (delq nil (mapcar 'chess-input-test-move
+ (cdr chess-input-moves)))))
(cond
((or (= (length moves) 1)
;; if there is an exact match except for case, it must be an
(downcase (cdr (cadr moves))))
(setq moves (cdr moves))))
(funcall chess-input-move-function nil (caar moves))
- (setq chess-move-string nil
- chess-legal-moves nil
- chess-legal-moves-pos nil))
+ (setq chess-input-move-string nil
+ chess-input-moves nil
+ chess-input-moves-pos nil))
((null moves)
- (chess-keyboard-shortcut-delete))
+ (chess-input-shortcut-delete))
(t
- (chess-keyboard-display-moves moves)))))
+ (chess-input-display-moves moves)))))
(provide 'chess-input)
--- /dev/null
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Implements chess kibitzing, stored as annotations to the game being
+;; viewed or played. C-c C-c is used to save a kibitzing comment.
+;;
+
+(defvar chess-kibitz-input-last nil)
+(defvar chess-kibitz-index nil)
+
+(make-variable-buffer-local 'chess-kibitz-input-last)
+(make-variable-buffer-local 'chess-kibitz-index)
+
+(define-derived-mode chess-kibitz-mode text-mode "Kibitz"
+ "A mode for editing chess annotations."
+ (set-buffer-modified-p nil)
+ (setq chess-kibitz-input-last (copy-marker (point-max) t))
+ (let ((map (current-local-map)))
+ (define-key map [(control ?c) (control ?c)] 'chess-kibitz-save)))
+
+(defun chess-kibitz-save ()
+ (interactive)
+ (let ((ann (buffer-substring-no-properties chess-kibitz-input-last
+ (point-max))))
+ (chess-game-run-hooks chess-module-game 'kibitz ann)
+ (chess-pos-add-annotation (chess-game-pos chess-kibitz-index) ann))
+ (set-marker chess-kibitz-input-last (point-max))
+ (set-buffer-modified-p nil))
+
+(defun chess-kibitz-show-annotations (index)
+ (setq chess-kibitz-index index)
+ (erase-buffer)
+ (let ((position (chess-game-pos chess-module-game index))
+ popup)
+ (dolist (ann (chess-pos-annotations position))
+ (when (stringp ann)
+ (insert ann ?\n)
+ (setq popup t)))
+ (if popup
+ (display-buffer (current-buffer)))))
+
+(defun chess-kibitz-handler (game event &rest args)
+ (cond
+ ((eq event 'initialize)
+ (kill-buffer (current-buffer))
+ (set-buffer (generate-new-buffer "*Annotations*"))
+ (chess-kibitz-mode)
+ t)
+
+ ((eq event 'switch-to-annotations)
+ (switch-to-buffer-other-window (current-buffer)))
+
+ ((eq event 'kibitz)
+ (chess-kibitz-handler 'switch-to-annotations)
+ (save-excursion
+ (goto-char chess-kibitz-input-last)
+ (insert (car args))))
+
+ ((eq event 'set-index)
+ (chess-kibitz-show-annotations (car args)))
+
+ ((memq event '(post-undo move))
+ (chess-kibitz-show-annotations (chess-game-index game)))))
+
+(provide 'chess-kibitz)
+
+;;; chess-kibitz.el ends here
;; Play against an opponent over the network
;;
-(require 'chess-engine)
+(require 'chess-common)
(require 'chess-fen)
(require 'chess-algebraic)
(function
(lambda ()
(funcall chess-engine-response-handler 'setup-game
- (chess-engine-convert-pgn (match-string 1))))))
+ (chess-engine-convert-pgn
+ (chess-network-parse-multiline (match-string 1)))))))
(cons "pass$"
(function
(lambda ()
(cons "retract$"
(function
(lambda ()
- (funcall chess-engine-response-handler 'retract))))))
+ (funcall chess-engine-response-handler 'retract))))
+ (cons "illegal$"
+ (function
+ (lambda ()
+ (funcall chess-engine-response-handler 'illegal))))
+ (cons "kibitz\\s-+\\(.+\\)$"
+ (function
+ (lambda ()
+ (funcall chess-engine-response-handler 'kibitz
+ (chess-network-parse-multiline (match-string 1))))))
+ (cons "chat\\s-+\\(.+\\)$"
+ (function
+ (lambda ()
+ (funcall chess-engine-response-handler 'chat
+ (chess-network-parse-multiline (match-string 1))))))))
(chess-message-catalog 'english
'((network-starting . "Starting network client/server...")
(network-waiting . "Now waiting for your opponent to connect...")
(network-connected ."You have connected; pass now or make your move.")))
+(defun chess-network-flatten-multiline (str)
+ (while (string-match "\n" str)
+ (setq str (replace-match "\C-k" t t str)))
+ str)
+
+(defun chess-network-parse-multiline (str)
+ (while (string-match "\C-k" str)
+ (setq str (replace-match "\n" t t str)))
+ str)
+
(defun chess-network-handler (game event &rest args)
"Initialize the network chess engine."
(unless chess-engine-handling-event
(chess-message 'network-connected))
t))
- ((eq event 'destroy)
- (chess-engine-send nil "quit\n"))
+ ((eq event 'ready)) ; don't set active yet
((eq event 'setup-pos)
(chess-engine-send nil (format "fen %s\n"
((eq event 'setup-game)
(chess-engine-send nil (format "pgn %s\n"
- (chess-game-to-string (car args)))))
+ (chess-network-flatten-multiline
+ (chess-game-to-string (car args))))))
((eq event 'pass)
(chess-engine-send nil "pass\n"))
((eq event 'illegal)
(chess-engine-send nil "illegal\n"))
- ((eq event 'move)
- (if (= 1 (chess-game-index game))
- (chess-game-set-tag game "Black" chess-engine-opponent-name))
- (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
- (if (chess-game-over-p game)
- (chess-game-set-data game 'active nil))))))
+ ((eq event 'kibitz)
+ (chess-engine-send nil (format "kibitz %s\n"
+ (chess-network-flatten-multiline
+ (car args)))))
+
+ ((eq event 'chat)
+ (chess-engine-send nil (format "chat %s\n"
+ (chess-network-flatten-multiline
+ (car args)))))
+
+ ((eq event 'set-index)
+ (chess-engine-send nil (format "index %d\n" (car args))))
+
+ (t
+ (apply 'chess-common-handler game event args)))))
(provide 'chess-network)
(make-variable-buffer-local 'chess-pgn-current-game)
(make-variable-buffer-local 'chess-pgn-current-index)
+(chess-message-catalog 'english
+ '((could-not-read-pgn . "Could not read or find a PGN game")))
+
+;;;###autoload
+(defun chess-pgn-read (&optional file)
+ "Read and display a PGN game after point."
+ (interactive "P")
+ (if (or file (not (search-forward "[Event " nil t)))
+ (setq file (read-file-name "Read a PGN game from file: ")))
+ (if file
+ (find-file file))
+ (let ((game (chess-pgn-to-game)))
+ (if game
+ (chess-display-set-game (chess-create-display) game)
+ (chess-error 'could-not-read-pgn))))
+
;;;###autoload
(define-derived-mode chess-pgn-mode text-mode "PGN"
"A mode for editing chess PGN files."
'database-index)))
(chess-display-set-index chess-pgn-display index))))))
+(defun chess-pgn-visualize ()
+ "Visualize the move for the PGN game under point.
+This does not require that the buffer be in PGN mode."
+ (let (game)
+ (save-excursion
+ (if (search-backward "[Event " nil t)
+ (setq game (chess-pgn-to-game))))
+ (if game
+ (let ((chess-pgn-current-game game))
+ (chess-pgn-show-position))
+ (chess-error 'could-not-read-pgn))))
+
(defun chess-pgn-show-position ()
(interactive)
- (chess-pgn-read-game)
- (chess-pgn-create-display))
+ (if (not (eq major-mode 'chess-pgn-mode))
+ (chess-pgn-visualize)
+ (chess-pgn-read-game)
+ (chess-pgn-create-display)))
(defun chess-pgn-mouse-show-position (event)
(interactive "e")
;; Play against phalanx!
;;
-(require 'chess-engine)
(require 'chess-common)
(defgroup chess-phalanx nil
(if (chess-pos-piece-p position index (if color ?R ?r))
(setq rook index file king-file)
(setq file (funcall (if long '1+ '1-) file)))))
- (if (and rook (chess-legal-plies position :any :index king
- :target king-target))
+ (setq file (chess-index-file king)
+ file (funcall (if long '1- '1+) file))
+ (while (and rook (funcall (if long '>= '<=) file
+ (chess-index-file king-target)))
+ (let ((index (chess-rf-to-index (if color 7 0) file)))
+ (if (chess-pos-piece-p position index ? )
+ (setq file (funcall (if long '1- '1+) file))
+ (setq rook nil))))
+ (if (and rook (chess-pos-legal-moves position color king-target
+ (list king)))
(list king king-target rook
(chess-rf-to-index (if color 7 0) (if long 3 5))
- (if long :long-castle :castle))
- (assert (not "Could not determine castling manuever")))))
+ (if long :long-castle :castle)))))
(chess-message-catalog 'english
'((pawn-promote-query . "Promote pawn to queen/rook/knight/bishop? ")))
;; we must determine whether this ply results in a check,
;; checkmate or stalemate
- (unless (or (memq :check changes)
+ (unless (or chess-pos-always-white
+ (memq :check changes)
(memq :checkmate changes)
(memq :stalemate changes))
(let* ((chess-ply-checking-mate t)
(chess-ply--add nil nil pos)))
(if (chess-pos-can-castle position (if color ?K ?k))
- (chess-ply--add 0 2))
+ (let ((changes (chess-ply-create-castle position nil candidate)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies)))))
+
(if (chess-pos-can-castle position (if color ?Q ?q))
- (chess-ply--add 0 -2)))
+ (let ((changes (chess-ply-create-castle position t candidate)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies))))))
;; the knight is a zesty little piece; there may be more than
;; one, but at only one possible square in each direction
"Routines for manipulating chess positions."
:group 'chess)
-(defvar chess-pos-white-always-on-move nil)
-(make-variable-buffer-local 'chess-pos-white-always-on-move)
+(defvar chess-pos-always-white nil)
+(make-variable-buffer-local 'chess-pos-always-white)
(defconst chess-starting-position
[;; the eight ranks and files of the chess position
(chess-pos-set-en-passant position (cadr changes))))))
;; toggle the side whose move it is
- (unless chess-pos-white-always-on-move
+ (unless chess-pos-always-white
(chess-pos-set-side-to-move position (not color)))
;; promote the piece if we were meant to
be moved, and TARGET is the index of the location to be moved to.
Note: All of the pieces specified by CANDIDATES must be of the same
-type."
+type. Also, it is the callers responsibility to ensure that the piece
+can legally reach the square in question. This function merely
+assures that the resulting position is valid."
(let ((cand candidates)
(piece (chess-pos-piece position (car candidates)))
- taken-piece last-cand king-pos)
+ other-piece last-cand king-pos)
(while cand
;; determine the resulting position
- (chess-pos-set-piece position (car cand) ? )
- (setq taken-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 taken-piece)
- (chess-pos-set-piece position (car cand) piece)
+ (setq other-piece (chess-pos-piece position (car cand)))
+ (when (if color
+ (> other-piece ?a)
+ (< other-piece ?A))
+ (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))
(defcustom chess-default-modules
'((chess-sound chess-announce)
- chess-autosave)
+ chess-autosave
+ chess-clock
+ chess-kibitz
+ chess-chat)
"Modules to be used when starting a chess session.
A sublist indicates a series of alternatives, if the first is not
available.
:group 'chess)
(defun chess--create-display (module game my-color disable-popup)
- (when (require module nil t)
- (let ((display (chess-display-create game module my-color)))
- (when display
- (chess-game-set-data game 'my-color my-color)
- (if disable-popup
- (chess-display-disable-popup display))
- display))))
+ (let ((display (chess-display-create game module my-color)))
+ (when display
+ (chess-game-set-data game 'my-color my-color)
+ (if disable-popup
+ (chess-display-disable-popup display))
+ display)))
(defun chess--create-engine (module game response-handler ctor-args)
(let ((engine (apply 'chess-engine-create module game
'chess--create-display
(chess-game-create) perspective nil)))
-;;;###autoload
-(defun chess-read-pgn (&optional file)
- "Read and display a PGN game after point."
- (interactive "P")
- (if (or file (not (search-forward "[Event " nil t)))
- (setq file (read-file-name "Read a PGN game from file: ")))
- (if file
- (find-file file))
- (let ((game (chess-pgn-to-game))
- display)
- (when game
- (setq display (chess-create-display))
- (chess-display-set-game display game))))
-
(defvar chess-puzzle-indices nil)
(defvar chess-puzzle-position nil)
(make-variable-buffer-local 'chess-puzzle-indices)
(dolist (key '(database database-index database-count))
(chess-game-set-data game key (chess-game-data next-game key)))))))
+(chess-message-catalog 'english
+ '((queen-would-take . "The queen would take your knight!")
+ (congratulations . "Congratulations!")))
+
+(defun chess-tutorial-knight-1 (game ignore event &rest args)
+ (if (eq event 'move)
+ (let ((position (chess-game-pos game)))
+ (if (null (chess-pos-search position ?p))
+ (chess-message 'congratulations)
+ (when (chess-search-position
+ position (car (chess-pos-search position ?N)) ?q)
+ (chess-game-run-hooks chess-module-game 'undo 1)
+ (chess-display-update nil)
+ (chess-error 'queen-would-take))))))
+
+(defun chess-tutorial ()
+ (interactive)
+ (let* (chess-default-modules
+ (display (chess-create-display)))
+ (with-current-buffer display
+ (chess-game-set-start-position
+ (chess-display-game nil)
+ (chess-fen-to-pos "8/3p1p/2p3p/4q/2p3p/3p1p/8/N w - -"))
+ (chess-game-add-hook (chess-display-game nil) 'chess-tutorial-knight-1)
+ (setq chess-pos-always-white t)
+ (chess-display-popup nil)
+ (message "Goal: take all the pawns, without letting the queen take your knight"))))
+
(provide 'chess)
;;; chess.el ends here