diff options
| -rw-r--r-- | TODO | 32 | ||||
| -rw-r--r-- | chess-algebraic.el | 202 | ||||
| -rw-r--r-- | chess-announce.el | 16 | ||||
| -rw-r--r-- | chess-crafty.el | 4 | ||||
| -rw-r--r-- | chess-display.el | 176 | ||||
| -rw-r--r-- | chess-engine.el | 8 | ||||
| -rw-r--r-- | chess-fen.el | 21 | ||||
| -rw-r--r-- | chess-game.el | 8 | ||||
| -rw-r--r-- | chess-gnuchess.el | 4 | ||||
| -rw-r--r-- | chess-ics.el | 5 | ||||
| -rw-r--r-- | chess-ics1.el | 44 | ||||
| -rw-r--r-- | chess-images.el | 27 | ||||
| -rw-r--r-- | chess-irc.el | 4 | ||||
| -rw-r--r-- | chess-network.el | 2 | ||||
| -rw-r--r-- | chess-phalanx.el | 4 | ||||
| -rw-r--r-- | chess-plain.el | 13 | ||||
| -rw-r--r-- | chess-ply.el | 172 | ||||
| -rw-r--r-- | chess-pos.el | 70 | ||||
| -rw-r--r-- | chess-sound.el | 25 | ||||
| -rw-r--r-- | chess-var.el | 6 | ||||
| -rw-r--r-- | chess.el | 55 | ||||
| -rw-r--r-- | chess.texi | 2 |
22 files changed, 455 insertions, 445 deletions
@@ -10,42 +10,12 @@ ---------------------------------------------------------------------- -- Have chess-algebraic-to-ply use chess-ply-create, since I can't - trust :check and :checkmate anyway. Or, break chess-ply-create into - multiple functions that get reused by chess-algebraic. - -- Make sure that when chess-algebraic-to-ply is used, and then - chess-pos-move is used, that I don't redo all the checks. There - should be a way of "blessing" a ply. - -- Make sure chess-pos-move does full validation. - -- Make sure that chess-search-position can find a rook move due to - castling. For example, O-O includes Rhf1. So, - (chess-search-position ... "f1" ?R) should return the h1 rook, if it - could reach that square legally by castling. - -- There is an ambiguity in keyboard shortcutting between Bxc6 and bxc6 - -- In chess-fen-to-pos, syntax check incoming FEN strings - - Detect draw/resign/abort/retract, etc., from ICS and common engines - Make use of the my-color and active data in chess-game.el to ensure that I only do what I should be doing -- Add `chess-display-read-only', to indicate that no changes can be - made to a displayed chess board. This would be good for cloned - displays, and when observing a bot (or two engines head-to-head). - -- Remove `chess-illegal', and just use plain error. - -- Allow S in the display to send arbitrary text to the end - -- Make chess-display-popup-in-... first class citizens - -- Have chess-display-popup-in-frame autosize based on the content (if - possible) +- Why doesn't S-b produce [B] in the keyboard shortcutting? ---------------------------------------------------------------------- diff --git a/chess-algebraic.el b/chess-algebraic.el index 9749220..3207498 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -55,115 +55,113 @@ This regexp handles both long and short form.") (defconst chess-algebraic-regexp-entire (concat chess-algebraic-regexp "$")) -(defun chess-algebraic-to-ply (position move) +(defun chess-algebraic-to-ply (position move &optional trust) "Convert the algebraic notation MOVE for POSITION to a ply." - (unless (string-match chess-algebraic-regexp-entire move) - (error "Cannot parse non-algebraic move notation: %s" move)) - (let ((mate (match-string 9 move)) - (piece (aref move 0)) - changes ply) - (if (eq piece ?O) - (let ((long (= (length (match-string 1 move)) 5))) - (setq ply (chess-ply-create-castle position long) - changes (chess-ply-changes ply))) - (let ((color (chess-pos-side-to-move position)) - (promotion (match-string 8 move))) - (setq changes - (let ((source (match-string 4 move)) - (target (chess-coord-to-index (match-string 6 move)))) - (if (and source (= (length source) 2)) - (list (chess-coord-to-index source) target) - (if (= (length source) 0) - (setq source nil) - (setq source (aref source 0))) - (let (candidates which) - (unless (< piece ?a) - (setq source piece piece ?P)) - ;; we must use our knowledge of how pieces can - ;; move, to determine which piece is meant by the - ;; piece indicator - (when (setq candidates - (chess-search-position position target - (if color piece - (downcase piece)))) - (if (= (length candidates) 1) - (list (car candidates) target) - (if (null source) - (error "Clarify piece to move by rank or file") - (while candidates - (if (if (>= source ?a) - (eq (chess-index-file (car candidates)) - (- source ?a)) - (eq (chess-index-rank (car candidates)) - (- 7 (- source ?1)))) - (setq which (car candidates) candidates nil) - (setq candidates (cdr candidates)))) - (if (null which) - (error "Could not determine which piece to use") - (list which target))))))))) - (if promotion - (nconc changes (list :promote (aref promotion 0)))))) - (if mate - (nconc changes (list (if (equal mate "#") :checkmate :check)))) + (when (string-match chess-algebraic-regexp-entire move) + (let ((color (chess-pos-side-to-move position)) + (mate (match-string 9 move)) + (piece (aref move 0)) + changes ply) + (if (eq piece ?O) + (let ((long (= (length (match-string 1 move)) 5))) + (if (chess-pos-can-castle position (if long (if color ?Q ?q) + (if color ?K ?k))) + (setq ply (chess-ply-create-castle position long) + changes (chess-ply-changes ply)))) + (let ((promotion (match-string 8 move))) + (setq changes + (let ((source (match-string 4 move)) + (target (chess-coord-to-index (match-string 6 move)))) + (if (and source (= (length source) 2)) + (list (chess-coord-to-index source) target) + (if (= (length source) 0) + (setq source nil) + (setq source (aref source 0))) + (let (candidates which) + (unless (< piece ?a) + (setq source piece piece ?P)) + ;; we must use our knowledge of how pieces can + ;; move, to determine which piece is meant by the + ;; piece indicator + (when (setq candidates + (chess-search-position position target + (if color piece + (downcase piece)))) + (if (= (length candidates) 1) + (list (car candidates) target) + (if (null source) + (error "Clarify piece to move by rank or file") + (while candidates + (if (if (>= source ?a) + (eq (chess-index-file (car candidates)) + (- source ?a)) + (eq (chess-index-rank (car candidates)) + (- 7 (- source ?1)))) + (setq which (car candidates) candidates nil) + (setq candidates (cdr candidates)))) + (if (null which) + (error "Could not determine which piece to use") + (list which target))))))))) + (if promotion + (nconc changes (list :promote (aref promotion 0)))))) - (or ply (and changes (cons (chess-pos-copy position) changes))))) + (when trust + (if mate + (nconc changes (list (if (equal mate "#") :checkmate :check)))) + (nconc changes (list :valid))) + + (or ply (apply 'chess-ply-create position changes))))) (defun chess-ply-to-algebraic (ply &optional long) "Convert the given PLY to algebraic notation. If LONG is non-nil, render the move into long notation." - (if (let ((first (car (chess-ply-changes ply)))) - (or (null first) - (symbolp first))) + (if (let ((source (chess-ply-source ply))) + (or (null source) (symbolp source))) "" - (let* ((pos (chess-ply-pos ply)) - (changes (chess-ply-changes ply)) - (from (car changes)) - (to (cadr changes)) - (from-piece (chess-pos-piece pos from)) - (color (chess-pos-side-to-move pos)) str - (notation - (if (setq str - (if (memq :castle changes) "O-O" - (if (memq :long-castle changes) "O-O-O"))) - str - (let ((candidates (chess-search-position pos to from-piece)) - (rank 0) (file 0) - (from-rank (/ from 8)) - (from-file (mod from 8)) - differentiator notation) - (when (> (length candidates) 1) - (dolist (candidate candidates) - (if (= (/ candidate 8) from-rank) - (setq rank (1+ rank))) - (if (= (mod candidate 8) from-file) - (setq file (1+ file)))) - (cond - ((= file 1) - (setq differentiator (+ from-file ?a))) - ((= rank 1) - (setq differentiator (+ (- 7 from-rank) ?1))) - (t (error "Could not differentiate piece")))) - (concat - (unless (= (upcase from-piece) ?P) - (char-to-string (upcase from-piece))) - (if long - (chess-index-to-coord from) - (if differentiator - (char-to-string differentiator) - (if (and (not long) (= (upcase from-piece) ?P) - (/= (chess-index-file from) - (chess-index-file to))) - (char-to-string (+ (chess-index-file from) ?a))))) - (if (/= ? (chess-pos-piece pos to)) - "x" (if long "-")) - (chess-index-to-coord to) - (let ((promote (memq :promote changes))) - (if promote - (concat "=" (char-to-string - (upcase (cadr promote))))))))))) - (concat notation - (if (memq :check changes) "+" - (if (memq :checkmate changes) "#")))))) + (or (and (chess-ply-has-keyword ply :castle) "O-O") + (and (chess-ply-has-keyword ply :long-castle) "O-O-O") + (let* ((pos (chess-ply-pos ply)) + (from (chess-ply-source ply)) + (to (chess-ply-target ply)) + (from-piece (chess-pos-piece pos from)) + (color (chess-pos-side-to-move pos)) + (candidates (chess-search-position pos to from-piece)) + (rank 0) (file 0) + (from-rank (/ from 8)) + (from-file (mod from 8)) + differentiator) + (when (> (length candidates) 1) + (dolist (candidate candidates) + (if (= (/ candidate 8) from-rank) + (setq rank (1+ rank))) + (if (= (mod candidate 8) from-file) + (setq file (1+ file)))) + (cond + ((= file 1) + (setq differentiator (+ from-file ?a))) + ((= rank 1) + (setq differentiator (+ (- 7 from-rank) ?1))) + (t (error "Could not differentiate piece")))) + (concat + (unless (= (upcase from-piece) ?P) + (char-to-string (upcase from-piece))) + (if long + (chess-index-to-coord from) + (if differentiator + (char-to-string differentiator) + (if (and (not long) (= (upcase from-piece) ?P) + (/= (chess-index-file from) + (chess-index-file to))) + (char-to-string (+ (chess-index-file from) ?a))))) + (if (/= ? (chess-pos-piece pos to)) + "x" (if long "-")) + (chess-index-to-coord to) + (let ((promote (chess-ply-has-keyword ply :promote))) + (if promote + (concat "=" (char-to-string + (upcase (cadr promote)))))) + (if (chess-ply-has-keyword ply :check) "+" + (if (chess-ply-has-keyword ply :checkmate) "#"))))))) (provide 'chess-algebraic) diff --git a/chess-announce.el b/chess-announce.el index 27554a8..95cf40c 100644 --- a/chess-announce.el +++ b/chess-announce.el @@ -29,10 +29,12 @@ The first is called one start of the announcer. The second is called with the string to announce each time. The third is called to shutdown the announcer process, if necessary.") +(defun chess-announce-available-p () t) + (defun chess-announce-for-game (game) "Announce the opponent's moves in GAME." - (chess-game-add-hook game 'chess-announce-event-handler) - (funcall (nth 0 chess-announce-functions))) + (funcall (nth 0 chess-announce-functions)) + (chess-game-add-hook game 'chess-announce-event-handler)) (defun chess-announce-event-handler (game ignore event &rest args) "This display module presents a standard chessboard. @@ -52,9 +54,9 @@ See `chess-display-type' for the different kinds of displays." (t-piece (chess-pos-piece pos target)) text) (cond - ((memq :castle changes) + ((chess-ply-has-keyword ply :castle) (setq text "kingside castle")) - ((memq :long-castle changes) + ((chess-ply-has-keyword :long-castle) (setq text "queenside castle")) ((= t-piece ? ) (setq text (concat (cdr (assq (downcase s-piece) @@ -66,11 +68,11 @@ See `chess-display-type' for the different kinds of displays." chess-announce-names)) " takes at " (chess-index-to-coord target))))) - (if (memq :check changes) + (if (chess-ply-has-keyword :check) (setq text (concat text ", check"))) - (if (memq :checkmate changes) + (if (chess-ply-has-keyword :checkmate) (setq text (concat text ", checkmate"))) - (if (memq :stalemate changes) + (if (chess-ply-has-keyword :stalemate) (setq text (concat text ", stalemate"))) (funcall (nth 1 chess-announce-functions) text))))))) diff --git a/chess-crafty.el b/chess-crafty.el index 6e0d733..72b866e 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -24,11 +24,11 @@ (function (lambda () (funcall chess-engine-response-handler 'move - (chess-engine-convert-algebraic (match-string 2)))))) + (chess-engine-convert-algebraic (match-string 2) t))))) (cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)" (function (lambda () - (signal 'chess-illegal (match-string 1))))))) + (error (match-string 1))))))) (defun chess-crafty-handler (event &rest args) (cond diff --git a/chess-display.el b/chess-display.el index edde9d6..38d2a5a 100644 --- a/chess-display.el +++ b/chess-display.el @@ -15,30 +15,15 @@ "Common code used by chess displays." :group 'chess) -(defcustom chess-display-use-faces t - "If non-nil, provide colored faces for ASCII displays." +(defcustom chess-display-separate-frame (display-multi-frame-p) + "If non-nil, chessboard display use their own frame." :type 'boolean - :group 'chess-display) - -(defface chess-display-black-face - '((((class color) (background light)) (:foreground "Green")) - (((class color) (background dark)) (:foreground "Green")) - (t (:bold t))) - "*The face used for black pieces on the ASCII display." - :group 'chess-display) + :group 'chess-images) -(defface chess-display-white-face - '((((class color) (background light)) (:foreground "Yellow")) - (((class color) (background dark)) (:foreground "Yellow")) - (t (:bold t))) - "*The face used for white pieces on the ASCII display." - :group 'chess-display) - -(defface chess-display-highlight-face - '((((class color) (background light)) (:background "#add8e6")) - (((class color) (background dark)) (:background "#add8e6"))) - "Face to use for highlighting pieces that have been selected." - :group 'chess-display) +(defcustom chess-display-popup t + "If non-nil, popup displays whenever a significant event occurs." + :type 'boolean + :group 'chess-ics1) ;;; Code: @@ -333,7 +318,7 @@ that is supported by most displays, and is the default mode." (chess-with-current-buffer display (let ((mode :selected)) (dolist (arg args) - (if (symbolp arg) + (if (or (symbolp arg) (stringp arg)) (setq mode arg) (funcall chess-display-event-handler 'highlight arg mode)))))) @@ -425,7 +410,7 @@ See `chess-display-type' for the different kinds of displays." (define-key map [tab] 'chess-display-invert) (define-key map [??] 'describe-mode) - (define-key map [?B] 'chess-display-list-buffers) + (define-key map [?L] 'chess-display-list-buffers) ;;(define-key map [?C] 'chess-display-duplicate) (define-key map [?I] 'chess-display-invert) @@ -451,15 +436,15 @@ See `chess-display-type' for the different kinds of displays." (define-key map [? ] 'chess-display-pass) (define-key map [??] 'describe-mode) (define-key map [?@] 'chess-display-remote) - (define-key map [?A] 'chess-display-abort) + (define-key map [(control ?c) (control ?a)] 'chess-display-abort) (define-key map [?C] 'chess-display-duplicate) - (define-key map [?D] 'chess-display-draw) + (define-key map [?D] 'chess-display-duplicate) + (define-key map [(control ?c) (control ?d)] 'chess-display-draw) (define-key map [?E] 'chess-display-edit-board) (define-key map [?F] 'chess-display-set-from-fen) ;;(define-key map [?M] 'chess-display-manual-move) (define-key map [?M] 'chess-display-match) - (define-key map [?N] 'chess-display-abort) - (define-key map [?R] 'chess-display-resign) + (define-key map [(control ?c) (control ?r)] 'chess-display-resign) (define-key map [?S] 'chess-display-shuffle) (define-key map [?U] 'chess-display-undo) (define-key map [?X] 'chess-display-quit) @@ -468,7 +453,8 @@ See `chess-display-type' for the different kinds of displays." (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 + ?R ?N ?B ?Q ?K ?O)) (define-key map (vector key) 'chess-keyboard-shortcut)) (define-key map [backspace] 'chess-keyboard-shortcut-delete) (define-key map [?x] 'ignore) @@ -503,12 +489,6 @@ See `chess-display-type' for the different kinds of displays." ["Next" chess-display-move-forward t] ["Last" chess-display-move-last t]))) -(defun chess-display-redraw () - "Just redraw the current display." - (interactive) - (erase-buffer) - (chess-display-update nil)) - (defun chess-display-mode (&optional read-only) "A mode for displaying and interacting with a chessboard. If READ-ONLY is non-nil, then no modifications are allowed. @@ -565,6 +545,17 @@ The key bindings available in this mode are: (or (chess-ply-to-algebraic ply) "???")))))))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Commands used by the keyboard bindings above +;; + +(defun chess-display-redraw () + "Just redraw the current display." + (interactive) + (erase-buffer) + (chess-display-update nil)) + (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." @@ -682,10 +673,9 @@ Basically, it means we are playing, not editing or reviewing." (chess-fischer-random-position)) (ding))) -(defun chess-display-match (whom) +(defun chess-display-match () "Resign the current game." - (interactive "sWhom do you wish to play? ") - (chess-game-run-hooks chess-display-game 'match whom)) + (chess-game-run-hooks chess-display-game 'match)) (defun chess-display-resign () "Resign the current game." @@ -847,7 +837,50 @@ to the end or beginning." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; Allow for quick entry of algebraic moves via keyboard +;; Default window and frame popup functions +;; + +(defun chess-display-popup-in-window () + "Popup the given DISPLAY, so that it's visible to the user." + (unless (get-buffer-window (current-buffer)) + (fit-window-to-buffer (display-buffer (current-buffer))))) + +(defun chess-display-popup-in-frame (height width &optional display) + "Popup the given DISPLAY, so that it's visible to the user." + (let ((window (get-buffer-window (current-buffer) t))) + (if window + (let ((frame (window-frame window))) + (unless (eq frame (selected-frame)) + (raise-frame frame))) + (let ((params (list (cons 'name "*Chessboard*") + (cons 'height height) + (cons 'width width)))) + (if display + (push (cons 'display display) params)) + (select-frame (make-frame params)) + (set-window-dedicated-p (selected-window) t))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Maintain a face cache for given color strings +;; + +(defvar chess-display-face-cache '((t . t))) + +(defun chess-display-get-face (color) + (or (cdr (assoc color chess-display-face-cache)) + (let ((face (make-face 'chess-display-highlight))) + (set-face-attribute face nil :background color) + (add-to-list 'chess-display-face-cache (cons color face)) + face))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Keyboard entry of algebraic notation, using shortcutting +;; +;; This scheme was adapted from the way SCID +;; (http://scid.sourceforge.net), by Shane Hudson, behaves. It's the +;; only way to move your pieces around! ;; (defvar chess-move-string "") @@ -864,17 +897,20 @@ to the end or beginning." (l (length move)) (xl (length chess-move-string)) (match t)) - (unless (or (and (equal chess-move-string "ok") + (unless (or (and (equal (downcase chess-move-string) "ok") (equal move "O-O")) - (and (equal chess-move-string "oq") + (and (equal (downcase chess-move-string) "oq") (equal move "O-O-O"))) (while (and (< i l) (< x xl)) - (if (= (aref move i) ?x) - (setq i (1+ i))) - (if (/= (downcase (aref move i)) - (aref chess-move-string x)) - (setq match nil i l) - (setq i (1+ i) x (1+ x))))) + (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))) (defsubst chess-keyboard-display-moves (&optional move-list) @@ -891,8 +927,7 @@ to the end or beginning." (stringp chess-move-string) (> (length chess-move-string) 1)) (setq chess-move-string - (substring chess-move-string 0 - (1- (length chess-move-string)))) + (substring chess-move-string 0 (1- (length chess-move-string)))) (chess-keyboard-display-moves))) (defun chess-keyboard-shortcut (&optional display-only) @@ -902,8 +937,7 @@ to the end or beginning." (setq chess-move-string nil)) (unless display-only (setq chess-move-string - (concat chess-move-string - (char-to-string (downcase last-command-char))))) + (concat chess-move-string (char-to-string last-command-char)))) (let ((position (chess-display-position nil))) (unless (and chess-legal-moves (eq position chess-legal-moves-pos)) @@ -926,49 +960,11 @@ to the end or beginning." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -;; Manage a face cache for textual displays -;; - -(defvar chess-display-face-cache '((t . t))) - -(defsubst chess-display-get-face (color) - (or (cdr (assoc color chess-display-face-cache)) - (let ((face (make-face 'chess-display-highlight))) - (set-face-attribute face nil :background color) - (add-to-list 'chess-display-face-cache (cons color face)) - face))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; Default window and frame popup functions -;; - -(defun chess-display-popup-in-window () - "Popup the given DISPLAY, so that it's visible to the user." - (unless (get-buffer-window (current-buffer)) - (fit-window-to-buffer (display-buffer (current-buffer))))) - -(defun chess-display-popup-in-frame (display height width) - "Popup the given DISPLAY, so that it's visible to the user." - (let ((window (get-buffer-window (current-buffer) t))) - (if window - (let ((frame (window-frame window))) - (unless (eq frame (selected-frame)) - (raise-frame frame))) - (let ((params (list (cons 'name "*Chessboard*") - (cons 'height height) - (cons 'width width)))) - (if display - (push (cons 'display display) params)) - (select-frame (make-frame params)) - (set-window-dedicated-p (selected-window) t))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;; Mousing around on the chess-display ;; (defvar chess-display-last-selected nil) + (make-variable-buffer-local 'chess-display-last-selected) (defun chess-display-select-piece () diff --git a/chess-engine.el b/chess-engine.el index 9a97cef..afa80d8 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -64,8 +64,8 @@ (chess-engine-position (setq chess-engine-position (chess-ply-next-pos ply))))) -(defsubst chess-engine-convert-algebraic (move) - (or (chess-algebraic-to-ply (chess-engine-position nil) move) +(defsubst chess-engine-convert-algebraic (move &optional trust-check) + (or (chess-algebraic-to-ply (chess-engine-position nil) move trust-check) (ignore (message "Received invalid move string: %s" move)))) @@ -156,7 +156,7 @@ (when game (if (y-or-n-p "Your opponent offers a draw, accept? ") (progn - (chess-game-draw game) + (chess-game-end game :draw) (chess-engine-command nil 'accept) (chess-game-set-data game 'active nil)) (chess-engine-command nil 'decline)) @@ -200,7 +200,7 @@ (cond ((eq chess-engine-pending-offer 'draw) (message "Your draw offer was accepted") - (chess-game-draw game) + (chess-game-end game :draw) (chess-game-set-data game 'active nil)) ((eq chess-engine-pending-offer 'abort) diff --git a/chess-fen.el b/chess-fen.el index 8dca4f6..b104f06 100644 --- a/chess-fen.el +++ b/chess-fen.el @@ -46,21 +46,24 @@ (let ((i 0) (l (length fen)) (rank 0) (file 0) (c ?0) (position (chess-pos-create t)) - number) - (while (and (/= c ? ) (< i l)) + error number) + (while (and (null error) (/= c ? ) (< i l)) (setq c (aref fen i)) (cond ((= c ?/) (setq file 0 rank (1+ rank))) ((and (>= c ?1) (<= c ?9)) (setq file (+ file (- c ?0)))) - ((/= c ? ) + ((memq (upcase c) '(?K ?Q ?B ?N ?R ?P)) (chess-pos-set-piece position (chess-rf-to-index rank file) c) - (setq file (1+ file)))) + (setq file (1+ file))) + (t (setq error t))) (setq i (1+ i))) - (chess-pos-set-side-to-move position (= (aref fen i) ?w)) + (if (memq (aref fen i) '(?b ?w)) + (chess-pos-set-side-to-move position (= (aref fen i) ?w)) + (setq error t)) (setq i (+ i 2) number nil) - (while (< i l) + (while (and (null error) (< i l)) (setq c (aref fen i)) (cond ((= c ?K) (chess-pos-set-can-castle position ?K t)) @@ -70,9 +73,11 @@ ((and (>= c ?a) (<= c ?h)) (chess-pos-set-en-passant position (chess-coord-to-index (substring fen i (+ i 2)))) - (setq i (1+ i)))) + (setq i (1+ i))) + (t (setq error t))) (setq i (1+ i))) - position)) + (unless error + position))) (defun chess-pos-to-fen (position &optional full) "Convert a chess POSITION to FEN-like notation. diff --git a/chess-game.el b/chess-game.el index 13f88c6..f81f888 100644 --- a/chess-game.el +++ b/chess-game.el @@ -11,9 +11,6 @@ (require 'chess-ply) -(defvar chess-illegal nil) -(put 'chess-illegal 'error-conditions '(error)) - (defvar chess-game-inhibit-events nil) (defconst chess-game-default-tags @@ -213,11 +210,6 @@ progress (nil), if it is drawn, resigned, mate, etc." (error "Cannot add moves to a completed game")) (unless (equal position (chess-ply-pos current-ply)) (error "Positions do not match")) - (unless (or (chess-ply-has-keyword ply :resign :draw) - (chess-search-position - position (cadr (chess-ply-changes ply)) - (chess-pos-piece position (car (chess-ply-changes ply))))) - (signal 'chess-illegal "Illegal move")) (chess-ply-set-changes current-ply changes) (chess-game-add-ply game (chess-ply-create (chess-ply-next-pos current-ply))) diff --git a/chess-gnuchess.el b/chess-gnuchess.el index ee5912b..8f08b3a 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -25,11 +25,11 @@ (function (lambda () (funcall chess-engine-response-handler 'move - (chess-engine-convert-algebraic (match-string 1)))))) + (chess-engine-convert-algebraic (match-string 1) t))))) (cons "Illegal move:" (function (lambda () - (signal 'chess-illegal "Illegal move")))) + (error "Illegal move")))) (cons "Board is wrong!" (function (lambda () diff --git a/chess-ics.el b/chess-ics.el index e4d4464..6b93559 100644 --- a/chess-ics.el +++ b/chess-ics.el @@ -61,6 +61,8 @@ who is black." (chess-pos-set-can-castle position ?q t)) (setq parts (cdr parts)) + ;; jww (2002-04-11): How is check indicated? + ;; unknown (setq parts (cdr parts)) (setq parts (cdr parts)) @@ -180,7 +182,8 @@ who is black." ((eq event 'match) (setq chess-engine-pending-offer 'match) - (chess-engine-send nil (format "match %s\n" (car args)))) + (chess-engine-send nil (format "match %s\n" + (read-string "Whom would you like challenge? ")))) ((eq event 'move) (unless chess-ics-ensure-ics12 diff --git a/chess-ics1.el b/chess-ics1.el index 0ce297e..b53b2e2 100644 --- a/chess-ics1.el +++ b/chess-ics1.el @@ -10,9 +10,24 @@ "The ICS1 style ASCII display." :group 'chess-display) -(defcustom chess-ics1-popup t - "If non-nil, popup the chessboard display whenever the opponent moves." - :type 'boolean +(defface chess-ics1-black-face + '((((class color) (background light)) (:foreground "Green")) + (((class color) (background dark)) (:foreground "Green")) + (t (:bold t))) + "*The face used for black pieces on the ASCII display." + :group 'chess-ics1) + +(defface chess-ics1-white-face + '((((class color) (background light)) (:foreground "Yellow")) + (((class color) (background dark)) (:foreground "Yellow")) + (t (:bold t))) + "*The face used for white pieces on the ASCII display." + :group 'chess-ics1) + +(defface chess-ics1-highlight-face + '((((class color) (background light)) (:background "#add8e6")) + (((class color) (background dark)) (:background "#add8e6"))) + "Face to use for highlighting pieces that have been selected." :group 'chess-ics1) (defcustom chess-ics1-popup-function 'chess-display-popup-in-window @@ -25,7 +40,7 @@ (defun chess-ics1-handler (event &rest args) (cond ((eq event 'popup) - (if chess-ics1-popup + (if chess-display-popup (funcall chess-ics1-popup-function))) ((eq event 'draw) (apply 'chess-ics1-draw args)) @@ -54,14 +69,12 @@ PERSPECTIVE is t for white or nil for black." (insert (format " %d " (1+ (- 7 rank))))) (insert "| ") (setq begin (1- (point))) - (if (and chess-display-use-faces (/= ? piece)) - (let ((p (char-to-string piece))) - (add-text-properties - 0 1 (list 'face (if (> piece ?a) - 'chess-display-black-face - 'chess-display-white-face)) p) - (insert p)) - (insert piece)) + (let ((p (char-to-string piece))) + (add-text-properties + 0 1 (list 'face (if (> piece ?a) + 'chess-ics1-black-face + 'chess-ics1-white-face)) p) + (insert p)) (insert ? ) (add-text-properties begin (point) (list 'chess-coord @@ -91,7 +104,12 @@ PERSPECTIVE is t for white or nil for black." (skip-chars-backward "^|") (setq beg (point)) (skip-chars-forward "^|") - (put-text-property beg (point) 'face 'chess-display-highlight-face)))) + (put-text-property beg (point) 'face + (cond + ((eq mode :selected) + 'chess-ics1-highlight-face) + (t + (chess-display-get-face mode))))))) (defun chess-debug-position (&optional position) "This is a debugging function, and not meant from general use." diff --git a/chess-images.el b/chess-images.el index eca809a..5ab618d 100644 --- a/chess-images.el +++ b/chess-images.el @@ -133,11 +133,6 @@ that specialized squares may be used such as marble tiles, etc." :set 'chess-images-clear-image-cache :group 'chess-images) -(defcustom chess-images-popup t - "If non-nil, popup the chessboard display whenever the opponent moves." - :type 'boolean - :group 'chess-images) - (defcustom chess-images-popup-function 'chess-images-popup "The function used to popup a chess-images display. The current-buffer is set to the display buffer when this function is @@ -147,27 +142,27 @@ called." ;;; Code: +(defconst chess-images-piece-names + '((?r "rook" 0) + (?n "knight" 1) + (?b "bishop" 2) + (?q "queen" 3) + (?k "king" 4) + (?p "pawn" 5)) + "The names and index values of the different pieces.") + (defun chess-images-handler (event &rest args) (cond ((eq event 'initialize) (chess-images-initialize)) ((eq event 'popup) - (if chess-images-popup + (if chess-display-popup (funcall chess-images-popup-function))) ((eq event 'draw) (apply 'chess-images-draw args)) ((eq event 'highlight) (apply 'chess-images-highlight args)))) -(defconst chess-images-piece-names - '((?r "rook" 0) - (?n "knight" 1) - (?b "bishop" 2) - (?q "queen" 3) - (?k "king" 4) - (?p "pawn" 5)) - "The names and index values of the different pieces.") - (defun chess-images-initialize () (let ((map (current-local-map))) (define-key map [?^] 'chess-images-increase-size) @@ -197,7 +192,7 @@ called." (display (and (stringp chess-images-separate-frame) chess-images-separate-frame))) ;; create the frame whenever necessary - (chess-display-popup-in-frame display (+ max-char-height 2) + (chess-display-popup-in-frame (+ max-char-height 2) max-char-width)) (chess-display-popup-in-window))) diff --git a/chess-irc.el b/chess-irc.el index 11cbf75..1588b22 100644 --- a/chess-irc.el +++ b/chess-irc.el @@ -70,8 +70,8 @@ nil) ((eq event 'match) - (setq chess-irc-opponent (car args)) - (chess-network-handler 'match (car args))) + (setq chess-irc-opponent (read-string "IRC nick of user to challenge: ")) + (chess-network-handler 'match chess-irc-opponent)) ((eq event 'shutdown) (chess-engine-send nil "quit") diff --git a/chess-network.el b/chess-network.el index a277423..237ba43 100644 --- a/chess-network.el +++ b/chess-network.el @@ -85,7 +85,7 @@ (read-string "Port: ")))) (if (eq which ?s) (message "Now waiting for your opponent to connect...") - (process-send-string proc (format "chess match %s\n" chess-full-name)) + (chess-network-handler 'match) (message "You have connected; pass now or make your move.")) proc)) diff --git a/chess-phalanx.el b/chess-phalanx.el index 2cabeb3..270376d 100644 --- a/chess-phalanx.el +++ b/chess-phalanx.el @@ -22,11 +22,11 @@ (function (lambda () (funcall chess-engine-response-handler 'move - (chess-engine-convert-algebraic (match-string 1)))))) + (chess-engine-convert-algebraic (match-string 1) t))))) (cons "Illegal move:\\s-*\\(.*\\)" (function (lambda () - (signal 'chess-illegal (match-string 1))))))) + (error (match-string 1))))))) (defun chess-phalanx-handler (event &rest args) (cond diff --git a/chess-plain.el b/chess-plain.el index fdcf522..2a2c545 100644 --- a/chess-plain.el +++ b/chess-plain.el @@ -61,11 +61,6 @@ modify `chess-plain-piece-chars' to avoid real confusion.)" :type '(choice (const 'color) (const 'square-color))) ;; fails somehow -(defcustom chess-plain-popup t - "If non-nil, popup the chessboard display whenever the opponent moves." - :type 'boolean - :group 'chess-plain) - (defcustom chess-plain-popup-function 'chess-display-popup-in-window "The function used to popup a chess-plain display." :type 'function @@ -76,7 +71,7 @@ modify `chess-plain-piece-chars' to avoid real confusion.)" (defun chess-plain-handler (event &rest args) (cond ((eq event 'popup) - (if chess-plain-popup + (if chess-display-popup (funcall chess-plain-popup-function))) ((eq event 'draw) (apply 'chess-plain-draw args)) @@ -151,7 +146,11 @@ PERSPECTIVE is t for white or nil for black." (1+ file) file))) (put-text-property (point) (1+ (point)) 'face - 'chess-display-highlight-face)))) + (cond + ((eq mode :selected) + 'chess-plain-highlight-face) + (t + (chess-display-get-face mode))))))) (provide 'chess-plain) diff --git a/chess-ply.el b/chess-ply.el index 8647cc8..c14f44a 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -85,10 +85,11 @@ ("bishop" . ?b))) (defun chess-ply-create-castle (position &optional long) - "Create a castling ply; this function supports Fischer Random castling." + "Create castling changes; this function supports Fischer Random castling." (let* ((color (chess-pos-side-to-move position)) (king (car (chess-pos-search position (if color ?K ?k)))) - (king-target (chess-rf-to-index (if color 7 0) (if long 2 6))) + (king-target (chess-rf-to-index (if color 7 0) + (if long 2 6))) (king-file (chess-index-file king)) (file (if long 0 7)) rook) @@ -97,12 +98,11 @@ (if (chess-pos-piece-p position index (if color ?R ?r)) (setq rook index file king-file) (setq file (funcall (if long '1+ '1-) file))))) - (if (and rook - (chess-search-position position king-target (if color ?K ?k))) - (cons (chess-pos-copy position) - (list king king-target rook - (chess-rf-to-index (if color 7 0) (if long 3 5)) - (if long :long-castle :castle)))))) + (if (and rook (chess-search-position position king-target + (if color ?K ?k))) + (list king king-target rook + (chess-rf-to-index (if color 7 0) (if long 3 5)) + (if long :long-castle :castle))))) (defun chess-ply-create (position &rest changes) "Create a ply from the given POSITION by applying the suppiled CHANGES. @@ -112,81 +112,96 @@ also extend castling, and will prompt for a promotion piece. Note: Do not pass in the rook move if CHANGES represents a castling maneuver." - (let ((ply (cons (chess-pos-copy position) changes))) - (if (null changes) - ply - ;; validate that `changes' can be legally applied to the given - ;; position - (when (member (car changes) - (chess-search-position position (cadr changes) - (chess-pos-piece position - (car changes)))) - ;; is this a castling maneuver? - (let ((color (chess-pos-side-to-move position))) - (when (and (eq (if color ?K ?k) - (chess-pos-piece position (car changes))) - (> (abs (- (chess-index-file (cadr changes)) - (chess-index-file (car changes)))) 1)) - (let ((kingside (> (chess-index-file (cadr changes)) - (chess-index-file (car changes))))) - ;; if so, add the rook moves - (nconc changes (if kingside - (list (chess-rf-to-index (if color 7 0) 7) - (chess-rf-to-index (if color 7 0) 5) - :castle) - (list (chess-rf-to-index (if color 7 0) 0) - (chess-rf-to-index (if color 7 0) 3) - :long-castle)))))) - + (let* ((valid-p (memq :valid changes)) + (ply (cons (chess-pos-copy position) + (delq :valid changes))) + (color (chess-pos-side-to-move position)) + piece) + + ;; validate that `changes' can be legally applied to the given + ;; position + (when (and changes (not (symbolp (car changes))) + (or valid-p + (member (car changes) + (chess-search-position + position (cadr changes) + (chess-pos-piece position (car changes)))))) + (setq piece (chess-pos-piece position (car changes))) + + ;; is this a castling maneuver? + (if (and (= piece (if color ?K ?k)) + (not (or (memq :castle changes) + (memq :long-castle changes)))) + (let* ((target (cadr changes)) + (file (chess-index-file target)) + (long (= 2 file)) + new-changes) + (if (and (or (and (= file 6) + (chess-pos-can-castle position + (if color ?K ?k))) + (and long + (chess-pos-can-castle position + (if color ?Q ?q)))) + (setq new-changes + (chess-ply-create-castle position long))) + (setcdr ply new-changes)))) + + ;; is this a pawn move to the ultimate rank? if so, and we + ;; haven't already been told, ask for the piece to promote it to + (if (and (= piece (if color ?P ?p)) + (not (memq :promote changes)) + (= (if color 0 7) (chess-index-rank (cadr changes)))) + (let ((new-piece (completing-read + "Promote pawn to queen/rook/knight/bishop? " + chess-piece-name-table nil t "queen"))) + (setq new-piece + (cdr (assoc new-piece chess-piece-name-table))) + (if color + (setq new-piece (upcase new-piece))) + (nconc changes (list :promote new-piece)))) + + (unless (or (memq :check changes) + (memq :checkmate changes) + (memq :stalemate changes)) (let* ((next-pos (chess-ply-next-pos ply)) - (color (chess-pos-side-to-move next-pos))) + (next-color (not color))) ;; is the opponent's king in check/mate or stalemate now, as - ;; a result of the changes? NOTE: engines, whom we should - ;; trust, may already have determine if check/checkmate - ;; applies. - (let ((can-move (catch 'can-move - (dotimes (rank 8) - (dotimes (file 8) - (let* ((to (chess-rf-to-index rank file)) - (piece (chess-pos-piece next-pos to))) - (when (or (eq piece ? ) - (if color - (> piece ?a) - (< piece ?a))) - (if (chess-search-position next-pos - to color) - (throw 'can-move t))))))))) + ;; a result of the changes? + (let ((can-move + (catch 'can-move + ;; find out if any of `color's pieces can move. We + ;; start the search on the home row for that color, + ;; as it's likier to find a legal move faster. + (let ((rank (if next-color 7 0)) + (file 0)) + (while (funcall (if next-color '>= '<) rank + (if next-color 0 8)) + (while (< file 8) + (let* ((to (chess-rf-to-index rank file)) + (piece (chess-pos-piece next-pos to))) + (when (or (eq piece ? ) + (if next-color + (> piece ?a) + (< piece ?a))) + (if (chess-search-position next-pos to next-color) + (throw 'can-move t)))) + (setq file (1+ file))) + (setq file 0 rank (funcall (if next-color '1- '1+) + rank))))))) + + ;; see if anyone from the other side is attacking the king + ;; in the new position (if (chess-search-position next-pos (car (chess-pos-search - next-pos (if color ?K ?k))) - (not color)) - ;; yes, well is in he in checkmate? - (if can-move - (nconc changes (list :check)) - (nconc changes (list :checkmate))) + next-pos (if next-color ?K ?k))) + (not next-color)) + (nconc changes (list (if can-move :check :checkmate))) ;; no, but is he in stalemate? (unless can-move - (nconc changes (list :stalemate))))) - - ;; is this a pawn move to the ultimate rank? if so, and we - ;; haven't already been told, ask for the piece to promote - ;; it to; NOTE: 'color' has the inverse meaning at this - ;; point... - (if (and (= ?p (downcase (chess-pos-piece next-pos - (cadr changes)))) - (= (if color 7 0) - (chess-index-rank (cadr changes)))) - (let ((new-piece (completing-read - "Promote pawn to queen/rook/knight/bishop? " - chess-piece-name-table nil t "queen"))) - (setq new-piece - (cdr (assoc new-piece chess-piece-name-table))) - (unless color - (setq new-piece (upcase new-piece))) - (nconc changes (list :promote new-piece))))) - - ;; return the annotated ply - ply)))) + (nconc changes (list :stalemate)))))))) + + ;; return the annotated ply + ply)) (defsubst chess-ply-final-p (ply) "Return non-nil if this is the last ply of a game/variation." @@ -205,7 +220,8 @@ maneuver." (> piece ?a) (< piece ?a))) (dolist (candidate (chess-search-position position to color)) - (push (chess-ply-create position candidate to) plies)))))) + (push (chess-ply-create position candidate to :valid) + plies)))))) plies)) (provide 'chess-ply) diff --git a/chess-pos.el b/chess-pos.el index 7249399..6c89e15 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -160,7 +160,7 @@ Also, EPD evaluation numbers/strings can be set here." (defun chess-pos-copy (position) "Create a new chess position, set at the starting position. If BLANK is non-nil, all of the squares will be empty. -The current side-to-move is always white." +The current side-to-move always starts as white." (let ((copy (make-vector 72 nil)) elem) (dotimes (i 71) (setq elem (aref position i)) @@ -197,17 +197,15 @@ The current side-to-move is always white." (defsubst chess-index-rank (index) (/ index 8)) (defsubst chess-index-file (index) (mod index 8)) -(defun chess-add-index (index rank-move file-move) +(defsubst chess-incr-index (index rank-move file-move) "Create a new INDEX from an old one, by adding rank-move and file-move." - (let* ((rank (chess-index-rank index)) - (file (chess-index-file index)) - (newrank (+ rank rank-move)) - (newfile (+ file file-move))) + (let ((newrank (+ (chess-index-rank index) rank-move)) + (newfile (+ (chess-index-file index) file-move))) (if (and (>= newrank 0) (< newrank 8) (>= newfile 0) (< newfile 8)) (chess-rf-to-index newrank newfile)))) -(defun chess-pos-piece-p (position index piece-or-color) +(defsubst chess-pos-piece-p (position index piece-or-color) "Return non-nil if at POSITION/INDEX there is the given PIECE-OR-COLOR. If PIECE-OR-COLOR is t for white or nil for black, any piece of that color will do." @@ -218,7 +216,7 @@ color will do." ((eq piece-or-color nil) (> p ?a)) (t (= p piece-or-color))))) -(defun chess-pos-search (position piece-or-color) +(defsubst chess-pos-search (position piece-or-color) "Look on POSITION anywhere for PIECE-OR-COLOR, returning all coordinates. If PIECE-OR-COLOR is t for white or nil for black, any piece of that color will do." @@ -270,7 +268,7 @@ trying to move a blank square." (chess-pos-set-piece position to piece)) (setq ch (cddr ch))))) - ;; now fix up the position + ;; now fix up the resulting position (let ((color (chess-pos-side-to-move position))) ;; once a piece is moved, en passant is no longer available @@ -285,15 +283,14 @@ trying to move a blank square." (chess-pos-set-can-castle position (if color ?K ?k) nil) (chess-pos-set-can-castle position (if color ?Q ?q) nil)) - ((and (= piece ?r) - (equal (car changes) - (chess-rf-to-index (if color 7 0) 0))) - (chess-pos-set-can-castle position (if color ?Q ?q) nil)) - - ((and (= piece ?r) - (equal (car changes) - (chess-rf-to-index (if color 7 0) 7))) - (chess-pos-set-can-castle position (if color ?K ?k) nil)) + ((= piece ?r) + (let ((king (car (chess-pos-search position (if color ?K ?k))))) + (if (and (chess-pos-can-castle position (if color ?K ?k)) + (< (chess-index-file (car changes)) king)) + (chess-pos-set-can-castle position (if color ?K ?k) nil) + (if (and (chess-pos-can-castle position (if color ?Q ?q)) + (> (chess-index-file (car changes)) king)) + (chess-pos-set-can-castle position (if color ?Q ?q) nil))))) ((and (= piece ?p) (> (abs (- (chess-index-rank (cadr changes)) @@ -339,6 +336,8 @@ indices which indicate where a piece may have moved from." (< piece ?a) piece)) (bias (if color -1 1)) + (test-piece (and (char-valid-p piece) + (upcase piece))) p pos candidates) (cond ;; if the piece is `t', it means to find the candidates resulting @@ -354,56 +353,58 @@ indices which indicate where a piece may have moved from." ;; pawn movement, which is diagonal 1 when taking, but forward ;; 1 or 2 when moving (the most complex piece, actually) - ((= (upcase piece) ?P) + ((= test-piece ?P) (let ((p (chess-pos-piece position target))) (if (if (= p ? ) ;; check for en passant (and (= (chess-index-rank target) (if color 2 5)) - (setq pos (chess-add-index target bias 0)) + (setq pos (chess-incr-index target bias 0)) (chess-pos-piece-p position pos (if color ?p ?P)) ;; make this fail if no en-passant is possible (= (or (chess-pos-en-passant position) 100) target) (setq candidates (list pos))) (if color (> p ?a) (< p ?a))) (let ((cands (list t))) - (setq pos (chess-add-index target (- bias) -1)) + (setq pos (chess-incr-index target (- bias) -1)) (if (and pos (chess-pos-piece-p position pos piece)) (nconc cands (list pos))) - (setq pos (chess-add-index target (- bias) 1)) + (setq pos (chess-incr-index target (- bias) 1)) (if (and pos (chess-pos-piece-p position pos piece)) (nconc cands (list pos))) (if candidates (nconc candidates (cdr cands)) (setq candidates (cdr cands)))) - (if (setq pos (chess-add-index target (- bias) 0)) + (if (setq pos (chess-incr-index target (- bias) 0)) (if (chess-pos-piece-p position pos piece) (setq candidates (list pos)) (when (and (chess-pos-piece-p position pos ? ) (= (if color 4 3) (chess-index-rank target))) - (setq pos (chess-add-index pos (- bias) 0)) + (setq pos (chess-incr-index pos (- bias) 0)) (if (and pos (chess-pos-piece-p position pos piece)) (setq candidates (list pos))))))))) ;; the rook, bishop and queen are the easiest; just look along ;; rank and file and/or diagonal for the nearest pieces! - ((memq (upcase piece) '(?R ?B ?Q)) + ((memq test-piece '(?R ?B ?Q)) (setq candidates (list t)) (dolist (dir (cond - ((= (upcase piece) ?R) + ((= test-piece ?R) '( (-1 0) (0 -1) (0 1) (1 0))) - ((= (upcase piece) ?B) + ((= test-piece ?B) '((-1 -1) (-1 1) (1 -1) (1 1))) - ((= (upcase piece) ?Q) + ((= test-piece ?Q) '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1))))) ;; up the current file - (setq pos (apply 'chess-add-index target dir)) + (setq pos (apply 'chess-incr-index target dir)) + ;; jww (2002-04-11): In Fischer Random castling, the rook can + ;; move in wacky ways (while pos (if (chess-pos-piece-p position pos piece) (progn @@ -411,20 +412,21 @@ indices which indicate where a piece may have moved from." (setq pos nil)) (if (not (chess-pos-piece-p position pos ? )) (setq pos nil) - (setq pos (apply 'chess-add-index pos dir)))))) + (setq pos (apply 'chess-incr-index pos dir)))))) (setq candidates (cdr candidates))) ;; the king is a trivial case of the queen, except when castling - ((= (upcase piece) ?K) + ((= test-piece ?K) (let ((dirs '((-1 -1) (-1 0) (-1 1) (0 -1) (0 1) (1 -1) (1 0) (1 1)))) (while dirs ;; up the current file - (setq pos (apply 'chess-add-index target (car dirs))) + (setq pos (apply 'chess-incr-index target (car dirs))) (if (and pos (chess-pos-piece-p position pos piece)) (setq candidates (list pos) dirs nil) (setq dirs (cdr dirs))))) + (let ((rank (if color 7 0))) ;; if we can still castle, then the king and rook are in their ;; squares; also, make sure that the user is not attempting to @@ -452,14 +454,14 @@ indices which indicate where a piece may have moved from." ;; the knight is a zesty little piece; there may be more than ;; one, but at only one possible square in each direction - ((= (upcase piece) ?N) + ((= test-piece ?N) (setq candidates (list t)) (dolist (dir '((-2 -1) (-2 1) (-1 -2) (-1 2) (1 -2) (1 2) (2 -1) (2 1))) ;; up the current file - (if (and (setq pos (apply 'chess-add-index target dir)) + (if (and (setq pos (apply 'chess-incr-index target dir)) (chess-pos-piece-p position pos piece)) (nconc candidates (list pos)))) (setq candidates (cdr candidates))) diff --git a/chess-sound.el b/chess-sound.el index c8f554c..1854679 100644 --- a/chess-sound.el +++ b/chess-sound.el @@ -37,12 +37,16 @@ :type '(repeat string) :group 'chess-sound) +(defun chess-sound-available-p () + (and (file-directory-p chess-sound-directory) + (file-readable-p (expand-file-name "tap.wav" + chess-sound-directory)) + (or (eq chess-sound-play-function 'play-sound-file) + (file-executable-p chess-sound-program)))) + (defun chess-sound-for-game (game) "Announce the opponent's moves in GAME." - (if (and (file-directory-p chess-sound-directory) - (file-exists-p (expand-file-name "tap.wav" - chess-sound-directory))) - (chess-game-add-hook game 'chess-sound-event-handler))) + (chess-game-add-hook game 'chess-sound-event-handler)) (defun chess-sound (ch) (let ((file @@ -57,8 +61,7 @@ (expand-file-name file chess-sound-directory)))) (defun chess-sound-play (file) - (apply 'call-process chess-sound-program - nil nil nil chess-sound-args)) + (apply 'call-process chess-sound-program nil nil nil chess-sound-args)) (defun chess-sound-event-handler (game ignore event &rest args) "This display module presents a standard chessboard. @@ -76,9 +79,9 @@ See `chess-display-type' for the different kinds of displays." (t-piece (chess-pos-piece pos target)) text) (cond - ((memq :castle changes) + ((chess-ply-has-keyword :castle) (chess-sound "O-O")) - ((memq :long-castle changes) + ((chess-ply-has-keyword :long-castle) (chess-sound "O-O-O")) ((= t-piece ? ) (chess-sound (downcase s-piece)) @@ -88,11 +91,11 @@ See `chess-display-type' for the different kinds of displays." (chess-sound ?x) (chess-sound (downcase t-piece)) (chess-sound target))) - (if (memq :check changes) + (if (chess-ply-has-keyword :check) (chess-sound ?+)) - (if (memq :checkmate changes) + (if (chess-ply-has-keyword :checkmate) (chess-sound ?#)) - (if (memq :stalemate changes) + (if (chess-ply-has-keyword :stalemate) (chess-sound "smate"))))) nil))) diff --git a/chess-var.el b/chess-var.el index a3972af..c33b243 100644 --- a/chess-var.el +++ b/chess-var.el @@ -58,12 +58,10 @@ progress (nil), if it is drawn, resigned, mate, etc." (let ((current-ply (chess-var-ply var)) (changes (chess-ply-changes ply)) (position (chess-ply-pos ply))) + (if (chess-ply-final-p current-ply) + (error "Cannot add moves to a completed game")) (unless (equal position (chess-ply-pos current-ply)) (error "Positions do not match")) - (unless (chess-search-position - position (cadr (chess-ply-changes ply)) - (chess-pos-piece position (car (chess-ply-changes ply)))) - (signal 'chess-illegal "Illegal move")) (chess-ply-set-changes current-ply changes) (chess-var-add-ply var (chess-ply-create (chess-ply-next-pos current-ply))))) @@ -98,11 +98,13 @@ a0 243 "Default engine to be used when starting a chess session." :type 'sexp :group 'chess) -(defcustom chess-announce-module 'chess-announce + (defcustom chess-announce-moves t -This happens verbally if 'festival' is installed, otherwise it just -prints a message in your minibuffer, which works well for Emacspeak -users." + "If non-nil, announce when your opponent makes a move. +This variable can also be a symbol which names a different announcing +module to use. This happens verbally if 'festival' is installed, or +if you have sound files installed and a sound play (see +chess-sound.el). Otherwise it just prints a message in your minibuffer, which works well for Emacspeak users." :type 'boolean :group 'chess) @@ -112,12 +114,20 @@ minibuffer, which works well for Emacspeak users." :type 'string :group 'chess) -(defun chess (&optional arg) - "Start a game of chess." - (interactive "P") +(defun chess (&optional engine) + &rest engine-ctor-args) + "Start a game of chess, playing against ENGINE (a module name)." + (interactive + (list + (if current-prefix-arg + (intern + (concat "chess-" + (let ((str (read-string "Engine to play against: "))) + (if (> (length str) 0) + str + "none")))) chess-default-engine))) - (require chess-default-display) (let* ((my-color t) ; we start out as white always (display (chess-display-create chess-default-display my-color)) @@ -131,17 +141,10 @@ minibuffer, which works well for Emacspeak users." (require 'chess-ics1) (setq display (chess-display-create 'chess-ics1 my-color))) - (chess-display-disable-popup display)) (chess-display-set-game display game) (chess-display-set-main display) - (let ((engine-module - (if arg - (intern - (or (concat "chess-" - (read-string "Engine module to play against: ")) - "chess-none")) - chess-default-engine))) + (let ((engine-module (or engine chess-default-engine))) (let ((engine (chess-engine-create engine-module))) engine-ctor-args))) @@ -151,12 +154,22 @@ minibuffer, which works well for Emacspeak users." ;; computerized engines fall into this category), we need to ;; let them know we're ready to begin (chess-engine-command engine 'ready)) - (when chess-announce-module - (require chess-announce-module) - (funcall (intern (concat (symbol-name chess-announce-module) - "-for-game")) game)))) + + (when chess-announce-moves + (if (and (not (eq chess-announce-moves t)) + (symbolp chess-announce-moves)) + (let ((name (symbol-name chess-announce-moves))) + (require chess-announce-moves) + (if (funcall (intern (concat name "-available-p"))) + (funcall (intern (concat name "-for-game")) game))) + (require 'chess-sound) + (if (chess-sound-available-p) + (chess-sound-for-game game) + (require 'chess-announce) + (if (chess-announce-available-p) (chess-announce-for-game game))))))) - (chess-display-update display t))) + + display)) (cons display engine))) ;;;###autoload @@ -131,7 +131,7 @@ Chess puzzles are most often provided as a set of positions. @c lispfun chess-index-to-coord -@c lispfun chess-add-index +@c lispfun chess-incr-index @subsection Position details |