;;
;; $Revision$
-;;; Code:
-
+(require 'chess-module)
(require 'chess-game)
(require 'chess-var)
(require 'chess-algebraic)
"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-display)
+
+(defcustom chess-display-mode-line-format " %C %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
+ %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:
;; User interface
;;
-(defvar chess-display-style)
-(defvar chess-display-game)
-(defvar chess-display-variation)
(defvar chess-display-index)
-(defvar chess-display-ply)
-(defvar chess-display-position)
(defvar chess-display-perspective)
-(defvar chess-display-main-p nil)
(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-style)
-(make-variable-buffer-local 'chess-display-game)
-(make-variable-buffer-local 'chess-display-variation)
(make-variable-buffer-local 'chess-display-index)
-(make-variable-buffer-local 'chess-display-ply)
-(make-variable-buffer-local 'chess-display-position)
(make-variable-buffer-local 'chess-display-perspective)
-(make-variable-buffer-local 'chess-display-main-p)
(make-variable-buffer-local 'chess-display-event-handler)
(make-variable-buffer-local 'chess-display-no-popup)
(make-variable-buffer-local 'chess-display-edit-mode)
,@body)
,@body)))
-(defun chess-display-create (style perspective &optional main read-only)
- "Create a chess display, for displaying chess objects.
-The display is drawn using the given STYLE, from the PERSPECTIVE
-color's point of view. If MAIN is non-nil, then this is a main
-display, which means it will popup on significant events, and will
-cause the underlying game object to be shutdown when it is destroyed.
-If READ-ONLY is non-nil, then the display will not allow the user to
-makes moves, or any other changes to the underlying game."
- (let* ((name (symbol-name style))
- (handler (intern-soft (concat name "-handler"))))
- (unless handler
- (error "There is no such chessboard display style '%s'" name))
- (with-current-buffer (generate-new-buffer "*Chessboard*")
- (chess-display-mode read-only)
- (funcall handler 'initialize)
- (setq chess-display-style style
- chess-display-perspective perspective
- chess-display-event-handler handler)
- (if main
- (chess-display-set-main nil))
- (add-hook 'kill-buffer-hook 'chess-display-quit nil t)
- (current-buffer))))
+(chess-message-catalog 'english
+ '((no-such-style . "There is no such chessboard display style '%s'")))
+
+(defvar chess-display-style)
+
+(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*")))
(defun chess-display-clone (display style perspective)
- (let ((new-display (chess-display-create style perspective)))
- (with-current-buffer display
- (cond
- (chess-display-game
- (chess-display-set-game new-display chess-display-game))
- (chess-display-variation
- (chess-display-set-variation new-display chess-display-variation))
- (chess-display-ply
- (chess-display-set-ply new-display chess-display-ply))
- (chess-display-position
- (chess-display-set-game new-display chess-display-position))))
+ (let ((new-display (chess-display-create chess-module-game
+ style perspective)))
;; the display will have already been updated by the `set-' calls,
;; it's just not visible yet
(chess-display-popup new-display)
new-display))
-(defsubst chess-display-style (display)
- (chess-with-current-buffer display
- chess-display-style))
-
(defsubst chess-display-perspective (display)
(chess-with-current-buffer display
chess-display-perspective))
(chess-display-set-perspective* nil perspective)
(chess-display-update nil)))
-(defsubst chess-display-main-p (display)
- (chess-with-current-buffer display
- chess-display-main-p))
-
-(defun chess-display-set-main (display)
+(defun chess-display-set-position (display &optional position my-color)
(chess-with-current-buffer display
- (setq chess-display-main-p t)))
-
-(defun chess-display-clear-main (display)
- (chess-with-current-buffer display
- (setq chess-display-main-p nil)))
-
-
-(defun chess-display-set-position (display position &optional search-func)
- "Set the display position.
-Note that when a single position is being displayed, out of context of
-a game, the user's move will cause a new variation to be created,
-without a game object.
-If the position is merely edited, it will change the POSITION object
-that was passed in."
- (chess-with-current-buffer display
- (if chess-display-game
- (chess-display-detach-game nil))
- (setq chess-display-game nil
- chess-display-variation nil
- chess-display-index nil
- chess-display-ply nil
- chess-display-position position)
- (chess-display-update nil t)))
+ (if position
+ (progn
+ (chess-game-set-start-position chess-module-game position)
+ (chess-game-set-data chess-module-game 'my-color my-color))
+ (chess-game-set-start-position chess-module-game
+ chess-starting-position)
+ (chess-game-set-data chess-module-game 'my-color t))
+ (chess-display-set-index nil 0)))
(defun chess-display-position (display)
"Return the position currently viewed."
(chess-with-current-buffer display
- (or (and chess-display-game
- (chess-game-pos chess-display-game chess-display-index))
- (and chess-display-variation
- (chess-var-pos chess-display-variation chess-display-index))
- (and chess-display-ply
- (chess-ply-next-pos chess-display-ply))
- chess-display-position)))
+ (chess-game-pos chess-module-game chess-display-index)))
(defun chess-display-set-ply (display ply)
- "Set the display ply.
-This differs from a position display, only in that the algebraic form
-of the move made to the reach the displayed position will be shown in
-the modeline."
(chess-with-current-buffer display
- (if chess-display-game
- (chess-display-detach-game nil))
- (setq chess-display-game nil
- chess-display-variation nil
- chess-display-index nil
- chess-display-ply ply
- chess-display-position nil)
- (chess-display-update display t)))
+ (setq chess-game-index 1)
+ (chess-game-set-plies chess-module-game
+ (list ply (chess-ply-create
+ (chess-ply-next-pos ply))))))
(defun chess-display-ply (display)
(chess-with-current-buffer display
- (or (and chess-display-game
- (chess-game-ply chess-display-game chess-display-index))
- (and chess-display-variation
- (chess-var-ply chess-display-variation chess-display-index))
- chess-display-ply)))
+ (chess-game-ply chess-module-game chess-display-index)))
(defun chess-display-set-variation (display variation &optional index)
"Set the display variation.
variation. Any moves made on the board will extend/change the
variation that was passed in."
(chess-with-current-buffer display
- (if chess-display-game
- (chess-display-detach-game nil))
- (setq chess-display-game nil
- chess-display-variation variation
- chess-display-index (chess-var-index variation)
- chess-display-ply nil
- chess-display-position nil)
- (chess-display-update nil t)))
+ (setq chess-game-index (or index (chess-var-index variation)))
+ (chess-game-set-plies chess-module-game variation)))
(defun chess-display-variation (display)
(chess-with-current-buffer display
- (or (and chess-display-game
- (chess-game-main-var chess-display-game))
- chess-display-variation)))
+ (chess-game-main-var chess-module-game)))
-(defun chess-display-set-game (display game &optional index)
- "Set the display game.
-This will cause the first ply in the game's main variation to be
-displayed. Also, information about the game is shown in the
-modeline."
+(defun chess-display-set-game* (display game &optional index)
+ "Set the game associated with the given DISPLAY."
(chess-with-current-buffer display
- (if chess-display-game
- (chess-display-detach-game nil))
- (setq chess-display-game game
- chess-display-variation nil
- chess-display-index (chess-game-index game)
- chess-display-ply nil
- chess-display-position nil)
- (if game
- (chess-game-add-hook game 'chess-display-event-handler display))
- (chess-display-update nil t)))
+ (chess-module-set-game* display game)
+ (chess-display-set-index nil (or index (chess-game-index game)))))
-(defun chess-display-copy-game (display game)
- (chess-with-current-buffer display
- (setq chess-display-index (chess-game-index game))
- (if (null chess-display-game)
- (chess-display-set-game nil game)
- (chess-game-set-tags chess-display-game (chess-game-tags game))
- ;; this call triggers `setup-game' for us
- (chess-game-set-plies chess-display-game
- (chess-game-plies game)))))
-
-(defun chess-display-set-start-position (display &optional position my-color)
- (chess-with-current-buffer display
- (let ((game (chess-display-game nil)))
- (if (null game)
- (chess-display-set-position nil (or position
- chess-starting-position))
- (if position
- (progn
- (chess-game-set-start-position game position)
- (chess-game-set-data game 'my-color my-color))
- (chess-game-set-start-position game chess-starting-position)
- (chess-game-set-data game 'my-color t))))))
-
-(defun chess-display-detach-game (display)
- "Set the display game.
-This will cause the first ply in the game's main variation to be
-displayed. Also, information about the game is shown in the
-modeline."
+(defun chess-display-set-game (display game &optional index)
+ "Set the given DISPLAY to display the GAME object, optionally at INDEX.
+This is the function to call to cause a display to view a game. It
+will also update all of the listening engines and other displays to
+also view the same game."
(chess-with-current-buffer display
- (if chess-display-game
- (chess-game-remove-hook chess-display-game
- 'chess-display-event-handler
- (or display (current-buffer))))))
+ (chess-game-copy-game chess-display-set-game game)
+ (chess-display-set-index nil (or index (chess-game-index game)))))
-(defsubst chess-display-game (display)
- (chess-with-current-buffer display
- chess-display-game))
+(defalias 'chess-display-game 'chess-module-game)
(defun chess-display-set-index* (display index)
(chess-with-current-buffer display
- (unless chess-display-index
- (error "There is no game or variation currently being displayed."))
(unless (or (not (integerp index))
(< index 0)
- (> index (if chess-display-game
- (chess-game-index chess-display-game)
- (chess-var-index chess-display-variation))))
+ (> index (chess-game-index chess-module-game)))
(setq chess-display-index index))))
(defun chess-display-set-index (display index)
(chess-with-current-buffer display
(chess-display-set-index* nil index)
- (chess-display-update nil)))
+ (chess-display-update nil t)))
-(defsubst chess-display-index (display)
- (chess-with-current-buffer display
- chess-display-index))
+(defalias 'chess-display-index 'chess-module-game-index)
(defun chess-display-update (display &optional popup)
"Update the chessboard DISPLAY. POPUP too, if that arg is non-nil."
(funcall chess-display-event-handler 'draw
(chess-display-position nil)
(chess-display-perspective nil))
- (chess-display-set-modeline)
+ (chess-display-update-modeline)
(if (and popup (not chess-display-no-popup)
- (chess-display-main-p nil))
+ (chess-module-leader-p nil))
(chess-display-popup nil))))
(defun chess-display-move (display ply)
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
- (cond
- (chess-display-game
- ;; jww (2002-03-28): This should beget a variation within the
- ;; game, or alter the game, just as SCID allows
- (if (= (chess-display-index nil)
- (chess-game-index chess-display-game))
- (chess-game-move chess-display-game ply)
- (error "What to do here?? NYI")))
- (chess-display-variation
- (chess-var-move chess-display-variation ply)
- (chess-display-set-index* nil (chess-var-index
- chess-display-variation)))
- (chess-display-ply
- (setq chess-display-ply ply))
- (chess-display-position ; an ordinary position
- (setq chess-display-position (chess-ply-next-pos ply))))
+ ;; 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))
+ (chess-game-move chess-module-game ply)
+ (error "What to do here?? NYI"))
(chess-display-update nil)))
(defun chess-display-highlight (display &rest args)
(dolist (arg args)
(if (or (symbolp arg) (stringp arg))
(setq mode arg)
- (funcall chess-display-event-handler
- 'highlight arg mode))))))
+ (funcall chess-display-event-handler 'highlight arg mode))))))
+
+(defun chess-display-highlight-legal (display pos)
+ "Highlight all legal move targets from POS."
+ (chess-with-current-buffer display
+ (dolist (ply (chess-legal-plies (chess-display-position nil)
+ :index pos))
+ (chess-display-highlight nil "pale green"
+ (chess-ply-target ply)))))
(defun chess-display-popup (display)
"Popup the given DISPLAY, so that it's visible to the user."
(chess-with-current-buffer display
(setq chess-display-no-popup t)))
-(defun chess-display-destroy (display)
- "Destroy a chess display object, killing all of its buffers."
- (let ((buf (or display (current-buffer))))
- (when (buffer-live-p buf)
- (chess-display-event-handler (chess-display-game nil)
- buf 'destroy)
- (with-current-buffer buf
- (remove-hook 'kill-buffer-hook 'chess-display-quit t))
- (kill-buffer buf))))
-
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Event handler
:type '(repeat symbol)
:group 'chess-display)
-(defun chess-display-event-handler (game display event &rest args)
+(defun chess-display-handler (game event &rest args)
"This display module presents a standard chessboard.
See `chess-display-type' for the different kinds of displays."
- (with-current-buffer display
+ (if (eq event 'initialize)
+ (progn
+ (chess-display-mode)
+ (setq chess-display-index (chess-game-index game)
+ chess-display-perspective perspective
+ chess-display-event-handler
+ (intern-soft (concat (symbol-name chess-display-style)
+ "-handler")))
+ (and chess-display-event-handler
+ (funcall chess-display-event-handler 'initialize)))
(cond
- ((eq event 'shutdown)
- (chess-display-destroy nil))
-
- ((eq event 'destroy)
- (chess-display-detach-game nil))
-
((eq event 'pass)
(let ((my-color (chess-game-data game 'my-color)))
(chess-game-set-data game 'my-color (not my-color))
(chess-display-set-perspective* nil (not my-color))))
((eq event 'orient)
- ;; Set the display's perspective to whichever color I'm
- ;; playing
- (chess-display-set-perspective*
- nil (chess-game-data game 'my-color))))
-
- (if (memq event '(orient update setup-game move resign))
- (chess-display-set-index* nil (chess-game-index game)))
+ ;; Set the display's perspective to whichever color I'm playing
+ (chess-display-set-perspective* nil (chess-game-data game '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))
(chess-display-update nil momentous)))))
"The mode map used in read-only display buffers.")
(defvar chess-display-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map)
- (set-keymap-parent map chess-display-safe-map)
-
+ (let ((map (copy-keymap chess-display-safe-map)))
(define-key map [? ] 'chess-display-pass)
(define-key map [??] 'describe-mode)
(define-key map [?@] 'chess-display-remote)
(define-key map [(control ?y)] 'chess-display-yank-board)
(dolist (key '(?a ?b ?c ?d ?e ?f ?g ?h
- ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8
- ?r ?n ?b ?q ?k ?o
- ?R ?N ?B ?Q ?K ?O))
+ ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8
+ ?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 [?x] 'ignore)
(define-key map [(control ?m)] 'chess-display-select-piece)
(define-key map [return] 'chess-display-select-piece)
(define-key map [(button1)] 'chess-display-mouse-select-piece)
(define-key map [(button2)] 'chess-display-mouse-select-piece))
(t
- (define-key map [mouse-1] 'chess-display-mouse-select-piece)
- (define-key map [mouse-2] 'chess-display-mouse-select-piece)))
+ (define-key map [down-mouse-1] 'chess-display-mouse-select-piece)
+ (define-key map [drag-mouse-1] 'chess-display-mouse-select-piece)
+
+ (define-key map [down-mouse-2] 'chess-display-mouse-select-piece)
+ (define-key map [drag-mouse-2] 'chess-display-mouse-select-piece)))
(define-key map [menu-bar files] 'undefined)
(define-key map [menu-bar edit] 'undefined)
["Next" chess-display-move-forward t]
["Last" chess-display-move-last t])))
-(defun chess-display-mode (&optional read-only)
+(defun chess-display-mode ()
"A mode for displaying and interacting with a chessboard.
-If READ-ONLY is non-nil, then no modifications are allowed.
The key bindings available in this mode are:
\\{chess-display-mode-map}"
(interactive)
(setq major-mode 'chess-display-mode mode-name "Chessboard")
- (if read-only
- (use-local-map chess-display-safe-map)
- (use-local-map chess-display-mode-map))
+ (use-local-map chess-display-mode-map)
(buffer-disable-undo)
(setq buffer-auto-save-file-name nil
mode-line-format 'chess-display-mode-line))
-(defun chess-display-set-modeline ()
+(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 ((color (chess-pos-side-to-move (chess-display-position nil)))
- (index (chess-display-index nil))
- ply)
- (if (null index)
- (setq chess-display-mode-line
- (if color " White to move" " Black to move"))
- (if (and index (= index 0))
- (setq chess-display-mode-line
- (format " %s START" (if color "White" "Black")))
- (cond
- (chess-display-ply
- (setq ply chess-display-ply))
- (chess-display-game
- (setq ply (chess-game-ply chess-display-game (1- index))))
- (chess-display-variation
- (setq ply (chess-var-ply chess-display-variation (1- index)))))
- (if ply
- (setq chess-display-mode-line
- (concat
- " "
- (let ((final (chess-ply-final-p ply)))
- (cond
- ((eq final :checkmate) "CHECKMATE")
- ((eq final :resign) "RESIGNED")
- ((eq final :stalemate) "STALEMATE")
- ((eq final :draw) "DRAWN")
- (t
- (if color "White" "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-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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(defsubst chess-display-active-p ()
"Return non-nil if the displayed chessboard reflects an active game.
Basically, it means we are playing, not editing or reviewing."
- (and chess-display-game
- (= (chess-display-index nil)
- (chess-game-index chess-display-game))
- (not (chess-game-over-p chess-display-game))
+ (and (= chess-display-index
+ (chess-game-index chess-module-game))
+ (not (chess-game-over-p chess-module-game))
(not chess-display-edit-mode)))
(defun chess-display-invert ()
"Send the current board configuration to the user."
(interactive "P")
(let ((x-select-enable-clipboard t))
- (if (and arg chess-display-game)
+ (if arg
(kill-new (with-temp-buffer
- (chess-game-to-pgn (chess-display-game nil))
+ (chess-game-to-pgn chess-module-game)
(buffer-string)))
(kill-new (chess-pos-to-fen (chess-display-position nil))))))
(delete-backward-char 1))
(goto-char (point-min))
(cond
- ((search-forward "[Event" nil t)
+ ((search-forward "[Event " nil t)
(goto-char (match-beginning 0))
(chess-display-copy-game display (chess-pgn-to-game)))
((looking-at (concat chess-algebraic-regexp "$"))
last-command-char)
(chess-display-update nil)))
-(defun chess-display-quit ()
- "Quit the current game."
- (interactive)
- (if (and chess-display-main-p
- chess-display-game)
- (chess-game-run-hooks chess-display-game 'shutdown)
- (chess-display-destroy nil)))
+(defalias 'chess-display-quit 'chess-module-destroy)
+
+(chess-message-catalog 'english
+ '((illegal-notation . "Illegal move notation: %s")))
(defun chess-display-manual-move (move)
"Move a piece manually, using chess notation."
(format "%s(%d): "
(if (chess-pos-side-to-move (chess-display-position nil))
"White" "Black")
- (1+ (/ (or (chess-display-index nil) 0) 2))))))
+ (1+ (/ (or chess-display-index 0) 2))))))
(let ((ply (chess-algebraic-to-ply (chess-display-position nil) move)))
(unless ply
- (error "Illegal move notation: %s" move))
+ (chess-error 'illegal-notation move))
(chess-display-move nil ply)))
(defun chess-display-remote (display)
"Pass the move to your opponent. Only valid on the first move."
(interactive)
(if (chess-display-active-p)
- (chess-game-run-hooks chess-display-game 'pass)
+ (chess-game-run-hooks chess-module-game 'pass)
(ding)))
(defun chess-display-shuffle ()
(interactive)
(require 'chess-random)
(if (and (chess-display-active-p)
- (= 0 (chess-display-index nil)))
- (chess-game-set-start-position chess-display-game
+ (= 0 chess-display-index))
+ (chess-game-set-start-position chess-module-game
(chess-fischer-random-position))
(ding)))
(defun chess-display-match ()
"Resign the current game."
- (chess-game-run-hooks chess-display-game 'match))
+ (chess-game-run-hooks chess-module-game 'match))
(defun chess-display-resign ()
"Resign the current game."
(interactive)
(if (chess-display-active-p)
(progn
- (chess-game-end (chess-display-game nil) :resign)
- (chess-game-run-hooks chess-display-game 'resign))
+ (chess-game-end chess-module-game :resign)
+ (chess-game-run-hooks chess-module-game 'resign))
(ding)))
(defun chess-display-abort ()
"Abort the current game."
(interactive)
(if (chess-display-active-p)
- (chess-game-run-hooks chess-display-game 'abort)
+ (chess-game-run-hooks chess-module-game 'abort)
(ding)))
+(chess-message-catalog 'english
+ '((draw-offer . "You offer a draw")))
+
(defun chess-display-draw ()
"Offer to draw the current game."
(interactive)
(if (chess-display-active-p)
(progn
- (message "You offer a draw")
- (chess-game-run-hooks chess-display-game 'draw))
+ (chess-message 'draw-offer)
+ (chess-game-run-hooks chess-module-game 'draw))
(ding)))
(defun chess-display-undo (count)
(setq count
(if count
(prefix-numeric-value count)
- (if (eq (chess-pos-side-to-move
- (chess-display-position nil))
- (chess-game-data chess-display-game 'my-color))
+ (if (eq (chess-pos-side-to-move (chess-display-position nil))
+ (chess-game-data chess-module-game 'my-color))
2 1)))
- (chess-game-run-hooks chess-display-game 'undo count))
+ (chess-game-run-hooks chess-module-game 'undo count))
(ding)))
(defun chess-display-list-buffers ()
"List all buffers related to this display's current game."
(interactive)
- (when chess-display-game
- (let ((buffer-list-func (symbol-function 'buffer-list)))
- (unwind-protect
- (let ((chess-game chess-display-game)
- (lb-command (lookup-key ctl-x-map [(control ?b)]))
- (ibuffer-maybe-show-regexps nil))
- (fset 'buffer-list
- (function
- (lambda ()
- (delq nil
- (mapcar (function
- (lambda (cell)
- (and (bufferp (cdr cell))
- (buffer-live-p (cdr cell))
- (cdr cell))))
- (chess-game-hooks chess-game))))))
- (call-interactively lb-command))
- (fset 'buffer-list buffer-list-func)))))
+ (let ((buffer-list-func (symbol-function 'buffer-list)))
+ (unwind-protect
+ (let ((chess-game chess-module-game)
+ (lb-command (lookup-key ctl-x-map [(control ?b)]))
+ (ibuffer-maybe-show-regexps nil))
+ (fset 'buffer-list
+ (function
+ (lambda ()
+ (delq nil
+ (mapcar (function
+ (lambda (cell)
+ (and (bufferp (cdr cell))
+ (buffer-live-p (cdr cell))
+ (cdr cell))))
+ (chess-game-hooks chess-game))))))
+ (call-interactively lb-command))
+ (fset 'buffer-list buffer-list-func))))
+
+(chess-message-catalog 'english
+ '((return-to-current . "Use '>' to return to the current position")))
(defun chess-display-set-current (dir)
"Change the currently displayed board.
((eq dir t) nil)
((eq dir nil) 0))))
(chess-display-set-index
- nil (or index
- (if chess-display-game
- (chess-game-index chess-display-game)
- (chess-var-index chess-display-variation))))
+ nil (or index (chess-game-index chess-module-game)))
(unless (chess-display-active-p)
- (message "Use '>' to return to the current position"))))
+ (chess-message 'return-to-current))))
(defun chess-display-move-backward ()
(interactive)
- (if chess-display-index
- (chess-display-set-current ?-)))
+ (chess-display-set-current ?-))
(defun chess-display-move-forward ()
(interactive)
- (if chess-display-index
- (chess-display-set-current ?+)))
+ (chess-display-set-current ?+))
(defun chess-display-move-first ()
(interactive)
- (if chess-display-index
- (chess-display-set-current nil)))
+ (chess-display-set-current nil))
(defun chess-display-move-last ()
(interactive)
- (if chess-display-index
- (chess-display-set-current t)))
+ (chess-display-set-current t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
map)
"The mode map used for editing a chessboard position.")
+(chess-message-catalog 'english
+ '((editing-directly
+ . "Now editing position directly, use S when complete...")))
+
(defun chess-display-edit-board ()
"Setup the current board for editing."
(interactive)
;; for which purpose the movement keys can still be used.
(chess-display-set-position nil (chess-display-position nil))
;; jww (2002-03-28): setup edit-mode keymap here
- (message "Now editing position directly, use S when complete..."))
+ (chess-message 'editing-directly))
(defun chess-display-send-board ()
"Send the current board configuration to the user."
(interactive)
- (if chess-display-game
- (chess-game-set-start-position chess-display-game
- (chess-display-position nil)))
+ (chess-game-set-start-position chess-module-game
+ (chess-display-position nil))
(setq chess-display-edit-mode nil))
(defun chess-display-restore-board ()
(make-variable-buffer-local 'chess-legal-moves-pos)
(make-variable-buffer-local 'chess-legal-moves)
-(defun chess-keyboard-test-move (move)
+(chess-message-catalog 'english
+ '((not-your-move . "It is not your turn to move")
+ (game-is-over . "This game is over")))
+
+(defun chess-display-assert-can-move ()
+ (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-keyboard-test-move (move-ply)
"Return the given MOVE if it matches the user's current input."
- (let ((i 0) (x 0)
- (l (length move))
- (xl (length chess-move-string))
- (match t))
+ (let* ((move (cdr move-ply))
+ (i 0) (x 0) (l (length move))
+ (xl (length chess-move-string))
+ (match t))
(unless (or (and (equal (downcase chess-move-string) "ok")
- (equal move "O-O"))
+ (string-match "\\`O-O[+#]\\'" move))
(and (equal (downcase chess-move-string) "oq")
- (equal move "O-O-O")))
+ (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)))
- (if (= move-char ?x)
- (setq i (1+ i)))
- (if (/= entry-char (if (< entry-char ?a)
- move-char
- (downcase move-char)))
- (setq match nil i l)
- (setq i (1+ i) x (1+ x))))))
- (if match move)))
+ (if (and (= move-char ?x)
+ (/= entry-char ?x))
+ (setq i (1+ i))
+ (if (/= entry-char (if (< entry-char ?a)
+ move-char
+ (downcase move-char)))
+ (setq match nil i l)
+ (setq i (1+ i) x (1+ x)))))))
+ (if match
+ move-ply)))
(defsubst chess-keyboard-display-moves (&optional move-list)
(if (> (length chess-move-string) 0)
(message "[%s] %s" chess-move-string
- (mapconcat 'identity
+ (mapconcat 'cdr
(or move-list
(delq nil (mapcar 'chess-keyboard-test-move
- chess-legal-moves))) " "))))
+ (cdr chess-legal-moves))))
+ " "))))
(defun chess-keyboard-shortcut-delete ()
(interactive)
(when (and chess-move-string
(stringp chess-move-string)
- (> (length chess-move-string) 1))
+ (> (length chess-move-string) 0))
(setq chess-move-string
(substring chess-move-string 0 (1- (length chess-move-string))))
(chess-keyboard-display-moves)))
(defun chess-keyboard-shortcut (&optional display-only)
(interactive)
- (unless (memq last-command '(chess-keyboard-shortcut
- chess-keyboard-shortcut-delete))
- (setq chess-move-string nil))
- (unless display-only
- (setq chess-move-string
- (concat chess-move-string (char-to-string last-command-char))))
- (let ((position (chess-display-position nil)))
+ (let* ((position (chess-display-position nil))
+ (color (chess-pos-side-to-move position))
+ char)
+ (chess-display-assert-can-move)
+ (unless (memq last-command '(chess-keyboard-shortcut
+ chess-keyboard-shortcut-delete))
+ (setq chess-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))
- (setq chess-legal-moves-pos position
+ (eq position chess-legal-moves-pos)
+ (or (> (length chess-move-string) 1)
+ (eq (car chess-legal-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
- (sort (mapcar 'chess-ply-to-algebraic (chess-legal-plies position))
- 'string-lessp)))
- (let ((moves (delq nil (mapcar 'chess-keyboard-test-move
- chess-legal-moves))))
- (cond
- ((= (length moves) 1)
- (chess-display-manual-move (car moves))
- (setq chess-move-string nil
- chess-legal-moves nil
- chess-legal-moves-pos nil))
- ((null moves)
- (chess-keyboard-shortcut-delete))
- (t
- (chess-keyboard-display-moves moves))))))
+ (cons char
+ (sort
+ (mapcar
+ (function
+ (lambda (ply)
+ (cons ply (chess-ply-to-algebraic ply))))
+ (if (eq char ?b)
+ (append (chess-legal-plies
+ position :piece (if color ?P ?p) :file 1)
+ (chess-legal-plies
+ position :piece (if color ?B ?b)))
+ (if (and (>= char ?a)
+ (<= char ?h))
+ (chess-legal-plies position
+ :piece (if color ?P ?p)
+ :file (- char ?a))
+ (chess-legal-plies position
+ :piece (if color
+ (upcase char)
+ (downcase char))))))
+ (function
+ (lambda (left right)
+ (string-lessp (cdr left) (cdr right)))))))))
+ (let ((moves (delq nil (mapcar 'chess-keyboard-test-move
+ (cdr chess-legal-moves)))))
+ (cond
+ ((or (= (length moves) 1)
+ ;; if there is an exact match except for case, it must be an
+ ;; abiguity between a bishop and a b-pawn move. In this
+ ;; case, always take the b-pawn move; to select the bishop
+ ;; move, use B to begin the keyboard shortcut
+ (and (= (length moves) 2)
+ (string= (downcase (cdr (car moves)))
+ (downcase (cdr (cadr moves))))
+ (setq moves (cdr moves))))
+ (chess-display-move nil (caar moves))
+ (setq chess-move-string nil
+ chess-legal-moves nil
+ chess-legal-moves-pos nil))
+ ((null moves)
+ (chess-keyboard-shortcut-delete))
+ (t
+ (chess-keyboard-display-moves moves)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
(make-variable-buffer-local 'chess-display-last-selected)
+(chess-message-catalog 'english
+ '((cannot-mount . "You cannot move pieces on top of each other")
+ (move-not-legal . "That is not a legal move")
+ (wrong-color . "You cannot move your opponent's pieces")
+ (selected-empty . "You cannot select an empty square")
+ (piece-immobile . "That piece cannot move now")))
+
(defun chess-display-select-piece ()
"Select the piece under the cursor.
Clicking once on a piece selects it; then click on the target location."
(interactive)
(let ((coord (get-text-property (point) 'chess-coord))
- (position (chess-display-position nil)))
+ (position (chess-display-position nil))
+ message)
(when coord
- (condition-case err
- (if chess-display-last-selected
- (let ((last-sel chess-display-last-selected))
- ;; if they select the same square again, just deselect it
- (if (= (point) (car last-sel))
- (error "")
- (let ((s-piece (chess-pos-piece position (cadr last-sel)))
- (t-piece (chess-pos-piece position coord)) ply)
- (if (and (/= t-piece ? )
- (or (and (< t-piece ?a)
- (< s-piece ?a))
- (and (> t-piece ?a)
- (> s-piece ?a))))
- (error "You cannot move pieces on top of each other"))
- (unless (setq ply (chess-ply-create position
- (cadr last-sel) coord))
- (error "That is not a legal move"))
- (chess-display-move nil ply)))
- (setq chess-display-last-selected nil))
- (let ((piece (chess-pos-piece position coord)))
- (cond
- ((and (chess-display-active-p)
- ;; `active' means we're playing somebody via an
- ;; engine
- (chess-game-data chess-display-game 'active)
- (not (eq (chess-game-data chess-display-game
- 'my-color)
- (chess-pos-side-to-move position))))
- (error "It is not your turn to move"))
- ((eq piece ? )
- (error "You cannot select an empty square"))
- ((if (chess-pos-side-to-move position)
- (> piece ?a)
- (< piece ?a))
- (error "You cannot move your opponent's pieces")))
- (setq chess-display-last-selected (list (point) coord))
- (chess-display-highlight nil coord 'selected)))
- (error
- (setq chess-display-last-selected nil)
- (chess-display-update nil)
- (message (error-message-string err)))))))
+ (setq message
+ (catch 'message
+ (if chess-display-last-selected
+ (let ((last-sel chess-display-last-selected))
+ ;; if they select the same square again, just deselect
+ ;; it by redrawing the display and removing all
+ ;; highlights
+ (if (= (point) (car last-sel))
+ (chess-display-update nil)
+ (let ((s-piece (chess-pos-piece position
+ (cadr last-sel)))
+ (t-piece (chess-pos-piece position coord)) ply)
+ (if (and (/= t-piece ? )
+ (or (and (< t-piece ?a)
+ (< s-piece ?a))
+ (and (> t-piece ?a)
+ (> s-piece ?a))))
+ (throw 'message (chess-string 'cannot-mount)))
+ (unless (setq ply (chess-ply-create position
+ (cadr last-sel) coord))
+ (throw 'message (chess-string 'move-not-legal)))
+ (chess-display-move nil ply)))
+ (setq chess-display-last-selected nil))
+ (chess-display-assert-can-move)
+ (let ((piece (chess-pos-piece position coord)))
+ (cond
+ ((eq piece ? )
+ (throw 'message (chess-string 'selected-empty)))
+ ((if (chess-pos-side-to-move position)
+ (> piece ?a)
+ (< piece ?a))
+ (throw 'message (chess-string 'wrong-color)))
+ ((and chess-display-highlight-legal
+ (null (chess-legal-plies position :any :index coord)))
+ (throw 'message (chess-string 'piece-immobile))))
+ (setq chess-display-last-selected (list (point) coord))
+ (chess-display-highlight nil coord)
+ (if chess-display-highlight-legal
+ (chess-display-highlight-legal nil coord))))))
+ (when message
+ (setq chess-display-last-selected nil)
+ (chess-display-update nil)
+ (error message)))))
(defun chess-display-mouse-select-piece (event)
"Select the piece the user clicked on."
(interactive "e")
- (cond ((fboundp 'event-window) ; XEmacs
- (set-buffer (window-buffer (event-window event)))
- (and (event-point event) (goto-char (event-point event))))
- ((fboundp 'posn-window) ; Emacs
- (set-buffer (window-buffer (posn-window (event-start event))))
- (goto-char (posn-point (event-start event)))))
- (chess-display-select-piece))
+ (if (fboundp 'event-window) ; XEmacs
+ (progn
+ (set-buffer (window-buffer (event-window event)))
+ (and (event-point event) (goto-char (event-point event))))
+ (if (equal (event-start event) (event-end event))
+ (progn
+ (set-buffer (window-buffer (posn-window (event-start event))))
+ (goto-char (posn-point (event-start event)))
+ (chess-display-select-piece))
+ (goto-char (posn-point (event-end event)))
+ (chess-display-select-piece))))
(provide 'chess-display)