diff options
| -rw-r--r-- | Makefile | 26 | ||||
| -rw-r--r-- | TODO | 118 | ||||
| -rw-r--r-- | chess-algebraic.el | 165 | ||||
| -rw-r--r-- | chess-auto.el | 119 | ||||
| -rw-r--r-- | chess-auto.in | 10 | ||||
| -rw-r--r-- | chess-crafty.el | 36 | ||||
| -rw-r--r-- | chess-display.el | 455 | ||||
| -rw-r--r-- | chess-fen.el | 113 | ||||
| -rw-r--r-- | chess-game.el | 132 | ||||
| -rw-r--r-- | chess-gnuchess.el | 33 | ||||
| -rw-r--r-- | chess-images.el | 498 | ||||
| -rw-r--r-- | chess-pgn.el | 111 | ||||
| -rw-r--r-- | chess-ply.el | 91 | ||||
| -rw-r--r-- | chess-pos.el | 253 | ||||
| -rw-r--r-- | chess-process.el | 167 | ||||
| -rw-r--r-- | chess-session.el | 49 | ||||
| -rw-r--r-- | chess-standard.el | 218 | ||||
| -rw-r--r-- | chess.el | 130 |
18 files changed, 2724 insertions, 0 deletions
diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..a1eaa78 --- /dev/null +++ b/Makefile @@ -0,0 +1,26 @@ +DIRS = $(shell find . ! -name CVS -type d) +SPECIAL = chess-auto.el +SOURCE = $(filter-out $(SPECIAL),$(shell find -name '*.el')) +TARGET = $(patsubst %.el,%.elc,$(SPECIAL) $(SOURCE)) +EMACS = emacs + +all: $(TARGET) + -rm subdirs.elc + +chess-auto.el: chess-auto.in $(SOURCE) + cp chess-auto.in chess-auto.el + -rm chess-auto.elc + $(EMACS) --no-init-file --no-site-file -batch \ + -l $(shell pwd)/chess-auto \ + -f generate-autoloads \ + $(shell pwd)/chess-auto.el $(DIRS) + +%.elc: %.el + $(EMACS) --no-init-file --no-site-file -batch \ + -f batch-byte-compile $< + +clean: + rm -f $(TARGET) *~ + +fullclean: clean + -rm *.elc chess-auto.el @@ -0,0 +1,118 @@ +* 2.0 + +Write chess-game-to-pgn and chess-pgn-to-game. + +Get keyboard shortcuts working, right now "nf, nf", causes an error. + +* Other + +- Clipboard copy and paste should be global, and occur in this module + +- Port image display code to XEmacs + +- Keep a history of boards, and the moves corresponding with them, so + that the move history can be stepped through forward and back. + +- Allow the user to retract a move when playing against crafty. + +- Tie-in to ics.el, by adding "Internet opponent" to the opponents + list. + +- The ability to read and playback existing PGN files. + +- A way to set the time control, and display its status. + +- After a castle, the rook might place the opponent's king in check. + This is not considered at the moment. + +- After piece promotion, change the piece accordingly and look for + check posibilities (it's done with the pawn at the moment, which is + useless). + +- Handle en passant. + +- Support chess by mail, with direct tie-ins to Gnus/RMAIL. + +- Allow the opponent to give hints. + +- Choose the default image set based on the screen size. + +- Find some prettier image sets. + +- If the chess computer croaks, handle it gracefully. + +- A better way to visually show who's turn it is now? + +- The source have some strings with non-ascii content. + +- In a PGN file, offer the commands: chess-continue, chess-replay, + chess-show-position (which works for whichever sequence the cursor + is in). + +- For modified boards, add a command key to say that it's really black + to play, not white (or vice versa). + +- Multiple game buffer selection is a bit screwy. M-1 M-x chess will + not select the first buffer, for example. Perhaps named games would + be better? + +- Add a command that will load a saved game, continue it, and then + enter a move for whichever color is next to play. This would make + it trivial to add chess drivers to AIM, IRC, etc. The mere command + "!chess johnw37 Nf3" would mean: load the chess game johnw37, and + make my move as Nf3. It would also make chess by e-mail a snap to + implement. + +- Modify etalk's chess.el to use this chess.el as its library. + +- Add an analyze command that will indicate which pieces are defended, + how well, which are attacked, which moves would increase + defense/attack/both, etc. Basically, everything that can be known + about the current board, and one move ahead (on both sides). + +- Add a warning mode that will use the results of an analysis to warn + the user (and ask for confirmation) before doing something that + might lead to an inferior position. + +- Create chess-player.el, which creates persistent objects that + encapsulate information about any player: where he is, his name, his + opponent type, etc. This would maintain a log of games against that + player, their current chess rating, etc. Then, M-x chess would ask + you for a player, not an opponent. + +- When editing the board in display mode (or doing speculative moves), + doing them on a copy of the board with no hook except the display + hook. Then, if you like the result, it call be a `set' on the + original board from the copied board. + +- If moving your opponent's piece is bad, why let you select it in the + first place? Also, don't let them select a blank square. + +- Allow a networked mode that uses the X display protocol to show the + same board on two machines. That way, the guest machine wouldn't + even need to be running Emacs! + +- Once this is in place, one could play games without a log by just + sending the board config and move, back and forth. + +- Add a Map command, that will colorize the squares depending on + whether they are reachable by either side. Green if reachable by + you, Red if by your opponent, and blue if by both. With a prefix + argument, colorize only the squares that have pieces on them. This + is a stable modes that remains in effect until turned off. It also + requires the ability to pass a color to the chessboard highlighting + routine. + +- If a person selects a piece with the mouse, then uses right-click to + designate a target square, display the resulting board without + making a move. This requires copying chessboard-current-board to + chessboard-draft-board. If the user right-clicks without selecting + a piece, it will reset to chessboard-current-board and redraw. + +- Using display-pixel-width, and the images known to be available, + find the largest piece size that will fit. + +- Break out the display code into its own set of modules, then + parameterize the call into them so that alter size and change + directory uses them. Right now those two functions are hard-coded + for image displays. diff --git a/chess-algebraic.el b/chess-algebraic.el new file mode 100644 index 0000000..6e6ba83 --- /dev/null +++ b/chess-algebraic.el @@ -0,0 +1,165 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Convert a ply to/from standard chess algebraic notation +;; +;; A thing to deal with in chess is algebraic move notation, such as +;; Nxf3+. (I leave description of this notation to better manuals +;; than this). This notation is a shorthand way of representing where +;; a piece is moving from and to, by specifying the piece is involved, +;; where it's going, and whether or not a capture or check is +;; involved. +;; +;; You can convert from algebraic notation to a ply (one pair in most +;; cases, but two for a castle) using the following function (NOTE: +;; POSITION determines which side is on move (by calling +;; `chess-pos-side-to-move')): +;; +;; (chess-algebraic-to-ply POSITION STRING) +;; +;; The function also checks if a move is legal, and will raise an +;; error if not. +;; +;; To convert from a ply to algebraic notation, use: +;; +;; (chess-ply-to-algebraic PLY) +;; +;; Castling is determined by the movement of both a king and a rook. +;; +;; Lastly, there is a regexp for quickly checking if a string is in +;; algebraic notation or not, or searching out algebraic strings in a +;; buffer: +;; +;; chess-algebraic-regexp + +;; $Revision$ + +(require 'chess-pos) + +(defconst chess-algebraic-pieces-regexp "[RNBKQ]") + +(defconst chess-algebraic-regexp + (format (concat "\\(" + "O-O\\(-O\\)?\\|" + "\\(%s\\(\\([a-h]\\|[1-8]\\)?\\|[a-h][1-8]\\)\\)?" + "\\([x-]\\)?" + "\\([a-h][1-8]\\)" + "\\(=\\(%s\\)\\)?" + "\\)" + "\\([#+]\\)?") + chess-algebraic-pieces-regexp + chess-algebraic-pieces-regexp) + "A regular expression that matches all possible algebraic moves. +This regexp handles both long and short form.") + +(defun chess-algebraic-to-ply (position move) + "Convert the algebraic notation MOVE for POSITION to a ply." + (when (string-match chess-algebraic-regexp move) + (let* ((piece (aref move 0)) + (mate (match-string 10 move)) + (changes + (if (eq piece ?O) + (let ((rank (if color 7 0)) + (long (= (length (match-string 1 move)) 5))) + (list (chess-rf-to-index rank 4) + (chess-rf-to-index rank (if long 2 6)) + (chess-rf-to-index rank (if long 0 7)) + (chess-rf-to-index rank (if long 3 5)))) + (let ((source (match-string 4 move)) + (target (chess-coord-to-index (match-string 7 move)))) + (if (and source (= (length source) 2)) + (list (chess-coord-to-index source) target) + (let ((color (chess-pos-side-to-move position)) + candidates which) + (unless (< piece ?a) + (setq 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 + (funcall (car chess-modules) nil nil + 'search 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 (cdar candidates) (- source ?a)) + (eq (caar 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 mate + (nconc changes + (list (if (equal mate "#") + ':checkmate + ':check)))) + (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 (null (car (chess-ply-changes ply))) + "" + (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 + (and (= (upcase from-piece) ?K) + (= from (chess-rf-to-index (if color 7 0) 4)) + (if (= to (chess-rf-to-index (if color 7 0) 6)) + "O-O" + (if (= to (chess-rf-to-index (if color 7 0) 2)) + "O-O-O")))) + str + (let ((candidates + (funcall (car chess-modules) + nil nil 'search 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 (cadr promote)))))))))) + (concat notation + (if (memq ':check changes) "+" + (if (memq ':checkmate changes) "#")))))) + +(provide 'chess-algebraic) + +;;; chess-algebraic.el ends here diff --git a/chess-auto.el b/chess-auto.el new file mode 100644 index 0000000..81ec22c --- /dev/null +++ b/chess-auto.el @@ -0,0 +1,119 @@ +;;; -*-emacs-lisp-*- + +(defun generate-autoloads () + (interactive) + (require 'autoload) + (setq generated-autoload-file (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left)) + (batch-update-autoloads)) + +;;; Generated autoloads follow (made by autoload.el). + +;;;### (autoloads (chess-crafty) "chess-crafty" "engines/chess-crafty.el" +;;;;;; (15163 40201)) +;;; Generated autoloads from engines/chess-crafty.el + +(autoload (quote chess-crafty) "chess-crafty" nil nil nil) + +;;;*** + +;;;### (autoloads (chess-gnuchess) "chess-gnuchess" "engines/chess-gnuchess.el" +;;;;;; (15163 40201)) +;;; Generated autoloads from engines/chess-gnuchess.el + +(autoload (quote chess-gnuchess) "chess-gnuchess" nil nil nil) + +;;;*** + +;;;### (autoloads (chess-highlight) "chess-highlight" "tools/chess-highlight.el" +;;;;;; (15160 56560)) +;;; Generated autoloads from tools/chess-highlight.el + +(autoload (quote chess-highlight) "chess-highlight" "\ +This is the module constructor, call with a chess BOARD object. +This function returns an initialized module closure, which is a +function object that maintains the state associated with this call. +It may be called with command symbols in order to influence the +behavior of this module. One symbol which must be accepted is +`shutdown'." nil nil) + +;;;*** + +;;;### (autoloads (chess-ics1) "chess-ics1" "displays/chess-ics1.el" +;;;;;; (15482 53911)) +;;; Generated autoloads from displays/chess-ics1.el + +(autoload (quote chess-ics1) "chess-ics1" "\ +Handle any commands being sent to this instance of this module." nil nil) + +;;;*** + +;;;### (autoloads (chess-images) "chess-images" "displays/chess-images.el" +;;;;;; (15482 53911)) +;;; Generated autoloads from displays/chess-images.el + +(autoload (quote chess-images) "chess-images" "\ +This display module presents a standard chessboard using images." nil nil) + +;;;*** + +;;;### (autoloads (chess-module) "chess-module" "misc/chess-module.el" +;;;;;; (15484 30636)) +;;; Generated autoloads from misc/chess-module.el + +(autoload (quote chess-module) "chess-module" "\ +This is the module constructor, call with a chess GAME object. +This function returns an initialized module closure, which is a +function object that maintains the state associated with this call. +It may be called with command symbols in order to influence the +behavior of this module. One symbol which must be accepted is +`shutdown'." nil nil) + +;;;*** + +;;;### (autoloads (chess-phalanx) "chess-phalanx" "engines/chess-phalanx.el" +;;;;;; (15163 40201)) +;;; Generated autoloads from engines/chess-phalanx.el + +(autoload (quote chess-phalanx) "chess-phalanx" nil nil nil) + +;;;*** + +;;;### (autoloads (chess-plain) "chess-plain" "displays/chess-plain.el" +;;;;;; (15482 53911)) +;;; Generated autoloads from displays/chess-plain.el + +(autoload (quote chess-plain) "chess-plain" "\ +Handle any commands being sent to this instance of this module." nil nil) + +;;;*** + +;;;### (autoloads (chess-module) "chess-speak" "displays/chess-speak.el" +;;;;;; (15478 2520)) +;;; Generated autoloads from displays/chess-speak.el + +(autoload (quote chess-module) "chess-speak" "\ +This is the module constructor, call with a chess BOARD object. +This function returns an initialized module closure, which is a +function object that maintains the state associated with this call. +It may be called with command symbols in order to influence the +behavior of this module. One symbol which must be accepted is +`shutdown'." nil nil) + +;;;*** + +;;;### (autoloads (chess-standard) "chess-standard" "core/chess-standard.el" +;;;;;; (15484 32658)) +;;; Generated autoloads from core/chess-standard.el + +(autoload (quote chess-standard) "chess-standard" nil nil nil) + +;;;*** + +;;;### (autoloads (chess) "chess" "chess.el" (15486 56060)) +;;; Generated autoloads from chess.el + +(autoload (quote chess) "chess" "\ +Start a game of chess." t nil) + +;;;*** diff --git a/chess-auto.in b/chess-auto.in new file mode 100644 index 0000000..24c40f1 --- /dev/null +++ b/chess-auto.in @@ -0,0 +1,10 @@ +;;; -*-emacs-lisp-*- + +(defun generate-autoloads () + (interactive) + (require 'autoload) + (setq generated-autoload-file (car command-line-args-left)) + (setq command-line-args-left (cdr command-line-args-left)) + (batch-update-autoloads)) + +;;; Generated autoloads follow (made by autoload.el). diff --git a/chess-crafty.el b/chess-crafty.el new file mode 100644 index 0000000..51ca30a --- /dev/null +++ b/chess-crafty.el @@ -0,0 +1,36 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Play against the crafty engine +;; +;; $Revision$ + +(require 'chess-process) + +(defgroup chess-crafty nil + "Interface code for playing against crafty. Uses `chess-process'." + :group 'chess) + +(defcustom chess-crafty-command "crafty" + "The name of the crafty program." + :type 'string + :group 'chess-crafty) + +;;;###autoload +(defun chess-crafty (game) + (chess-process game 'chess-crafty-handler nil + (if (file-name-absolute-p chess-crafty-command) + chess-crafty-command + (executable-find chess-crafty-command)))) + +;;; Code: + +(defun chess-crafty-handler (game buffer command &rest args) + (unless (apply 'chess-process-handler game buffer command args) + (ignore + (if (eq command 'initialize) + (process-send-string (get-buffer-process buffer) + "alarm off\nansi off\n"))))) + +(provide 'chess-crafty) + +;;; chess-crafty.el ends here diff --git a/chess-display.el b/chess-display.el new file mode 100644 index 0000000..bbb2035 --- /dev/null +++ b/chess-display.el @@ -0,0 +1,455 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Code shared by all chess displays +;; +;; $Revision$ + +;;; Code: + +(require 'chess-game) + +(defgroup chess-display nil + "Common code used by chess displays." + :group 'chess) + +(defcustom chess-display-use-faces t + "If non-nil, provide colored faces for ASCII displays." + :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) + +(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) + +(defvar chess-display-draw-function nil) +(defvar chess-display-highlight-function nil) + +(make-variable-buffer-local 'chess-display-draw-function) +(make-variable-buffer-local 'chess-display-highlight-function) + +;;; Code: + +(defun chess-display (session buffer event &rest args) + "This display module presents a standard chessboard. +See `chess-display-type' for the different kinds of displays." + (cond + ((eq event 'initialize) + (let ((buf (generate-new-buffer "*Chessboard*"))) + (with-current-buffer buf + (setq chess-display-draw-function (car args) + chess-display-highlight-function (cadr args) + chess-display-perspective + (chess-session-data session 'my-color)) + (chess-display-mode) + buf))) + ((eq event 'shutdown) + (ignore + (if (buffer-live-p buffer) + (kill-buffer buffer)))) + (t + (ignore + (with-current-buffer buffer + (cond + ((eq event 'setup) + (setq chess-display-game (car args) + chess-display-game-index (chess-game-index (car args)) + chess-display-position (chess-game-pos (car args))) + (funcall chess-display-draw-function)) + + ((eq event 'highlight) + ;; if they are unselecting the piece, just redraw + (if (eq (nth 2 args) 'unselected) + (funcall chess-display-draw-function) + (apply chess-display-highlight-function args))) + + ((eq event 'move) + (assert (eq chess-display-game + (chess-session-data session 'current-game))) + (setq chess-display-game-index (chess-game-index chess-display-game) + chess-display-position (chess-game-pos chess-display-game)) + (funcall chess-display-draw-function)) + + (t + (funcall chess-display-draw-function))) + + (chess-display-set-modeline)))))) + +(defvar chess-display-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (set-keymap-parent map nil) + + (define-key map [(control ?i)] 'chess-display-invert) + (define-key map [tab] 'chess-display-invert) + + (define-key map [??] 'describe-mode) + (define-key map [?C] 'chess-display-clear-board) + (define-key map [?E] 'chess-display-edit-board) + (define-key map [?G] 'chess-display-restore-board) + (define-key map [?F] 'chess-display-set-from-fen) + (define-key map [?I] 'chess-display-invert) + (define-key map [?S] 'chess-display-send-board) + (define-key map [?X] 'chess-display-quit) + (define-key map [?M] 'chess-display-manual-move) + + (define-key map [?<] 'chess-display-move-backward) + (define-key map [?,] 'chess-display-move-backward) + (define-key map [(meta ?<)] 'chess-display-move-first) + (define-key map [?>] 'chess-display-move-forward) + (define-key map [?.] 'chess-display-move-forward) + (define-key map [(meta ?>)] 'chess-display-move-last) + + (define-key map [(meta ?w)] 'chess-display-copy-board) + (define-key map [(control ?y)] 'chess-display-paste-board) + + (define-key map [(control ?l)] 'chess-display-redraw) + + (dolist (key '(?a ?b ?c ?d ?e ?f ?g ?h + ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 + ?r ?n ?b ?q ?k ?o)) + (define-key map (vector key) 'chess-keyboard-shortcut)) + (define-key map [backspace] 'chess-keyboard-shortcut-delete) + +;; (let ((keys '(? ?p ?r ?n ?b ?q ?k ?P ?R ?N ?B ?Q ?K))) +;; (while keys +;; (define-key map (vector (car keys)) 'chess-display-set-piece) +;; (setq keys (cdr keys)))) + + (define-key map [(control ?m)] 'chess-display-select-piece) + (define-key map [return] 'chess-display-select-piece) + (cond + ((featurep 'xemacs) + (define-key map [(button1)] 'chess-display-mouse-select-piece) + (define-key map [(button2)] 'chess-display-mouse-select-piece)) + (t + (define-key map [mouse-1] 'chess-display-mouse-select-piece) + (define-key map [mouse-2] 'chess-display-mouse-select-piece))) + map) + "The mode map used in a chessboard display buffer.") + +(defvar chess-display-game) +(defvar chess-display-game-index) +(defvar chess-display-position) +(defvar chess-display-perspective) +(defvar chess-display-mode-line "") + +(make-variable-buffer-local 'chess-display-game) +(make-variable-buffer-local 'chess-display-game-index) +(make-variable-buffer-local 'chess-display-position) +(make-variable-buffer-local 'chess-display-perspective) +(make-variable-buffer-local 'chess-display-mode-line) + +(defun chess-display-mode () + "A mode for displaying and interacting with a chessboard. +The key bindings available in this mode are: +\\{chess-display-mode-map}" + (interactive) + (setq major-mode 'chess-display-mode mode-name "Chessboard") + (use-local-map chess-display-mode-map) + (buffer-disable-undo) + (setq buffer-auto-save-file-name nil + mode-line-format 'chess-display-mode-line)) + +(defun chess-display-set-modeline () + "Set the modeline to reflect the current game position." + (let ((color (chess-index-side-to-move chess-display-game-index)) + (index chess-display-game-index)) + (if (= index 1) + (setq chess-display-mode-line + (format " %s START" (if color "White" "BLACK"))) + (setq chess-display-mode-line + (concat + " " (if color "White" "BLACK") + " " (int-to-string (if (> index 1) + (/ index 2) (1+ (/ index 2)))) + ". " (if color "... ") + (chess-ply-to-algebraic + (chess-game-ply chess-display-game index))))))) + +(defsubst chess-display-current-p () + "Return non-nil if the displayed chessboard reflects the current game. +This means that no editing is being done." + (eq chess-display-position + (chess-game-pos chess-display-game))) + +(defun chess-display-invert () + "Invert the perspective of the current chess board." + (interactive) + (setq chess-display-perspective (not chess-display-perspective)) + (funcall chess-display-draw-function)) + +(defun chess-display-edit-board () + "Setup the current board for editing." + (interactive) + (when (chess-display-current-p) + (setq chess-display-position + (chess-pos-copy (chess-game-pos chess-display-game))) + (message "Now editing board, use S to send..."))) + +(defun chess-display-restore-board () + "Setup the current board for editing." + (interactive) + (setq chess-display-position (chess-game-pos chess-display-game) + chess-display-game-index (chess-game-index chess-display-game)) + (funcall chess-display-draw-function)) + +(defun chess-display-clear-board () + "Setup the current board for editing." + (interactive) + (when (y-or-n-p "Really clear the chessboard? ") + (chess-display-edit-board) + (dotimes (rank 8) + (dotimes (file 8) + (chess-pos-set-piece chess-display-position (cons rank file) ? ))) + (funcall chess-display-draw-function))) + +(defun chess-display-set-from-fen (fen) + "Send the current board configuration to the user." + (interactive "sSet from FEN string: ") + (setq chess-display-position (chess-fen-to-pos fen)) + (funcall chess-display-draw-function)) + +(defun chess-display-send-board () + "Send the current board configuration to the user." + (interactive) + (chess-session-event chess-current-session 'setup + (chess-game-create nil chess-display-position))) + +(defun chess-display-copy-board () + "Send the current board configuration to the user." + (interactive) + (let* ((x-select-enable-clipboard t) + (fen (chess-fen-from-pos chess-display-position))) + (kill-new fen) + (message "Copied board: %s" fen))) + +(defun chess-display-paste-board () + "Send the current board configuration to the user." + (interactive) + (let* ((x-select-enable-clipboard t) + (fen (current-kill 0))) + ;; jww (2001-06-26): not yet implemented + (message "Pasted board: %s" fen))) + +(defun chess-display-redraw () + "Just redraw the current display." + (interactive) + (funcall chess-display-draw-function)) + +(defun chess-display-set-piece () + "Set the piece under point to command character, or space for clear." + (interactive) + (unless (chess-display-current-p) + (chess-pos-set-piece chess-display-position + (get-text-property (point) 'chess-coord) + last-command-char) + (funcall chess-display-draw-function))) + +(defun chess-display-quit () + "Quit the current game." + (interactive) + (chess-session-event chess-current-session 'shutdown)) + +(defun chess-display-manual-move (move) + "Move a piece manually, using chess notation." + (interactive + (list (read-string + (format "%s(%d): " + (if (chess-pos-side-to-move chess-display-position) + "White" "Black") + (1+ (/ chess-display-game-index 2)))))) + (chess-session-event chess-current-session 'move + (chess-algebraic-to-ply chess-display-position))) + +(defun chess-display-set-current (dir) + "Change the currently displayed board. +Direction may be - or +, to move forward or back, or t or nil to jump +to the end or beginning." + (let ((index (cond ((eq dir ?-) (1- chess-display-game-index)) + ((eq dir ?+) (1+ chess-display-game-index)) + ((eq dir t) nil) + ((eq dir nil) 1)))) + (setq chess-display-position + (or (chess-game-pos chess-display-game index) + (error "You are already at the first or last position")) + chess-display-game-index + (or index (chess-game-index chess-display-game))) + (funcall chess-display-draw-function) + (chess-display-set-modeline) + (if (chess-display-current-p) + (message "This is the current position") + (message "Use G or M-> to return to the current position")))) + +(defun chess-display-move-backward () + (interactive) + (chess-display-set-current ?-)) + +(defun chess-display-move-forward () + (interactive) + (chess-display-set-current ?+)) + +(defun chess-display-move-first () + (interactive) + (chess-display-set-current nil)) + +(defun chess-display-move-last () + (interactive) + (chess-display-set-current t)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Allow for quick entry of algebraic moves via keyboard +;; + +(defvar chess-move-string nil) +(defvar chess-legal-moves-pos nil) +(defvar chess-legal-moves nil) + +(defun chess-keyboard-shortcut-delete () + (interactive) + (setq chess-move-string + (substring chess-move-string 0 + (1- (length chess-move-string))))) + +(defun chess-keyboard-shortcut (&optional display-only) + (interactive) + (unless (memq last-command '(chess-keyboard-shortcut + chess-keyboard-shortcut-delete)) + (setq chess-move-string nil)) + (unless display-only + (setq chess-move-string + (concat chess-move-string + (char-to-string (downcase last-command-char))))) + (unless (and chess-legal-moves + (eq chess-display-position chess-legal-moves-pos)) + (setq chess-legal-moves-pos chess-display-position + chess-legal-moves + (sort (mapcar 'chess-ply-to-algebraic + (chess-legal-plies chess-display-position + (chess-pos-side-to-move + chess-display-position))) + 'string-lessp))) + (let ((moves + (mapcar (function + (lambda (move) + (let ((i 0) (x 0) + (l (length move)) + (xl (length chess-move-string)) + (match t)) + (unless (or (and (equal chess-move-string "ok") + (equal move "O-O")) + (and (equal 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))))) + (if match move)))) + chess-legal-moves))) + (setq moves (delq nil moves)) + (cond + ((= (length moves) 1) + (chess-session-event chess-current-session 'move + (chess-algebraic-to-ply + chess-display-position (car moves))) + (setq chess-move-string nil + chess-legal-moves nil + chess-legal-moves-pos nil)) + ((null moves) + (setq chess-move-string + (substring chess-move-string 0 + (1- (length chess-move-string))))) + (t + (message "[%s] %s" chess-move-string + (mapconcat 'identity moves " ")))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; 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))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; 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 () + "Select the piece under the cursor. +Clicking once on a piece selects it; then click on the target location." + (interactive) + (let ((coord (get-text-property (point) 'chess-coord))) + (when coord + (if chess-display-last-selected + (let ((last-sel chess-display-last-selected) + move-error) + ;; if they select the same square again, just deselect it + (if (/= (point) (car last-sel)) + (if (chess-display-current-p) + (chess-session-event + chess-current-session 'move + (chess-ply-create chess-display-position + (cadr last-sel) coord)) + (chess-pos-move chess-display-position + (cadr last-sel) coord) + (funcall chess-display-draw-function)) + ;; put the board back to rights + (funcall chess-display-draw-function)) + (setq chess-display-last-selected nil) + (when move-error + (funcall chess-display-draw-function) + (error (error-message-string move-error)))) + (setq chess-display-last-selected (list (point) coord)) + ;; just as in a normal chess game, if you touch the piece, your + ;; opponent will see this + (if (chess-display-current-p) + (chess-session-event chess-current-session + 'highlight (point) coord 'selected) + (funcall chess-display-highlight-function + (point) coord 'selected)))))) + +(defun chess-display-mouse-select-piece (event) + "Select the piece the user clicked on." + (interactive "e") + (cond ((fboundp 'event-window) ; XEmacs + (set-buffer (window-buffer (event-window event))) + (and (event-point event) (goto-char (event-point event)))) + ((fboundp 'posn-window) ; Emacs + (set-buffer (window-buffer (posn-window (event-start event)))) + (goto-char (posn-point (event-start event))))) + (chess-display-select-piece)) + +(provide 'chess-display) + +;;; chess-display.el ends here diff --git a/chess-fen.el b/chess-fen.el new file mode 100644 index 0000000..8ef7ccb --- /dev/null +++ b/chess-fen.el @@ -0,0 +1,113 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Convert a chess position to/from FEN notation +;; +;; FEN notation encodes a chess position using a simple string. The +;; format is: +;; +;; POSITION SIDE FLAGS +;; +;; The POSITION gives all eight ranks, by specifying a letter for each +;; piece on the position, and a number for any intervening spaces. +;; Trailing spaces need not be counted. Uppercase letters signify +;; white, and lowercase black. For example, if your position only had +;; a black king on d8, your POSITION string would be: +;; +;; 3k//////// +;; +;; For the three spaces (a, b and c file), the black king, and then +;; all the remaining ranks (which are all empty, so their spaces can +;; be ignored). +;; +;; The SIDE is w or b, to indicate whose move it is. +;; +;; The FLAGS can contain K, Q, k or q, to signify whether the white or +;; black king can still castle on the king or queen side. You can +;; also have coordinates, such as e4, a5, to specify which pawns may +;; be captured by en passant. +;; +;; The starting chess position always looks like this: +;; +;; rnbqkbnr/pppppppp/////PPPPPPPP/RNBQKBNR/ w KQkq - +;; +;; And in "full" mode (where all spaces are accounted for): +;; +;; rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq - +;; +;; It may also have the current game sequence appended, but this +;; relate to the game, not the position. +;; +;; $Revision$ + +(require 'chess-pos) + +(defun chess-fen-to-pos (fen) + "Convert a FEN-like notation string to a chess position." + (let ((i 0) (l (length fen)) + (rank 0) (file 0) (c ?0) + (position (chess-pos-create t)) + number) + (while (and (/= 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 ? ) + (chess-pos-set-piece position (chess-rf-to-index rank file) c) + (setq file (1+ file)))) + (setq i (1+ i))) + (chess-pos-set-side-to-move position (= (aref fen i) ?w)) + (setq i (+ i 2) number nil) + (while (< i l) + (setq c (aref fen i)) + (cond + ((= c ?K) (chess-pos-set-can-castle position ?K t)) + ((= c ?Q) (chess-pos-set-can-castle position ?Q t)) + ((= c ?k) (chess-pos-set-can-castle position ?k t)) + ((= c ?q) (chess-pos-set-can-castle position ?q t)) + ((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))) + position)) + +(defun chess-pos-to-fen (position &optional full) + "Convert a chess POSITION to FEN-like notation. +If FULL is non-nil, represent trailing spaces as well." + (let ((blank 0) (str "") output) + (dotimes (rank 8) + (dotimes (file 8) + (let ((p (chess-pos-piece position (chess-rf-to-index rank file)))) + (if (= p ? ) + (setq blank (1+ blank)) + (if (> blank 0) + (setq blank 0 str (concat str (int-to-string blank)))) + (setq str (concat str (char-to-string p)))))) + (if (and full (> blank 0)) + (setq str (concat str (int-to-string blank)))) + (setq blank 0 str (concat str "/"))) + (setq str (if (chess-pos-side-to-move position) + (concat str " w ") + (concat str " b "))) + (if (chess-pos-can-castle position ?K) + (setq str (concat str "K") output t)) + (if (chess-pos-can-castle position ?Q) + (setq str (concat str "Q") output t)) + (if (chess-pos-can-castle position ?k) + (setq str (concat str "k") output t)) + (if (chess-pos-can-castle position ?q) + (setq str (concat str "q") output t)) + (if output + (setq str (concat str " ")) + (setq str (concat str "- "))) + (let ((index (chess-pos-en-passant position))) + (if index + (concat str (chess-index-to-coord index)) + (concat str "-"))))) + +(provide 'chess-fen) + +;;; chess-fen.el ends here diff --git a/chess-game.el b/chess-game.el new file mode 100644 index 0000000..c48816a --- /dev/null +++ b/chess-game.el @@ -0,0 +1,132 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Maintain a chess game that is being played or viewed +;; +;; $Revision$ + +;;; Commentary: + +;; A chess game is represented by a set of tags that describe the +;; game, and a list of plies representing the main variation. + +(require 'chess-ply) + +(defconst chess-game-default-tags + (list '("Event" . "Computer chess game") + '("Round" . "-") + (cons "Site" (system-name)) + '("White" . "?") + '("Black" . "?") + '("Result" . "*") + '("TimeControl" . "-"))) + +(defsubst chess-game-tags (game) + "Return the tags alist associated with GAME." + (car game)) + +(defsubst chess-game-set-tags (game tags) + "Return the tags alist associated with GAME." + (setcar game tags)) + +(defsubst chess-game-plies (game) + "Return the tags alist associated with GAME." + (cdr game)) + +(defsubst chess-game-set-plies (game plies) + "Return the tags alist associated with GAME." + (setcdr game plies)) + +(defsubst chess-game-tag (game tag) + "Return the value for TAG in GAME." + (let ((tags (chess-game-tags game))) + (and tags (cdr (assoc tag tags))))) + +(defun chess-game-set-tag (game tag value) + "Set a TAG for GAME to VALUE." + (let ((tags (chess-game-tags game))) + (if (null tags) + (setcar game (list (cons tag value))) + (let ((entry (assoc tag tags))) + (if entry + (setcdr entry value) + (nconc (car game) + (list (cons tag value)))))))) + +(defun chess-game-del-tag (game tag) + "Set a TAG for GAME to VALUE." + (setcar game (assq-delete-all tag (chess-game-tags game)))) + +(defsubst chess-game-index (game) + "Return the GAME's current position index." + (length (cdr game))) + +(defsubst chess-index-side-to-move (index) + "Return the color of the side which has the move." + (= (mod index 2) 1)) + +(defsubst chess-game-seq (game) + "Return the current GAME sequence." + (1+ (/ (chess-game-index game) 2))) + +(defsubst chess-game-side-to-move (game) + "Return the color of the side which has the move." + (chess-index-side-to-move (chess-game-index game))) + +(defun chess-game-move-color (game &optional invert) + "Return the capitalized color name associated with the side to move." + (if (if (chess-game-side-to-move game) + (not invert) invert) + "White" "Black")) + +(defun chess-game-ply (game &optional index) + "Return the position related to GAME's INDEX position." + (if index + (nth index (cdr game)) + (car (last (cdr game))))) + +(defun chess-game-pos (game &optional index) + "Return the position related to GAME's INDEX position." + (car (chess-game-ply game index))) + +(defun chess-game-create (&optional tags position) + "Create a new chess game object. +If TAGS is non-nil, it is a list of cons cell that define starting +tags to use. If POSITION is non-nil, the game starts at that +position." + (let ((game (cons nil nil))) + (dolist (tag chess-game-default-tags) + (chess-game-set-tag game (car tag) (cdr tag))) + (chess-game-set-tag game "Date" (format-time-string "%Y.%m.%d")) + (dolist (tag tags) + (chess-game-set-tag game (car tag) (cdr tag))) + (setcdr game (list (chess-ply-create + (or position (chess-pos-create))))) + game)) + +(defun chess-game-move (game ply) + "Make a move in the current GAME, from FROM to TO. +This creates a new position and adds it to the main variation. +The 'changes' of the last ply reflect whether the game is currently in +progress (nil), if it is drawn, resigned, mate, etc." + (let ((current-ply (chess-game-ply game)) + (changes (chess-ply-changes ply))) + (assert (equal (chess-ply-pos current-ply) (chess-ply-pos ply))) + (chess-ply-set-changes current-ply changes) + (cond + ((or (memq ':draw changes) + (memq ':perpetual changes) + (memq ':repetition changes) + (memq ':stalemate changes)) + (chess-game-set-tag game "Result" "1/2-1/2")) + ((or (memq ':resign changes) + (memq ':checkmate changes)) + (chess-game-set-tag game "Result" + (if (chess-game-side-to-move game) + "0-1" "1-0"))) + (t (nconc (cdr game) + (list (chess-ply-create + (chess-ply-next-pos current-ply)))))))) + +(provide 'chess-game) + +;;; chess-game.el ends here diff --git a/chess-gnuchess.el b/chess-gnuchess.el new file mode 100644 index 0000000..1031f4f --- /dev/null +++ b/chess-gnuchess.el @@ -0,0 +1,33 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Play against the gnuchess engine +;; +;; $Revision$ + +(require 'chess-process) + +(defgroup chess-gnuchess nil + "Interface code for playing against gnuchess. Uses `chess-process'." + :group 'chess) + +(defcustom chess-gnuchess-command "gnuchess" + "The name of the gnuchess program." + :type 'string + :group 'chess-gnuchess) + +;;;###autoload +(defun chess-gnuchess (game) + (chess-process + game nil + (list (list (concat "My move is : \\(" chess-algebraic-regexp "\\)") + (function + (lambda (move) + (chess-game-move chess-process-game move nil))) 1) + '("Illegal move:" (error "Illegal move"))) + (if (file-name-absolute-p chess-gnuchess-command) + chess-gnuchess-command + (executable-find chess-gnuchess-command)))) + +(provide 'chess-gnuchess) + +;;; chess-gnuchess.el ends here diff --git a/chess-images.el b/chess-images.el new file mode 100644 index 0000000..10d1821 --- /dev/null +++ b/chess-images.el @@ -0,0 +1,498 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Display a chessboard using graphical images +;; +;; $Revision$ + +;;; Commentary: + +;; In addition to what all displays offer, the images display adds a +;; few commands: +;; +;; ^ increase the size of the display (if larger pieces exist) +;; V decrease the size of the display (if smaller pieces exist) +;; D use pieces from another directory +;; +;; When using pieces from another directory, they will be loaded and +;; displayed immediately, allowing you to easily browse among +;; different piece sets if you have them (such as the ZIICS set, see +;; the xboard man page). + +(require 'chess-display) + +(defgroup chess-images nil + "Module for drawing a chess-display using graphical images." + :group 'chess-display) + +(defvar chess-images-cache nil) + +(defun chess-images-clear-image-cache (sym value) + (set sym value) + (setq chess-images-cache nil)) + +(defcustom chess-images-separate-frame (display-multi-frame-p) + "If non-nil, display the chessboard in its own frame." + :type 'boolean + :group 'chess-images) + +(defcustom chess-images-directory + (if (file-directory-p "/usr/share/games/xboard/pixmaps") + "/usr/share/games/xboard/pixmaps" + (expand-file-name "pixmaps" (file-name-directory + (or load-file-name buffer-file-name)))) + "Directory containing the chess piece bitmap images. +You are free to use your own chess pieces, of any size. By default, I +assume you have xboard installed, or can go get the pixmaps that come +with xboard. I am not an artist, and have not taken the time to draw +my own set of pieces. + +If you want to draw your own images, each piece must be named +COLOR-PIECE.EXT, where COLOR is either black or white, and PIECE is +one of rook, knight, bishop, queen, king or pawn. + +At the moment only XPM has been tested, and I'm afraid it's probably +the only one that will work. ImageMagick can be used to convert other +graphics formats into XPM for you. + +Each piece must define the background color to use the symbolic color +name \"background\", so that the chess program can use the same pieces +for all squares. If you want really custom pieces, you can use the +symbolic colors dark_square, light_square and dark_piece and +light_piece." + :type 'directory + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-background-image "blank" + "The name of the file used for background squares. +This file is optional. If there is no file available by this name, a +solid color square will be created and used. This option exists so +that specialized squares may be used such as marble tiles, etc. +jww (2001-06-23): This is still not fully implemented." + :type 'file + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-border-color (cdr (assq 'background-color + (frame-parameters))) + "Color to use for the border around pieces." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-dark-color + (if (display-color-p) "#77a26d" "gray60") + "Color to use for \"dark\" background squares." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-light-color + (if (display-color-p) "#c8c365" "gray80") + "Color to use for \"light\" background squares." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-black-color + (if (display-color-p) "#202020" "gray0") + "Color to use for \"black\" pieces." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-white-color + (if (display-color-p) "#ffffcc" "gray100") + "Color to use for \"white\" pieces." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-highlight-color + (if (display-color-p) "#add8e6" "gray90") + "Color to use for highlighting pieces that have been selected." + :type 'color + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-extension "xpm" + "The file extension used for chess display bitmaps." + :type 'file + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defcustom chess-images-border-width 2 + "This defines the width of the border that surrounds each piece." + :type '(choice integer (const :tag "No border" nil)) + :set 'chess-images-clear-image-cache + :group 'chess-images) + +(defun chess-images (game) + "A chessboard display that uses graphical images." + (chess-display game 'chess-images-handler + )) + +;;; 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.") + +(defvar chess-images-size nil) + +;;;###autoload +(defun chess-images (session buffer event &rest args) + "This display module presents a standard chessboard using images." + (if (not (eq event 'initialize)) + (apply 'chess-display session buffer event args) + (with-current-buffer + (chess-display session buffer event + 'chess-images-draw 'chess-images-highlight) + + (let ((map (current-local-map))) + (define-key map [?^] 'chess-images-increase-size) + (define-key map [?V] 'chess-images-decrease-size) + (define-key map [?D] 'chess-images-set-directory)) + + (setq chess-images-size + (chess-images-best-size (- (display-pixel-height) 20) + (- (display-pixel-width) 20)) + chess-images-cache nil) + + (current-buffer)))) + +(defun chess-images-popup-board () + (let* ((size (float (+ (* (or chess-images-border-width 0) 8) + (* chess-images-size 8)))) + (max-char-height (ceiling (/ size (frame-char-height)))) + (max-char-width (ceiling (/ size (frame-char-width))))) + + (if chess-images-separate-frame + ;; make room for the possible title bar and other + ;; decorations + (progn + (select-frame + (make-frame (list (cons 'name "*Chessboard*") + (cons 'height (+ max-char-height 2)) + (cons 'width max-char-width)))) + (set-window-dedicated-p (selected-window) t)) + (pop-to-buffer (current-buffer)) + (set-window-text-height (get-buffer-window (current-buffer)) + max-char-height)))) + +(defun chess-images-draw () + "Draw the given chess BOARD." + (if (null (get-buffer-window (current-buffer) t)) + (chess-images-popup-board)) + (let* ((inhibit-redisplay t) + (board chess-display-position) + (inverted (null chess-display-perspective)) + (rank (if inverted 7 0)) + (file (if inverted 7 0)) + (pos (point)) new beg) + (unless chess-images-cache + (chess-images-init-cache) + (erase-buffer)) + (unless (setq new (= (point-min) (point-max))) + (goto-char (point-min))) + (while (if inverted (>= rank 0) (< rank 8)) + (while (if inverted (>= file 0) (< file 8)) + (let* ((piece (chess-pos-piece board + (chess-rf-to-index rank file))) + (image + (if (= piece ? ) + (aref chess-images-cache + (+ 2 (if (= 0 (mod rank 2)) + (- 1 (mod file 2)) + (mod file 2)))) + (aref (aref (aref chess-images-cache + (if (> piece ?a) 0 1)) + (if (= 0 (mod rank 2)) + (- 1 (mod file 2)) + (mod file 2))) + (nth 2 (assq (downcase piece) + chess-images-piece-names)))))) + (if (not new) + (progn + (put-text-property (point) (1+ (point)) 'display image) + (unless (= (1+ (point)) (point-max)) + (forward-char 2))) + (setq beg (point)) + (insert-image image) + (if (= file (if inverted 0 7)) + (unless (= rank (if inverted 0 7)) + (insert ?\n)) + (insert-image (aref chess-images-cache 5))) + (add-text-properties + beg (point) (list 'intangible (chess-rf-to-index rank file) + 'rear-nonsticky '(intangible) + 'chess-coord (chess-rf-to-index rank file))))) + (setq file (if inverted (1- file) (1+ file)))) + (setq file (if inverted 7 0) + rank (if inverted (1- rank) (1+ rank)))) + (set-buffer-modified-p nil) + (goto-char pos))) + +(defun chess-images-highlight (pos index &optional mode) + "Highlight the piece on BOARD at INDEX, using the given MODE. +Common modes are: + `selected' show that the piece has been selected for movement. + `unselected' show that the piece has been unselected." + (if (null (get-buffer-window (current-buffer) t)) + (chess-images-popup-board)) + (let ((highlight (copy-alist (get-text-property pos 'display)))) + (setcar (last highlight) + (list (cons "light_square" chess-images-highlight-color) + (cons "dark_square" chess-images-highlight-color) + (cons "background" chess-images-highlight-color))) + (put-text-property pos (1+ pos) 'display highlight))) + +(defvar chess-images-sizes nil) + +(defun chess-images-alter-size (test) + (let ((sizes chess-images-sizes)) + (if (eq test '<) + (setq sizes (reverse sizes))) + (while sizes + (if (funcall test (car sizes) chess-images-size) + (progn + (setq chess-images-size (car sizes) + chess-images-cache nil + sizes nil) + (chess-images-draw) + (if chess-images-separate-frame + (let* ((size (float (+ (* (or chess-images-border-width 0) 8) + (* chess-images-size 8)))) + (max-char-height (ceiling (/ size (frame-char-height)))) + (max-char-width (ceiling (/ size (frame-char-width))))) + (set-frame-size (selected-frame) + max-char-width + (+ max-char-height 2))))) + (setq sizes (cdr sizes)))))) + +(defun chess-images-increase-size () + "Increase the size of the pieces on the board." + (interactive) + (chess-images-alter-size '>)) + +(defun chess-images-decrease-size () + "Increase the size of the pieces on the board." + (interactive) + (chess-images-alter-size '<)) + +(defun chess-images-sizes () + "Return the set of available sizes for the current piece set. +They are returned in ascending order, or nil for no sizes available." + (let ((file (expand-file-name (format "black-rook.%s" + chess-images-extension) + chess-images-directory))) + (if (file-readable-p file) + (with-temp-buffer + (insert-file-contents-literally file) + (re-search-forward "\"\\([0-9]+\\)") + (setq chess-images-sizes (list (string-to-int (match-string 1))))) + (let (sizes) + (dolist (file (directory-files chess-images-directory nil + (format "rdd[0-9]+\\.%s" + chess-images-extension))) + (if (string-match "rdd\\([0-9]+\\)\\." file) + (push (string-to-int (match-string 1 file)) sizes))) + (setq chess-images-sizes (sort sizes '<)))))) + +(defun chess-images-best-size (&optional height width) + "Return the piece size that works best for a window of HEIGHT." + (let* ((size (min (- (/ (or height (frame-pixel-height)) 8) + (or chess-images-border-width 0)) + (- (/ (or width (frame-pixel-width)) 8) + (or chess-images-border-width 0)))) + (sizes (chess-images-sizes)) + (last (car sizes))) + (while sizes + (if (> (car sizes) size) + (setq sizes nil) + (setq last (car sizes) + sizes (cdr sizes)))) + last)) + +(defun chess-images-set-directory (directory) + "Increase the size of the pieces on the board." + (interactive "DUse chess pieces in: ") + (setq chess-images-directory directory + chess-images-size (chess-images-best-size) + chess-images-cache nil) + (chess-images-alter-size '=)) + +(defun chess-images-create-xpm (height &optional width) + (with-temp-buffer + (insert "/* XPM */\n") + (insert "static char *chessdotel[] = {\n") + (insert "/* columns rows colors chars-per-pixel */\n") + (insert (format "\"%d %d 2 1\",\n" (or width height) height)) + (insert "\" c black s void\",\n") + (insert "\". c white s background\",\n") + (insert "/* pixels */\n") + (dotimes (i height) + (insert ?\" (make-string (or width height) ?.) ?\" ?, ?\n)) + (delete-backward-char 2) + (insert "\n};\n") + (buffer-string))) + +(defun chess-images-hack-xpm (file add-height color) + "Hack an XPM to append ADD-HEIGHT rows of COLOR. +This is necessary for bizzare Emacs reasons." + (with-temp-buffer + (if (string-match "\\`/\\* XPM \\*/" file) + (insert file) + (insert-file-contents-literally file)) + (goto-char (point-min)) + (if (re-search-forward (concat "\"\\([0-9]+\\)\\s-+\\([0-9]+\\)\\s-+" + "\\([0-9]+\\)\\s-+\\([0-9]+\\)\"") nil t) + (let* ((width (string-to-int (match-string 1))) + (height (string-to-int (match-string 2))) + (colors (string-to-int (match-string 3))) + (chars-per-color (string-to-int (match-string 4))) + (color-char (make-string chars-per-color ?~))) + (replace-match (int-to-string (+ height add-height)) t t nil 2) + (unless + (save-match-data + (save-excursion + (if (re-search-forward + (format "^\"\\(..\\)\\s-*c\\s-+%s" color) nil t) + (setq color-char + (substring (match-string 1) 0 chars-per-color))))) + (replace-match (int-to-string (1+ colors)) t t nil 3) + (end-of-line) + (insert "\n\"" color-char "\tc " color "\",")) + (beginning-of-line) + (forward-line (1+ colors)) + (while (looking-at "/\\*") + (forward-line)) + (dotimes (i add-height) + (insert "\"") + (dotimes (j width) + (insert color-char)) + (insert "\",\n")))) + (buffer-string))) + +(defsubst chess-images-create-image (file background &optional foreground) + "Create an Emacs image object, for insertion on the board." + (let ((syms (list (nth background + `(("dark_square" . ,chess-images-dark-color) + ("light_square" . ,chess-images-light-color))) + (nth background + `(("background" . ,chess-images-dark-color) + ("background" . ,chess-images-light-color)))))) + (if foreground + (nconc + syms + (list (nth foreground + `(("dark_piece" . ,chess-images-black-color) + ("light_piece" . ,chess-images-white-color)))))) + (if chess-images-border-width + (create-image + (chess-images-hack-xpm file chess-images-border-width + chess-images-border-color) + nil t :color-symbols syms) + (create-image file nil (string-match "\\`/\\* XPM \\*/" file) + :color-symbols syms)))) + +(defun chess-images-init-cache () + "Initialize the display image cache." + (message "Loading chess piece images...") + ;; Make a vector of two vectors of 6-item vectors: each piece of + ;; each color on each color square; and lastly two slots for the + ;; blank squares + (setq chess-images-cache + (vector (vector (make-vector 6 nil) + (make-vector 6 nil)) + (vector (make-vector 6 nil) + (make-vector 6 nil)) + nil nil nil nil)) + (let* ((colors '("black" "white")) + (backgrounds (list chess-images-dark-color + chess-images-light-color)) + (piece-colors (list chess-images-black-color + chess-images-white-color)) + (c 0) (b 0) + (pieces chess-images-piece-names) + blank name image-data) + (dotimes (c 2) + (dotimes (b 2) + (dolist (piece chess-images-piece-names) + (let ((file (expand-file-name + (format "%s-%s.%s" (nth c colors) (nth 1 piece) + chess-images-extension) + chess-images-directory)) + image) + (cond + ((file-readable-p file) + (aset (aref (aref chess-images-cache c) b) + (nth 2 piece) + (chess-images-create-image file b c))) + ;; try loading an xboard format file + (t + (setq file (expand-file-name + (format "%c%c%c%d.%s" (caar pieces) + (if (= c 0) ?d ?l) + (if (= b 0) ?d ?l) chess-images-size + chess-images-extension) + chess-images-directory)) + (aset (aref (aref chess-images-cache c) b) + (nth 2 piece) + (chess-images-create-image file b c)))))))) + (cond + ((file-readable-p + (setq blank (expand-file-name + (format "%s.%s" chess-images-background-image + chess-images-extension) + chess-images-directory))) + (aset chess-images-cache 2 + (chess-images-create-image blank 0)) + (aset chess-images-cache 3 + (chess-images-create-image blank 1))) + ;; try loading an xboard format file + ((file-readable-p + (setq name (format "dsq%d.%s" chess-images-size + chess-images-extension) + blank (expand-file-name name chess-images-directory))) + (aset chess-images-cache 2 + (chess-images-create-image blank 0)) + (aset name 0 ?l) + (setq blank (expand-file-name name chess-images-directory)) + (aset chess-images-cache 3 + (chess-images-create-image blank 1))) + ;; if all else fails, create one + (t + (setq image-data + (cond + ((string= chess-images-extension "xpm") + (chess-images-create-xpm chess-images-size)))) + (aset chess-images-cache 2 + (chess-images-create-image image-data 0)) + (aset chess-images-cache 3 + (chess-images-create-image image-data 1)))) + (when chess-images-border-width + (aset chess-images-cache 4 + (create-image + (chess-images-create-xpm + chess-images-border-width + (+ (* 8 chess-images-size) + (* 9 chess-images-border-width))) + nil t :color-symbols + (list (cons "background" chess-images-border-color)))) + (aset chess-images-cache 5 + (create-image + (chess-images-create-xpm chess-images-size + chess-images-border-width) + nil t :color-symbols + (list (cons "background" chess-images-border-color)))))) + (message "Loading chess piece images...done")) + +(provide 'chess-images) + +;;; chess-images.el ends here diff --git a/chess-pgn.el b/chess-pgn.el new file mode 100644 index 0000000..56fab5a --- /dev/null +++ b/chess-pgn.el @@ -0,0 +1,111 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Convert a chess game to/from PGN notation +;; +;; $Revision$ + +(require 'chess-game) +(require 'chess-algebraic) + +(defun chess-pgn-read-plies (position &optional top-level) + (let ((plies (list t)) prevpos done) + (while (not (or done (eobp))) + (cond + ((looking-at "[1-9][0-9]*\\.[. ]*") + (goto-char (match-end 0))) + ((looking-at chess-algebraic-regexp) + (goto-char (match-end 0)) + (setq prevpos position) + (let ((ply (chess-algebraic-to-ply position (match-string 0)))) + (setq position (chess-ply-next-pos ply)) + (nconc plies (list ply)))) + ((and top-level + (looking-at "\\(\\*\\|1-0\\|0-1\\|1/2-1/2\\)")) + (goto-char (match-end 0)) + (chess-game-set-tag game "Result" (match-string-no-properties 0)) + (setq done t)) + ((looking-at "{") + (forward-char) + (let ((begin (point))) + (search-forward "}") + (forward-char) + (chess-pos-add-annotation prevpos (buffer-substring-no-properties + begin (- (point) 2))))) + ((looking-at "(") + (forward-char) + (skip-chars-forward " \t\n") + (chess-pos-add-annotation prevpos (chess-pgn-read-plies + (chess-pos-copy prevpos)))) + ((and (not top-level) + (looking-at ")")) + (forward-char) + (setq done t)) + (t (error "Error parsing PGN syntax"))) + (skip-chars-forward " \t\n")) + (cdr plies))) + +(defun chess-pgn-to-game () + "Convert PGN notation at point into a chess game." + (when (search-forward "[" nil t) + (let ((game (chess-game-create))) + (setcar game nil) + (backward-char) + (while (looking-at "^\\s-*\\[\\(\\S-+\\)\\s-+\\(\".+?\"\\)\\][ \t\n]+") + (chess-game-set-tag game (match-string-no-properties 1) + (read (match-string-no-properties 2))) + (goto-char (match-end 0))) + (let ((fen (chess-game-tag game "FEN"))) + (chess-game-set-plies + game (chess-pgn-read-plies + (if fen + (chess-fen-to-position fen) + (chess-pos-copy chess-starting-position)) t))) + game))) + +(defun chess-pgn-insert-annotations (ply) + (dolist (ann (chess-pos-annotations (chess-ply-pos ply))) + (if (stringp ann) + (insert (format " {%s}" ann)) + (assert (listp ann)) + (chess-pgn-insert-plies index ann)))) + +(defun chess-pgn-insert-plies (index plies &optional for-black indented) + "NYI: Still have to implement INDENTED argument." + (while plies + (unless for-black + (insert (format "%d. %s" index + (chess-ply-to-algebraic (car plies)))) + (chess-pgn-insert-annotations (car plies)) + (setq plies (cdr plies) index (1+ index))) + (when plies + (when for-black + (insert (format "%d. ..." index)) + (setq for-black nil)) + (insert (format " %s" (chess-ply-to-algebraic (car plies)))) + (chess-pgn-insert-annotations (car plies)) + (setq plies (cdr plies))) + (if plies + (insert ? )))) + +(defun chess-game-to-pgn (game &optional indented) + "Convert a chess GAME to PGN notation. +If INDENTED is non-nil, indent the move texts." + (let ((fen (chess-game-tag game "FEN")) + (first-pos (chess-ply-pos (chess-game-ply game 0)))) + (when (and fen (not (equal fen (chess-pos-to-fen first-pos)))) + (chess-game-del-tag game "FEN") + (setq fen nil)) + (if (and (not fen) + (not (equal chess-starting-position first-pos))) + (chess-game-set-tag game "FEN" (chess-pos-to-fen first-pos)))) + (dolist (tag (chess-game-tags game)) + (insert (format "[%s \"%s\"]\n" (car tag) (cdr tag)))) + (insert ?\n) + (let ((begin (point))) + (chess-pgn-insert-plies 1 (chess-game-plies game)) + (insert (or (chess-game-tag game "Result") "*") ?\n) + (fill-region begin (point)))) + +(provide 'chess-pgn) + +;;; chess-pgn.el ends here diff --git a/chess-ply.el b/chess-ply.el new file mode 100644 index 0000000..ffc51a4 --- /dev/null +++ b/chess-ply.el @@ -0,0 +1,91 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Routines for manipulating chess plies +;; +;; $Revision$ + +;;; Commentary: + +;; A ply is the differential between two positions. Or, it is the +;; coordinate transformations applied to one position in order to +;; arrive at the following position. It is also informally called "a +;; move". +;; +;; A ply is represented in Lisp using a cons cell of the form: +;; +;; (BASE-POSITION . +;; (FROM-COORD1 TO-COORD1 [FROM-COORD2 TO-COORD2] [KEYWORDS])) +;; +;; The KEYWORDS indicate special actions that are not really chess +;; moves: +;; +;; :promote PIECE ; promote pawn to PIECE on arrival +;; :resign ; a resignation causes the game to end +;; :stalemate +;; :repetition +;; :perpetual +;; :check ; check is announced +;; :checkmate +;; :draw ; a draw was offered and accepted +;; :draw-offered ; a draw was offered but not accepted +;; +;; A ply may be represented in ASCII by printing the FEN string of the +;; base position, and then printing the positional transformation in +;; algebraic notation. Since the starting position is usually known, +;; the FEN string is optional. A ply may be represented graphically +;; by moving the chess piece(s) involved. It may be rendered verbally +;; by voicing which piece is to move, where it will move to, and what +;; will happen a result of the move (piece capture, check, etc). +;; +;; Plies may be sent over network connections, postal mail, e-mail, +;; etc., so long as the current position is maintained at both sides. +;; Transmitting the base position's FEN string along with the ply +;; offers a form of confirmation during the course of a game. + +;;; Code: + +(require 'chess-pos) + +(defgroup chess-ply nil + "Routines for manipulating chess plies." + :group 'chess) + +(defsubst chess-ply-pos (ply) + (car ply)) + +(defsubst chess-ply-set-pos (ply position) + (setcar ply position)) + +(defsubst chess-ply-changes (ply) + (cdr ply)) + +(defsubst chess-ply-set-changes (ply changes) + (setcdr ply changes)) + +(defun chess-ply-next-pos (ply) + (apply 'chess-pos-move (chess-pos-copy (chess-ply-pos ply)) + (chess-ply-changes ply))) + +(defsubst chess-ply-create (position &rest changes) + (cons position changes)) + +(defun chess-legal-plies (position color) + "Return a list of all legal plies in POSITION for COLOR." + (let (plies) + (dotimes (rank 8) + (dotimes (file 8) + (let* ((to (chess-rf-to-index rank file)) + (piece (chess-pos-piece position to))) + (when (or (eq piece ? ) + (if color + (> piece ?a) + (< piece ?a))) + (dolist (candidate (funcall (car chess-modules) + nil nil 'search position to t)) + (push (chess-ply-create position (list candidate to)) + plies)))))) + plies)) + +(provide 'chess-ply) + +;;; chess-ply.el ends here diff --git a/chess-pos.el b/chess-pos.el new file mode 100644 index 0000000..039bf31 --- /dev/null +++ b/chess-pos.el @@ -0,0 +1,253 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Routines for manipulating chess positions +;; +;; $Revision$ + +;;; Commentary: + +;; A chess `position' is a vector that starts with sixty-four +;; characters, representing the 8x8 grid of a chess position. Each +;; position may contain p, r, n, b, k, q or <space>, or any of the +;; previous letters in uppercase. Uppercase signifies white, and +;; lowercase means black. +;; +;; Creating a new position can be done with: +;; +;; (chess-pos-create) +;; (chess-pos-copy POSITION) +;; +;; To setup the chess board at an aritrary position, manipulate the +;; position that has been returned to you, or use a position input +;; module. + +;; Once you have a chess position, there are several things you can do +;; with i. First of all, a coordinate system of octal indices is +;; used, where ?\044 signifies rank 4 file 4 (i.e., "e4"). Rank is +;; numbered 0 to 7, top to bottom, and file is 0 to 7, left to right. +;; For those who wish to use ASCII coordinates, such as "e4", there +;; are two conversion functions: +;; +;; (chess-coord-to-index STRING) +;; (chess-index-to-coord INDEX) + +;; With an octal index value, you can look up what's on a particular +;; square, or set that square's value: +;; +;; (chess-pos-piece POSITION INDEX) +;; (chess-pos-set-piece POSITION INDEX PIECE) +;; +;; PIECE must be one of the letters mentioned above (in upper or +;; lowercase), or a space to represent a blank square. +;; +;; To test whether a piece is at a particular position, use: +;; +;; (chess-pos-piece-p POSITION INDEX PIECE) +;; +;; PIECE may also be t for any white piece, nil for any black piece, +;; or the symbol `any', which returns t if the square is not empty. + +;; You can hunt for all occurances of a certain piece using: +;; +;; (chess-pos-search POSITION PIECE) +;; +;; You might also try the `search' event, which employs the +;; intelligence of listening rules modules to search out your piece +;; according to legal piece movements. + +;; Once you have a pair of indices, you can move a piece around: +;; +;; (chess-pos-move POSITION FROM-INDEX TO-INDEX) +;; +;; NOTE This is not the safe way for users to move pieces around! +;; This function moves pieces DIRECTLY, without checking for legality, +;; or informing listening modules of the move. To make an "official" +;; move, use: +;; +;; (chess-move FROM-INDEX TO-INDEX) +;; +;; This will publish the move to all listening modules, which can then +;; handle the move event as they wish. + +;;; Code: + +(defgroup chess-pos nil + "Routines for manipulating chess positions." + :group 'chess) + +(defconst chess-starting-position + [;; the eight ranks and files of the chess position + ?r ?n ?b ?q ?k ?b ?n ?r + ?p ?p ?p ?p ?p ?p ?p ?p + ? ? ? ? ? ? ? ? ; spaces are blanks! + ? ? ? ? ? ? ? ? ; here too + ? ? ? ? ? ? ? ? ; protect from whitespace-cleanup + ? ? ? ? ? ? ? ? ; so have a comment afterwards + ?P ?P ?P ?P ?P ?P ?P ?P + ?R ?N ?B ?Q ?K ?B ?N ?R + ;; index of pawn that can be captured en passant + nil + ;; can white and black castle on king or queen side? + t t t t + ;; is the side to move in: `check', `checkmate', `stalemate' + nil + ;; which color is it to move next? + t + ;; list of annotations for this position. Textual annotations are + ;; simply that, while lists represent interesting variations. + nil] + "Starting position of a chess position.") + +(defsubst chess-pos-piece (position index) + "Return the piece on POSITION at INDEX." + (aref position index)) + +(defsubst chess-pos-set-piece (position index piece) + "Set the piece on POSITION at INDEX to PIECE." + (aset position index piece)) + +(defsubst chess-pos-can-castle (position side) + "Return whether the king can castle on SIDE. +SIDE must be either ?q or ?k (case determines color)." + (aref position (+ 65 (if (< side ?a) + (if (= side ?K) 0 1) + (if (= side ?k) 2 3))))) + +(defsubst chess-pos-set-can-castle (position side value) + "Set whether the king can castle on SIDE. +SIDE must be either ?q or ?k (case determines color)." + (aset position (+ 65 (if (< side ?a) + (if (= side ?K) 0 1) + (if (= side ?k) 2 3))) value)) + +(defsubst chess-pos-en-passant (position) + "Return index of pawn that can be captured en passant, or nil." + (aref position 64)) + +(defsubst chess-pos-set-en-passant (position index) + "Set index of pawn that can be captured en passant." + (aset position 64 index)) + +(defsubst chess-pos-status (position) + "Return whether the side to move is in a special state. +The symbols allowed are: `check', `checkmate', `stalemate'." + (aref position 69)) + +(defsubst chess-pos-set-status (position value) + "Set whether the side to move is in a special state." + (aset position 69 value)) + +(defsubst chess-pos-side-to-move (position) + "Return the color whose move it is in POSITION." + (aref position 70)) + +(defsubst chess-pos-set-side-to-move (position color) + "Set the color whose move it is in POSITION." + (aset position 70 color)) + +(defsubst chess-pos-annotations (position) + "Return the list of annotations for this position." + (aref position 71)) + +(defun chess-pos-add-annotation (position annotation) + "Add an annotation for this position." + (let ((ann (chess-pos-annotations position))) + (if ann + (nconc ann (list annotation)) + (aset position 71 (list annotation))))) + +(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." + (let ((copy (make-vector 72 nil)) elem) + (dotimes (i 71) + (setq elem (aref position i)) + (aset copy i + (cond + ((listp elem) (copy-alist elem)) + ((vectorp elem) (vconcat elem)) + (t elem)))) + copy)) + +(defun chess-pos-create (&optional blank) + "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." + (if blank + (vconcat (make-vector 64 ? ) + [nil t t t t nil t nil]) + (chess-pos-copy chess-starting-position))) + +(defsubst chess-rf-to-index (rank file) + "Convert RANK and FILE coordinates into an octal index." + (+ (* 8 rank) file)) + +(defsubst chess-coord-to-index (coord) + "Convert a COORD (ex. e2, f3) into a chess.el index." + (+ (* 8 (- 7 (- (aref coord 1) ?1))) + (- (aref coord 0) ?a))) + +(defsubst chess-index-to-coord (index) + "Convert a COORD (ex. e2, f3) into a chess position index." + (concat (char-to-string (+ (mod index 8) ?a)) + (char-to-string (+ (- 7 (/ index 8)) ?1)))) + +(defsubst chess-index-rank (index) (/ index 8)) +(defsubst chess-index-file (index) (mod index 8)) + +(defun chess-add-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))) + (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) + "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." + (let ((p (chess-pos-piece position index))) + (cond + ((= p ? ) (= p piece-or-color)) + ((eq piece-or-color t) (< p ?a)) + ((eq piece-or-color nil) (> p ?a)) + (t (= p piece-or-color))))) + +(defun 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." + (let (found) + (dotimes (i 64) + (if (chess-pos-piece-p position i piece-or-color) + (push i found))) + found)) + +(defun chess-pos-move (position &rest changes) + "Move a piece on the POSITION directly, using the indices FROM and TO. +This function does not check any rules, it only makes sure you are not +trying to move a blank square." + (while changes + (unless (symbolp (car changes)) + (let* ((from (car changes)) + (to (cadr changes)) + (piece (chess-pos-piece position from))) + (if (= piece ? ) + (error "Attempted piece move from blank square %s" from)) + (chess-pos-set-piece position from ? ) + (chess-pos-set-piece position to piece) + ;; once a piece is moved, en passant is no longer available + (chess-pos-set-en-passant position nil) + ;; toggle the side whose move it is + (chess-pos-set-side-to-move + position (not (chess-pos-side-to-move position))))) + (setq changes (cddr changes))) + position) + +(provide 'chess-pos) + +;;; chess-pos.el ends here diff --git a/chess-process.el b/chess-process.el new file mode 100644 index 0000000..298f8e1 --- /dev/null +++ b/chess-process.el @@ -0,0 +1,167 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Obtain movements and other information from a subprocess +;; +;; $Revision$ + +;;; Commentary: + +(require 'chess-game) +(require 'chess-algebraic) + +(defgroup chess-process nil + "Code for reading movements and other commands from a subprocess." + :group 'chess) + +(defvar chess-process-command-or-host nil + "What type of process is it? +This could be a string, naming a command to run, in which case it is a +local connection. +It could be a cons cell, giving the (HOST . PORT) of a network connection. +It could be a Lisp function, which will be called to establish +whatever type of connection it wishes, so long as it returns a buffer +related to the resulting process.") + +(defvar chess-process-arguments nil + "If `chess-process-where' is a string or Lisp function, pass these args.") + +(defvar chess-process-triggers + (list (list + (concat "\\s-*\\(white\\|black\\)\\s-*([0-9]+):\\s-+\\(" + chess-algebraic-regexp "\\)\\s-*$") + (function + (lambda (color move) + (if (if (chess-game-side-to-move chess-process-game) + (string= (downcase color) "white") + (string= (downcase color) "black")) + (chess-game-move chess-process-game move nil)))) 1 2) + '(".*Illegal move:\\s-*\\(.*\\)" + (signal 'chess-illegal (match-string 1))) + '(".+?\015" (replace-match ""))) + "A list of regexps and the commands that they trigger. +The alist should be of the form: + + ((REGEXP COMMAND ARG1-GROUP ARG2-GROUP ...) ...) + +Where the ARG*-GROUP entries specify which parenthesis groups in the +regexp demarcate those arguments. Anything more complicated than this +must be handled by modules that derive from this module.") + +(make-variable-buffer-local 'chess-process-command-or-host) +(make-variable-buffer-local 'chess-process-arguments) +(make-variable-buffer-local 'chess-process-triggers) + +(defun chess-process (game handler triggers command-or-host &rest args) + "This function should only be called by specific chess engine modules." + (let ((buf (generate-new-buffer " *chess-process*"))) + (with-current-buffer buf + (setq chess-process-command-or-host command-or-host) + (if args (setq chess-process-arguments command-or-host)) + (if triggers (setq chess-process-triggers triggers))) + `(lambda (game command &rest args) + (apply ,(or (list 'quote handler) + 'chess-process-handler) game ,buf command args)))) + +;;; Code: + +(defvar chess-process-game) +(defvar chess-process-last-pos) +(defvar chess-process-working nil) + +(make-variable-buffer-local 'chess-process-game) +(make-variable-buffer-local 'chess-process-last-pos) +(make-variable-buffer-local 'chess-process-working) + +(defun chess-process-handler (game buffer command &rest args) + "Handle any commands being sent to this instance of this module." + (ignore + (if (eq command 'shutdown) + (when (buffer-live-p buffer) + (condition-case err + (process-send-string (get-buffer-process buffer) "quit\n") + (error nil)) + (kill-buffer buffer)) + (with-current-buffer buffer + (let (cmdstr) + (cond + ((eq command 'initialize) + (setq chess-process-game game + chess-process-last-pos (point-min)) + (let ((proc + (if (stringp chess-process-command-or-host) + (prog2 + (message "Starting chess program '%s'..." + chess-process-command-or-host) + (apply 'start-process "chess-process" + (current-buffer) + chess-process-command-or-host + chess-process-arguments) + (message "Starting chess program '%s'...done" + chess-process-command-or-host)) + (prog2 + (message "Connecting to host %s:%d..." + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)) + (open-network-stream + "chess-process" (current-buffer) + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)) + (message "Connecting to host %s:%d...done" + (car chess-process-command-or-host) + (cdr chess-process-command-or-host)))))) + (unless (and proc (memq (process-status proc) '(run open))) + (error "Failed to start chess process")) + (set-process-filter proc 'chess-process-filter))) + ((eq command 'pass) + (setq cmdstr "go\n")) + ((eq command 'move) + (setq cmdstr (concat (chess-board-last-move + (chess-game-board game)) "\n")))) + (if (and cmdstr (not chess-process-working)) + (process-send-string (get-buffer-process (current-buffer)) + cmdstr))))))) + +(defun chess-process-filter (proc string) + "Process filter for receiving text from a chess process." + (let ((buf (process-buffer proc))) + (when (buffer-live-p buf) + (with-current-buffer buf + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc)))) + (unless chess-process-working + (setq chess-process-working t) + (unwind-protect + (progn + (goto-char chess-process-last-pos) + (beginning-of-line) + (while (not (eobp)) + (condition-case err + (let ((triggers chess-process-triggers)) + (while triggers + ;; this could be accelerated by joining + ;; together the regexps + (when (looking-at (caar triggers)) + (let ((command (nth 1 (car triggers))) + (args (mapcar 'match-string + (nthcdr 2 (car triggers))))) + (cond + ((functionp command) + (apply command args)) + ((symbolp command) + (chess-game-send-event chess-process-game + command args)) + (t (eval command))))) + (setq triggers (cdr triggers)))) + (chess-illegal (error-message-string err))) + (forward-line))) + (setq chess-process-last-pos (point) + chess-process-working nil))))))) + +(provide 'chess-process) + +;;; chess-process.el ends here diff --git a/chess-session.el b/chess-session.el new file mode 100644 index 0000000..6f0dde4 --- /dev/null +++ b/chess-session.el @@ -0,0 +1,49 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Manage a chess playing/viewing session +;; +;; $Revision$ + +;;; Commentary: + +(defun chess-session-create () + (cons nil nil)) + +(defun chess-session-add-listener (session listener &optional front) + (if (or front (not (cdr session))) + (setcdr session (cons (cons listener nil) + (cdr session))) + (nconc session (list (cons listener nil))))) + +(defun chess-session-remove-listener (session listener) + (setcdr session (delq (assq listener (cdr session)) + (cdr session)))) + +(defun chess-session-data (session sym) + (cdr (assq sym (car session)))) + +(defun chess-session-set-data (session sym value) + (let ((entry (assq sym (car session)))) + (if entry + (setcdr entry value) + (setcar session (cons (cons sym value) + (car session)))))) + +(defun chess-session-del-data (session sym) + (setcar session (delq (assq sym (car session)) + (car session)))) + +(defun chess-session-event (session event &rest args) + (let ((listeners (cdr session)) result) + (while (and (or (eq event 'initialize) + (null result)) listeners) + (setq result (apply (caar listeners) session (cdar listeners) + event args)) + (if (eq event 'initialize) + (setcdr (car listeners) result)) + (setq listeners (cdr listeners))) + result)) + +(provide 'chess-session) + +;;; chess-session.el ends here diff --git a/chess-standard.el b/chess-standard.el new file mode 100644 index 0000000..4e11b1f --- /dev/null +++ b/chess-standard.el @@ -0,0 +1,218 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Standard Chess rules module +;; +;; This module implements the following events: +;; +;; `move' +;; +;; Make a move on the current board, if it is legal. +;; +;; `search' +;; +;; Pieces can be located by searching all legal paths a piece might +;; use to reach a particular square. Thus, to find all white pawn(s) +;; that could make it to e4 (either by taking a piece, or by moving +;; there) you'd call: +;; +;; (chess-standard-search POSITION (chess-coord-to-index "e4") ?P) +;; +;; This returns a list of indices specifying all white pawns that +;; could reach e4 in one move. NOTE: The general search order is from +;; upper-left clockwise. + +;; $Revision$ + +(defgroup chess-standard nil + "The rules of standard chess." + :group 'chess) + +;;; Code: + +;;;###autoload +(defun chess-standard (session var event &rest args) + (cond + ((eq event 'move) + (ignore + (chess-standard-validate (car args)) + (chess-game-move (chess-session-data session 'current-game) + (car args)))) + ((eq event 'search) + (apply 'chess-standard-search args)))) + +(defun chess-standard-validate (ply) + "Validate the given PLY against standard chess rules." + (let* ((pos (chess-ply-pos ply)) + (color (chess-pos-side-to-move pos)) + (source (car (chess-ply-changes ply))) + (piece (chess-pos-piece pos source)) + (target (cadr (chess-ply-changes ply)))) + + (if (eq piece ? ) + (signal 'chess-illegal + "Cannot move from a square that is empty")) + + (if (if color + (> piece ?a) + (< piece ?a)) + (signal 'chess-illegal + "Cannot move your opponents pieces")) + + (let ((enemy-piece (chess-pos-piece pos target))) + (if (and (not (eq enemy-piece ? )) + (if color + (< enemy-piece ?a) + (> enemy-piece ?a))) + (signal 'chess-illegal + "Cannot move on top of your own pieces"))) + + (unless (chess-standard-search pos target piece) + (signal 'chess-illegal "Illegal move")))) + +(defun chess-standard-search (position target piece) + "Look on POSITION from position TARGET for PIECE. +This routine looks along legal paths of movement for PIECE. + +If PIECE is t or nil, legal piece movements for any piece of that +color will be considered (t for white, nil for black). Otherwise, the +case of the PIECE determines color. + +The return value is a list of candidates, which means a list of +indices which indicate where a piece may have moved from." + (let* ((bias (if (and (char-valid-p piece) + (< piece ?a)) -1 1)) + (c (= bias -1)) + p pos candidates) + (cond + ;; if the piece is `t', it means to find the candidates resulting + ;; from any piece movement. This is useful for testing whether a + ;; king is in check, for example. + ((memq piece '(t nil)) + (setq candidates (list t)) + (dolist (p '(?P ?R ?N ?B ?K ?Q)) + (nconc candidates + (chess-standard-search position target + (if piece p (downcase p))))) + (setq candidates (cdr candidates))) + + ;; pawn movement, which is diagonal 1 when taking, but forward + ;; 1 or 2 when moving (the most complex piece, actually) + ((= (upcase piece) ?P) + (let ((p (chess-pos-piece position target))) + (if (if (= p ? ) + ;; check for en passant + (and (= (chess-index-rank target) (if c 2 5)) + (setq pos (chess-add-index target bias 0)) + (chess-pos-piece-p position pos (if c ?p ?P)) + (and (chess-pos-en-passant position) + (= (chess-pos-en-passant position) target)) + (setq candidates (list pos))) + (if c (> p ?a) (< p ?a))) + (let ((cands (list t))) + (setq pos (chess-add-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)) + (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 (chess-pos-piece-p position pos piece) + (setq candidates (list pos)) + (when (and (= ? (chess-pos-piece position pos)) + (= (if c 4 3) (chess-index-rank target))) + (setq pos (chess-add-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)) + (setq candidates (list t)) + (dolist (dir (cond + ((= (upcase piece) ?R) + '( (-1 0) + (0 -1) (0 1) + (1 0))) + ((= (upcase piece) ?B) + '((-1 -1) (-1 1) + + (1 -1) (1 1))) + ((= (upcase 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)) + (while pos + (if (chess-pos-piece-p position pos piece) + (progn + (nconc candidates (list pos)) + (setq pos nil)) + (if (/= (chess-pos-piece position pos) ? ) + (setq pos nil) + (setq pos (apply 'chess-add-index pos dir)))))) + (setq candidates (cdr candidates))) + + ;; the king is a trivial case of the queen, except when castling + ((= (upcase 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))) + (if (and pos (chess-pos-piece-p position pos piece)) + (setq candidates (list pos) dirs nil) + (setq dirs (cdr dirs))))) + (let ((rank (if c 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 + ;; castle through check + (if (and + (null candidates) + (or (and (equal target (chess-rf-to-index rank 6)) + (chess-pos-can-castle position (if c ?K ?k)) + (setq pos (chess-rf-to-index rank 5)) + (chess-pos-piece-p position pos ? ) + (not (chess-standard-search position pos (not c))) + (setq pos (chess-rf-to-index rank 6)) + (chess-pos-piece-p position pos ? ) + (not (chess-standard-search position pos (not c)))) + (and (equal target (cons rank 2)) + (chess-pos-can-castle position (if c ?Q ?q)) + (setq pos (chess-rf-to-index rank 1)) + (chess-pos-piece-p position pos ? ) + (not (chess-standard-search position pos (not c))) + (setq pos (chess-rf-to-index rank 2)) + (chess-pos-piece-p position pos ? ) + (not (chess-standard-search position pos (not c))) + (setq pos (chess-rf-to-index rank 3)) + (chess-pos-piece-p position pos ? ) + (not (chess-standard-search position pos (not c)))))) + (setq candidates (list (chess-rf-to-index rank 4)))))) + + ;; 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) + (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)) + (chess-pos-piece-p position pos piece)) + (nconc candidates (list pos)))) + (setq candidates (cdr candidates))) + + (t (error "Unrecognized piece identifier"))) + + ;; return the discovered candidates list + candidates)) + +(provide 'chess-standard) + +;;; chess-standard.el ends here diff --git a/chess.el b/chess.el new file mode 100644 index 0000000..1041349 --- /dev/null +++ b/chess.el @@ -0,0 +1,130 @@ +a0 243 +;;; chess.el --- Play chess in Emacs + +;; Copyright (C) 2001 John Wiegley <johnw@gnu.org> + +;; Emacs Lisp Archive Entry +;; Filename: chess.el +;; Version: 2.0 +;; Keywords: games +;; Author: John Wiegley <johnw@gnu.org> +;; Maintainer: John Wiegley <johnw@gnu.org> +;; Description: Play chess in Emacs +;; URL: http://www.gci-net.com/~johnw/Emacs/packages/chess.tar.gz +;; Compatibility: Emacs20, Emacs21, XEmacs21 + +;; This file is not part of GNU Emacs. + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, +;; MA 02111-1307, USA. + +;;; Commentary: + +;; Welcome to Emacs Chess, a chess playing module for GNU Emacs. +;; +;; This program will not play chess against you; it is not a chess +;; computer. It can use a chess computer, however, to simulate your +;; opponent's moves. This is decided when you choose your opponent. +;; You must, of course, have that chess computer installed. See the +;; top of chess-player.el for more information. +;; +;; To just get a chessboard up, put the following in your .emacs file: +;; +;; (add-to-list 'load-list "<the path to Emacs Chess>") +;; +;; (autoload 'chess "chess" "Play a game of chess" t) +;; +;; Now you can type `M-x chess', and play chess against anyone else in +;; the room with you, without having to install anything more. +;; +;; Once this is working, the next thing to do is to customize +;; `chess-use-modules'. This is a list of functionality modules used +;; by chess.el to provide its functionality. You can enable or +;; disable modules so that Emacs Chess better suites your tastes. +;; Those modules in turn often have configuration variables, and +;; appropriate documentation at the top of the related file. +;; +;; Emacs Chess is designed in a highly modular fashion, using loosely +;; coupled modules that respond to events on the chess board. This +;; makes it very easy for programmers to add their own types of +;; displays, opponents, analysis programs, etc. See the documentation +;; in chess-module.el to learn more. +;; +;; There is no documentation for this program other than what exists +;; in the source files. This is because the source files aim at being +;; self documenting, and as chess is such a simple game, most chess +;; players aren't going to need to know much about this program in +;; particular. +;; +;; However, most people will probably be interested in reading the top +;; of chess-display.el and chess-pgn.el, which describe the user +;; interface commands available in each of those buffer types. + +;;; Code: +(require 'chess-session) +(require 'chess-pgn) + +(defgroup chess nil + "An Emacs chess playing program." + :group 'games) +(defconst chess-version "2.0" +(defconst chess-version "2.0a7" + "The version of the Emacs chess program.") +(defcustom chess-modules + (list 'chess-standard + ;'chess-crafty + (if (display-graphic-p) + 'chess-images 'chess-ics1)) + "Default module set to be used when starting a chess session. +Any rules modules, if they are being used, must appear first in this +list! This usually means `chess-standard' must be the very first +entry." + :type (list 'radio (apropos-internal "\\`chess-[^-]+\\'" 'functionp)) + :type 'sexp + :group 'chess) +(defvar chess-current-session nil) + + +(defun chess () + "Start a game of chess." + (interactive) + (setq chess-current-session (chess-session-create)) + (chess-session-add-listener chess-current-session 'chess-global-handler) + (dolist (module chess-modules) + (chess-session-add-listener chess-current-session module)) + (chess-session-event chess-current-session 'initialize) + (chess-session-event chess-current-session 'setup (chess-game-create))) + +(defun chess-global-handler (session window-config event &rest args) + "React to changes on the chess board in a global Emacs way." + (cond + ((eq event 'initialize) + (chess-session-set-data session 'my-color t) ; start out white + (current-window-configuration)) + ((eq event 'shutdown) + (ignore (set-window-configuration window-config))) + ((eq event 'setup) + (ignore (chess-session-set-data session 'current-game (car args)))) + ((eq event 'pass) + (ignore + (let ((color (not (chess-session-data session 'my-color)))) + (message "You are now playing %s" + (if color "White" "Black")) + (chess-session-set-data session 'my-color (not chess-my-color))))))) + (aset chess-puzzle-locations 3 puzzle-engine))))))) + +(provide 'chess) + +;;; chess.el ends here |