code.delx.au - gnu-emacs-elpa/blob - chess-display.el

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Code shared by all chess displays
   4 ;;
   5 ;; $Revision$
   6
   7 ;;; Code:
   8
   9 (require 'chess-session)
  10 (require 'chess-game)
  11 (require 'chess-algebraic)
  12 (require 'chess-fen)
  13
  14 (defgroup chess-display nil
  15   "Common code used by chess displays."
  16   :group 'chess)
  17
  18 (defcustom chess-display-use-faces t
  19   "If non-nil, provide colored faces for ASCII displays."
  20   :type 'boolean
  21   :group 'chess-display)
  22
  23 (defface chess-display-black-face
  24   '((((class color) (background light)) (:foreground "Green"))
  25     (((class color) (background dark)) (:foreground "Green"))
  26     (t (:bold t)))
  27   "*The face used for black pieces on the ASCII display."
  28   :group 'chess-display)
  29
  30 (defface chess-display-white-face
  31   '((((class color) (background light)) (:foreground "Yellow"))
  32     (((class color) (background dark)) (:foreground "Yellow"))
  33     (t (:bold t)))
  34   "*The face used for white pieces on the ASCII display."
  35   :group 'chess-display)
  36
  37 (defface chess-display-highlight-face
  38   '((((class color) (background light)) (:background "#add8e6"))
  39     (((class color) (background dark)) (:background "#add8e6")))
  40   "Face to use for highlighting pieces that have been selected."
  41   :group 'chess-display)
  42
  43 ;;; Code:
  44
  45 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  46 ;;
  47 ;; User interface
  48 ;;
  49
  50 (defvar chess-display-game)
  51 (defvar chess-display-search-function)
  52 (defvar chess-display-variation)
  53 (defvar chess-display-index)
  54 (defvar chess-display-ply)
  55 (defvar chess-display-position)
  56 (defvar chess-display-perspective)
  57 (defvar chess-display-draw-function nil)
  58 (defvar chess-display-highlight-function nil)
  59 (defvar chess-display-mode-line "")
  60
  61 (make-variable-buffer-local 'chess-display-game)
  62 (make-variable-buffer-local 'chess-display-search-function)
  63 (make-variable-buffer-local 'chess-display-variation)
  64 (make-variable-buffer-local 'chess-display-index)
  65 (make-variable-buffer-local 'chess-display-ply)
  66 (make-variable-buffer-local 'chess-display-position)
  67 (make-variable-buffer-local 'chess-display-perspective)
  68 (make-variable-buffer-local 'chess-display-draw-function)
  69 (make-variable-buffer-local 'chess-display-highlight-function)
  70 (make-variable-buffer-local 'chess-display-mode-line)
  71
  72 (defmacro chess-with-current-buffer (buffer &rest body)
  73   `(if buffer
  74        (with-current-buffer buffer
  75          ,@body)
  76      ,@body))
  77
  78 (defun chess-display-create (style perspective &optional search-func)
  79   "Create a chess display, for displaying chess objects."
  80   (let ((draw (intern-soft (concat (symbol-name style) "-draw")))
  81         (highlight (intern-soft (concat (symbol-name style) "-highlight"))))
  82     (with-current-buffer (generate-new-buffer "*Chessboard*")
  83       (setq cursor-type nil
  84             chess-display-draw-function draw
  85             chess-display-highlight-function highlight
  86             chess-display-perspective perspective
  87             chess-display-search-function search-func)
  88       (chess-display-mode)
  89       (current-buffer))))
  90
  91 (defsubst chess-display-destroy (display)
  92   "Destroy a chess display object, killing all of its buffers."
  93     (if (buffer-live-p display)
  94         (kill-buffer display)))
  95
  96 (defsubst chess-display-perspective (display)
  97   (chess-with-current-buffer display
  98     chess-display-perspective))
  99
 100 (defun chess-display-set-perspective (display perspective)
 101   (chess-with-current-buffer display
 102     (setq chess-display-perspective perspective)
 103     (chess-display-update nil)))
 104
 105 (defun chess-display-set-search-function (display search-func)
 106   (chess-with-current-buffer display
 107     (if chess-display-game
 108         (error "Cannot alter a display's search function when viewing a game")
 109       (setq chess-display-search-function search-func))))
 110
 111 (defun chess-display-search-function (display)
 112   (chess-with-current-buffer display
 113     (if chess-display-game
 114         (chess-game-search-function chess-display-game)
 115       (or chess-display-search-function
 116           'chess-standard-search-position))))
 117
 118 (defsubst chess-display-search-position (display position target piece)
 119   (chess-with-current-buffer display
 120     (funcall (chess-display-search-function nil)
 121              position target piece)))
 122
 123 (defun chess-display-set-position (display position &optional search-func)
 124   "Set the display position.
 125 Note that when a single position is being displayed, out of context of
 126 a game, the user's move will cause a new variation to be created,
 127 without a game object.
 128 If the position is merely edited, it will change the POSITION object
 129 that was passed in."
 130   (chess-with-current-buffer display
 131     (setq chess-display-game nil
 132           chess-display-search-function search-func
 133           chess-display-variation nil
 134           chess-display-index nil
 135           chess-display-ply nil
 136           chess-display-position position)
 137     (chess-display-update nil)))
 138
 139 (defun chess-display-position (display)
 140   "Return the position currently viewed."
 141   (chess-with-current-buffer display
 142     (or (and chess-display-game
 143              (chess-game-pos chess-display-game chess-display-index))
 144         (and chess-display-variation
 145              (chess-ply-next-pos
 146               (nth chess-display-index chess-display-variation)))
 147         (and chess-display-ply
 148              (chess-ply-next-pos chess-display-ply))
 149         chess-display-position)))
 150
 151 (defun chess-display-set-ply (display ply &optional search-func)
 152   "Set the display ply.
 153 This differs from a position display, only in that the algebraic form
 154 of the move made to the reach the displayed position will be shown in
 155 the modeline."
 156   (chess-with-current-buffer display
 157     (setq chess-display-game nil
 158           chess-display-search-function search-func
 159           chess-display-variation nil
 160           chess-display-index nil
 161           chess-display-ply ply
 162           chess-display-position nil)
 163     (chess-display-update display)))
 164
 165 (defun chess-display-ply (display)
 166   (chess-with-current-buffer display
 167     (or (and chess-display-game
 168              (chess-game-ply chess-display-game chess-display-index))
 169         (and chess-display-variation
 170              (nth chess-display-index chess-display-variation))
 171         chess-display-ply)))
 172
 173 (defun chess-display-set-variation (display plies &optional index search-func)
 174   "Set the display variation.
 175 This will cause the first ply in the variation to be displayed, with
 176 the user able to scroll back and forth through the moves in the
 177 variation.  Any moves made on the board will extend/change the
 178 variation that was passed in."
 179   (chess-with-current-buffer display
 180     (setq chess-display-game nil
 181           chess-display-search-function search-func
 182           chess-display-variation plies
 183           chess-display-index (or index 0)
 184           chess-display-ply nil
 185           chess-display-position nil)
 186     (chess-display-update nil)))
 187
 188 (defun chess-display-variation (display)
 189   (chess-with-current-buffer display
 190     (or (and chess-display-game
 191              (chess-game-plies chess-display-game))
 192         chess-display-variation)))
 193
 194 (defun chess-display-set-game (display game &optional index)
 195   "Set the display game.
 196 This will cause the first ply in the game's main variation to be
 197 displayed.  Also, information about the game is shown in the
 198 modeline."
 199   (chess-with-current-buffer display
 200     (setq chess-display-game game
 201           chess-display-search-function nil
 202           chess-display-variation nil
 203           chess-display-index (or index 0)
 204           chess-display-ply nil
 205           chess-display-position nil)
 206     (chess-display-update nil)))
 207
 208 (defsubst chess-display-game (display)
 209   (chess-with-current-buffer display
 210     chess-display-game))
 211
 212 (defun chess-display-set-index (display index)
 213   (chess-with-current-buffer display
 214     (unless chess-display-index
 215       (error "There is no game or variation currently being displayed."))
 216     (if chess-display-game
 217         (unless (chess-game-pos chess-display-game index)
 218           (error "There is no position in the displayed game at index %d."
 219                  index))
 220       (if (or (not (integerp index))
 221               (< index 0)
 222               (>= index (length chess-display-variation)))
 223           (error "There is no position in the display variation at index %d."
 224                  index)))
 225     (setq chess-display-index index)
 226     (chess-display-update nil)))
 227
 228 (defsubst chess-display-index (display)
 229   (chess-with-current-buffer display
 230     chess-display-index))
 231
 232 (defun chess-display-update (display)
 233   "This should be called if any object passed in has been changed.
 234 That is, if you call `chess-display-set-position', and then later
 235 change that position object, the display can be updated by calling
 236 `chess-display-update'."
 237   (chess-with-current-buffer display
 238     (if chess-display-draw-function
 239         (funcall chess-display-draw-function
 240                  (chess-display-position nil)
 241                  chess-display-perspective))
 242     (chess-display-set-modeline)))
 243
 244 (defun chess-display-move (display start &optional target)
 245   "Move a piece on DISPLAY from START to TARGET.
 246 If only START is given, it must be in algebraic move notation."
 247   (chess-with-current-buffer display
 248     ;; jww (2002-03-28): how is this going to handle castling?  There
 249     ;; needs to be a way to "flesh" out a move using the standard
 250     ;; search function.
 251     (let ((ply (if (null target)
 252                    (chess-algebraic-to-ply
 253                     (chess-display-position nil) start
 254                     (chess-display-search-function nil))
 255                  (chess-ply-create (chess-display-position nil)
 256                                    start target))))
 257       (cond
 258        ((chess-display-active-p)
 259         (chess-session-event chess-current-session 'move ply))
 260        (chess-display-game
 261         ;; jww (2002-03-28): This should beget a variation, or alter
 262         ;; the game, just as SCID allows
 263         (unless (= (chess-display-index nil)
 264                    (chess-game-index chess-display-game))
 265           (error "Cannot move partway in a game"))
 266         (chess-game-move chess-display-game ply))
 267        (chess-display-variation
 268         (nconc chess-display-variation (list ply)))
 269        (chess-display-ply
 270         (setq chess-display-ply ply))
 271        (t                               ; an ordinary position
 272         (setq chess-display-position (chess-ply-next-pos ply)))))
 273     (chess-display-update nil)))
 274
 275 (defun chess-display-highlight (display index &optional mode)
 276   "Highlight the square at INDEX on the current position.
 277 The given highlighting MODE is used, or the default if the style you
 278 are displaying with doesn't support that mode.  `selected' is a mode
 279 that is supported by most displays, and is the default mode."
 280   (chess-with-current-buffer display
 281     (if (chess-display-active-p)
 282         (chess-session-event chess-current-session 'highlight
 283                              index (or mode 'selected))
 284       (if chess-display-highlight-function
 285           (funcall chess-display-highlight-function index
 286                    (or mode 'selected)))))
 287
 288 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 289 ;;
 290 ;; Module method
 291 ;;
 292
 293 ;;;###autoload
 294 (defun chess-display (session display event &rest args)
 295   "This display module presents a standard chessboard.
 296 See `chess-display-type' for the different kinds of displays."
 297   (if (eq event 'initialize)
 298       (chess-display-create (car args)
 299                             (chess-session-data session 'my-color))
 300     (ignore
 301      (cond
 302       ((eq event 'shutdown)
 303        (chess-display-destroy display))
 304
 305       ((eq event 'setup)
 306        (chess-display-set-game display (car args)))
 307
 308       ((eq event 'highlight)
 309        ;; calling `chess-display-highlight' would be recursive
 310        (if chess-display-highlight-function
 311            (funcall chess-display-highlight-function
 312                     (car args) (cadr args))))
 313
 314       (t
 315        (chess-display-update display))))))
 316
 317 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 318 ;;
 319 ;; chess-display-mode
 320 ;;
 321
 322 (defvar chess-display-mode-map
 323   (let ((map (make-keymap)))
 324     (suppress-keymap map)
 325     (set-keymap-parent map nil)
 326
 327     (define-key map [(control ?i)] 'chess-display-invert)
 328     (define-key map [tab] 'chess-display-invert)
 329
 330     (define-key map [??] 'describe-mode)
 331     (define-key map [?C] 'chess-display-clear-board)
 332     (define-key map [?E] 'chess-display-edit-board)
 333     (define-key map [?F] 'chess-display-set-from-fen)
 334     (define-key map [?I] 'chess-display-invert)
 335     (define-key map [?X] 'chess-display-quit)
 336     (define-key map [?M] 'chess-display-manual-move)
 337
 338     (define-key map [?<] 'chess-display-move-backward)
 339     (define-key map [?,] 'chess-display-move-backward)
 340     (define-key map [(meta ?<)] 'chess-display-move-first)
 341     (define-key map [?>] 'chess-display-move-forward)
 342     (define-key map [?.] 'chess-display-move-forward)
 343     (define-key map [(meta ?>)] 'chess-display-move-last)
 344
 345     (define-key map [(meta ?w)] 'chess-display-copy-board)
 346     (define-key map [(control ?y)] 'chess-display-paste-board)
 347
 348     (define-key map [(control ?l)] 'chess-display-redraw)
 349
 350     (dolist (key '(?a ?b ?c ?d ?e ?f ?g ?h
 351                       ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8
 352                       ?r ?n ?b ?q ?k ?o))
 353       (define-key map (vector key) 'chess-keyboard-shortcut))
 354     (define-key map [backspace] 'chess-keyboard-shortcut-delete)
 355
 356     (define-key map [(control ?m)] 'chess-display-select-piece)
 357     (define-key map [return] 'chess-display-select-piece)
 358     (cond
 359      ((featurep 'xemacs)
 360       (define-key map [(button1)] 'chess-display-mouse-select-piece)
 361       (define-key map [(button2)] 'chess-display-mouse-select-piece))
 362      (t
 363       (define-key map [mouse-1] 'chess-display-mouse-select-piece)
 364       (define-key map [mouse-2] 'chess-display-mouse-select-piece)))
 365     map)
 366   "The mode map used in a chessboard display buffer.")
 367
 368 (defun chess-display-redraw ()
 369   "Just redraw the current display."
 370   (interactive)
 371   (chess-display-update nil))
 372
 373 (defun chess-display-mode ()
 374   "A mode for displaying and interacting with a chessboard.
 375 The key bindings available in this mode are:
 376 \\{chess-display-mode-map}"
 377   (interactive)
 378   (setq major-mode 'chess-display-mode mode-name "Chessboard")
 379   (use-local-map chess-display-mode-map)
 380   (buffer-disable-undo)
 381   (setq buffer-auto-save-file-name nil
 382         mode-line-format 'chess-display-mode-line))
 383
 384 (defun chess-display-set-modeline ()
 385   "Set the modeline to reflect the current game position."
 386   (let ((ply (chess-display-ply nil))
 387         (color (chess-pos-side-to-move (chess-display-position nil)))
 388         (index (chess-display-index nil)))
 389     (if (and index (= index 1))
 390         (setq chess-display-mode-line
 391               (format "   %s   START" (if color "White" "BLACK")))
 392       (setq chess-display-mode-line
 393             (concat
 394              "  " (if color "White" "BLACK")
 395              (if index
 396                  (concat "   " (int-to-string
 397                                 (if (> index 1)
 398                                     (/ index 2) (1+ (/ index 2))))))
 399              (if ply
 400                  (concat ". " (if color "... ")
 401                          (chess-ply-to-algebraic
 402                           ply (chess-display-search-function nil)))))))))
 403
 404 (defsubst chess-display-active-p ()
 405   "Return non-nil if the displayed chessboard reflects an active game.
 406 Basically, it means we are not editing or reviewing.
 407 The game must be part of an active session (i.e., not just reviewing a
 408 game object), and the board must represent the current position in
 409 that game (i.e., not editing the position, or reviewing an earlier
 410 position within the game)."
 411   (and chess-current-session
 412        chess-display-game
 413        (= (chess-display index nil)
 414           (chess-game-index chess-display-game))
 415        (not chess-display-edit-mode)))
 416
 417 (defun chess-display-invert ()
 418   "Invert the perspective of the current chess board."
 419   (interactive)
 420   (chess-display-set-perspective nil (not (chess-display-perspective nil))))
 421
 422 (defun chess-display-set-from-fen (fen)
 423   "Send the current board configuration to the user."
 424   (interactive "sSet from FEN string: ")
 425   (chess-display-set-position nil (chess-fen-to-pos fen)))
 426
 427 (defun chess-display-copy-board ()
 428   "Send the current board configuration to the user."
 429   (interactive)
 430   (let* ((x-select-enable-clipboard t)
 431          (fen (chess-fen-from-pos (chess-display-position nil))))
 432     (kill-new fen)
 433     (message "Copied board: %s" fen)))
 434
 435 (defun chess-display-paste-board ()
 436   "Send the current board configuration to the user."
 437   (interactive)
 438   (let* ((x-select-enable-clipboard t)
 439          (fen (current-kill 0)))
 440     ;; jww (2001-06-26): not yet implemented
 441     (message "Pasted board: %s" fen)))
 442
 443 (defun chess-display-set-piece ()
 444   "Set the piece under point to command character, or space for clear."
 445   (interactive)
 446   (unless (chess-display-active-p)
 447     (chess-pos-set-piece (chess-display-position nil)
 448                          (get-text-property (point) 'chess-coord)
 449                          last-command-char)
 450     (chess-display-update nil)))
 451
 452 (defun chess-display-quit ()
 453   "Quit the current game."
 454   (interactive)
 455   (if (chess-display-active-p)
 456       (chess-session-event chess-current-session 'shutdown)
 457     (chess-display-destroy nil)))
 458
 459 (defun chess-display-manual-move (move)
 460   "Move a piece manually, using chess notation."
 461   (interactive
 462    (list (read-string
 463           (format "%s(%d): "
 464                   (if (chess-pos-side-to-move (chess-display-position nil))
 465                       "White" "Black")
 466                   (1+ (/ (or (chess-display-index nil) 0) 2))))))
 467   (chess-display-move nil move))
 468
 469 (defun chess-display-set-current (dir)
 470   "Change the currently displayed board.
 471 Direction may be - or +, to move forward or back, or t or nil to jump
 472 to the end or beginning."
 473   (let ((index (cond ((eq dir ?-) (1- chess-display-index))
 474                      ((eq dir ?+) (1+ chess-display-index))
 475                      ((eq dir t) nil)
 476                      ((eq dir nil) 0))))
 477     (chess-display-set-index
 478      nil (or index
 479              (if chess-display-game
 480                  (chess-game-index chess-display-game)
 481                (1- (length chess-display-variation)))))
 482     (message "Use '>' to return to the current position")))
 483
 484 (defun chess-display-move-backward ()
 485   (interactive)
 486   (if chess-display-index
 487       (chess-display-set-current ?-)))
 488
 489 (defun chess-display-move-forward ()
 490   (interactive)
 491   (if chess-display-index
 492       (chess-display-set-current ?+)))
 493
 494 (defun chess-display-move-first ()
 495   (interactive)
 496   (if chess-display-index
 497       (chess-display-set-current nil)))
 498
 499 (defun chess-display-move-last ()
 500   (interactive)
 501   (if chess-display-index
 502       (chess-display-set-current t)))
 503
 504 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 505 ;;
 506 ;; chess-display-edit-mode (for editing the position directly)
 507 ;;
 508
 509 (defvar chess-display-edit-mode-map
 510   (let ((map (make-keymap)))
 511     (suppress-keymap map)
 512     (set-keymap-parent map chess-display-mode-map)
 513
 514     (define-key map [?C] 'chess-display-clear-board)
 515     (define-key map [?G] 'chess-display-restore-board)
 516     (define-key map [?S] 'chess-display-send-board)
 517
 518     (let ((keys '(?  ?p ?r ?n ?b ?q ?k ?P ?R ?N ?B ?Q ?K)))
 519       (while keys
 520         (define-key map (vector (car keys)) 'chess-display-set-piece)
 521         (setq keys (cdr keys))))
 522     map)
 523   "The mode map used for editing a chessboard position.")
 524
 525 (defun chess-display-edit-board ()
 526   "Setup the current board for editing."
 527   (interactive)
 528   (setq cursor-type t
 529         chess-display-edit-mode t)
 530   ;; Take us out of any game/ply/variation we might be looking at,
 531   ;; since we are not moving pieces now, but rather placing them --
 532   ;; for which purpose the movement keys can still be used.
 533   (chess-display-set-position nil (chess-display-position nil))
 534   ;; jww (2002-03-28): setup edit-mode keymap here
 535   (message "Now editing position directly, use S when complete..."))
 536
 537 (defun chess-display-send-board ()
 538   "Send the current board configuration to the user."
 539   (interactive)
 540   (if chess-current-session
 541       (chess-session-event chess-current-session 'setup
 542                            (chess-game-create (chess-display-position nil))))
 543   (setq cursor-type nil
 544         chess-display-edit-mode nil))
 545
 546 (defun chess-display-restore-board ()
 547   "Setup the current board for editing."
 548   (interactive)
 549   (setq cursor-type nil
 550         chess-display-edit-mode nil)
 551   ;; jww (2002-03-28): NYI
 552   (chess-display-update nil))
 553
 554 (defun chess-display-clear-board ()
 555   "Setup the current board for editing."
 556   (interactive)
 557   (when (y-or-n-p "Really clear the chessboard? ")
 558     (let ((position (chess-display-position nil)))
 559       (dotimes (rank 8)
 560         (dotimes (file 8)
 561           (chess-pos-set-piece position (cons rank file) ? ))))
 562     (chess-display-update nil)))
 563
 564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 565 ;;
 566 ;; Allow for quick entry of algebraic moves via keyboard
 567 ;;
 568
 569 (defvar chess-move-string nil)
 570 (defvar chess-legal-moves-pos nil)
 571 (defvar chess-legal-moves nil)
 572
 573 (make-variable-buffer-local 'chess-move-string)
 574 (make-variable-buffer-local 'chess-legal-moves-pos)
 575 (make-variable-buffer-local 'chess-legal-moves)
 576
 577 (defun chess-keyboard-shortcut-delete ()
 578   (interactive)
 579   (setq chess-move-string
 580         (substring chess-move-string 0
 581                    (1- (length chess-move-string)))))
 582
 583 (defun chess-keyboard-shortcut (&optional display-only)
 584   (interactive)
 585   (unless (memq last-command '(chess-keyboard-shortcut
 586                                chess-keyboard-shortcut-delete))
 587     (setq chess-move-string nil))
 588   (unless display-only
 589     (setq chess-move-string
 590           (concat chess-move-string
 591                   (char-to-string (downcase last-command-char)))))
 592   (let ((position (chess-display-position nil))
 593         (search-func (chess-display-search-function nil)))
 594     (unless (and chess-legal-moves
 595                  (eq position chess-legal-moves-pos))
 596       (setq chess-legal-moves-pos position
 597             chess-legal-moves
 598             (sort (mapcar (function
 599                            (lambda (ply)
 600                              (chess-ply-to-algebraic ply nil search-func)))
 601                           (chess-legal-plies position search-func))
 602                   'string-lessp)))
 603     (let ((moves (mapcar
 604                   (function
 605                    (lambda (move)
 606                      (let ((i 0) (x 0)
 607                            (l (length move))
 608                            (xl (length chess-move-string))
 609                            (match t))
 610                        (unless (or (and (equal chess-move-string "ok")
 611                                         (equal move "O-O"))
 612                                    (and (equal chess-move-string "oq")
 613                                         (equal move "O-O-O")))
 614                          (while (and (< i l) (< x xl))
 615                            (if (= (aref move i) ?x)
 616                                (setq i (1+ i)))
 617                            (if (/= (downcase (aref move i))
 618                                    (aref chess-move-string x))
 619                                (setq match nil i l)
 620                              (setq i (1+ i) x (1+ x)))))
 621                        (if match move))))
 622                   chess-legal-moves)))
 623       (setq moves (delq nil moves))
 624       (cond
 625        ((= (length moves) 1)
 626         (chess-display-move nil (car moves))
 627         (setq chess-move-string nil
 628               chess-legal-moves nil
 629               chess-legal-moves-pos nil))
 630        ((null moves)
 631         (chess-keyboard-shortcut-delete))
 632        (t
 633         (message "[%s] %s" chess-move-string
 634                  (mapconcat 'identity moves " ")))))))
 635
 636 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 637 ;;
 638 ;; Manage a face cache for textual displays
 639 ;;
 640
 641 (defvar chess-display-face-cache '((t . t)))
 642
 643 (defsubst chess-display-get-face (color)
 644   (or (cdr (assoc color chess-display-face-cache))
 645       (let ((face (make-face 'chess-display-highlight)))
 646         (set-face-attribute face nil :background color)
 647         (add-to-list 'chess-display-face-cache (cons color face))
 648         face)))
 649
 650 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 651 ;;
 652 ;; Mousing around on the chess-display
 653 ;;
 654
 655 (defvar chess-display-last-selected nil)
 656 (make-variable-buffer-local 'chess-display-last-selected)
 657
 658 (defun chess-display-select-piece ()
 659   "Select the piece under the cursor.
 660 Clicking once on a piece selects it; then click on the target location."
 661   (interactive)
 662   (let ((coord (get-text-property (point) 'chess-coord)))
 663     (when coord
 664       (if chess-display-last-selected
 665           (let ((last-sel chess-display-last-selected))
 666             ;; if they select the same square again, just deselect it
 667             (if (/= (point) (car last-sel))
 668                 (chess-display-move (cadr last-sel) coord)
 669               ;; put the board back to rights
 670               (chess-display-update nil))
 671             (setq chess-display-last-selected nil))
 672         (setq chess-display-last-selected (list (point) coord))
 673         ;; just as in a normal chess game, if you touch the piece,
 674         ;; your opponent will see this right away
 675         (chess-display-highlight nil coord 'selected)))))
 676
 677 (defun chess-display-mouse-select-piece (event)
 678   "Select the piece the user clicked on."
 679   (interactive "e")
 680   (cond ((fboundp 'event-window)        ; XEmacs
 681          (set-buffer (window-buffer (event-window event)))
 682          (and (event-point event) (goto-char (event-point event))))
 683         ((fboundp 'posn-window)         ; Emacs
 684          (set-buffer (window-buffer (posn-window (event-start event))))
 685          (goto-char (posn-point (event-start event)))))
 686   (chess-display-select-piece))
 687
 688 (provide 'chess-display)
 689
 690 ;;; chess-display.el ends here