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