From b60fd83dd950c2c5ef04f23f25bf0d25ac9c11db Mon Sep 17 00:00:00 2001 From: John Wiegley Date: Mon, 8 Apr 2002 03:37:26 +0000 Subject: Simplified the code, removed the 'search-function' nonsense. Even the wackiest chess variants use standard move notation. `chess-ply-create' now fully validates and annotates the plies that it creates, based on the initial piece move (such as the king, in the case of castling). --- Makefile | 17 ++- TODO | 5 - chess-algebraic.el | 34 ++--- chess-crafty.el | 5 +- chess-display.el | 149 +++++++++---------- chess-engine.el | 26 +--- chess-game.el | 75 +++------- chess-gnuchess.el | 5 +- chess-images.el | 4 +- chess-maint.el | 28 +++- chess-pgn.el | 8 +- chess-ply.el | 100 ++++++++++--- chess-pos.el | 170 ++++++++++++++++++++++ chess-standard.el | 237 ------------------------------ chess-var.el | 73 ++++++++++ chess.texi | 412 ++++++++++++++++++++--------------------------------- lispdoc.el | 47 ++++++ 17 files changed, 675 insertions(+), 720 deletions(-) delete mode 100644 chess-standard.el create mode 100644 chess-var.el create mode 100644 lispdoc.el diff --git a/Makefile b/Makefile index 00060f5..b66932c 100644 --- a/Makefile +++ b/Makefile @@ -22,14 +22,21 @@ chess-auto.el: chess-auto.in $(SOURCE) -l $(shell pwd)/chess-maint \ -f batch-byte-compile $< -chess.info: chess.texi - $(MAKEINFO) chess.texi +chess-final.texi: chess.texi $(SOURCE) + $(EMACS) --no-init-file --no-site-file -batch \ + -l $(shell pwd)/chess-maint \ + -f chess-generate-texinfo-file + +chess.info: chess-final.texi + $(MAKEINFO) chess-final.texi + +info: chess.info -chess.dvi: chess.texi - $(ENVADD) $(TEXI2DVI) chess.texi +chess.dvi: chess-final.texi + $(ENVADD) $(TEXI2DVI) chess-final.texi clean: - rm -f $(TARGET) *~ chess.dvi chess.info + rm -f $(TARGET) *~ chess.dvi chess.info chess-final.* rm -f *.aux *.cp *.cps *.fn *.fns *.ky *.log *.pg *.toc *.tp *.vr fullclean: clean diff --git a/TODO b/TODO index bfad5fd..9e8afc5 100644 --- a/TODO +++ b/TODO @@ -1,12 +1,7 @@ - - Port image display code to XEmacs - Allow the user to retract a move when playing against an engine. -- Long castling is signaled as an illegal move from chess-standard - -- Capital letters not supported in keyboard shortcut entry - ---------------------------------------------------------------------- - Tie-in to ics.el, by adding "Internet opponent" to the opponents diff --git a/chess-algebraic.el b/chess-algebraic.el index 3905659..09f8b30 100644 --- a/chess-algebraic.el +++ b/chess-algebraic.el @@ -51,7 +51,7 @@ "A regular expression that matches all possible algebraic moves. This regexp handles both long and short form.") -(defun chess-algebraic-to-ply (position move &optional search-func) +(defun chess-algebraic-to-ply (position move) "Convert the algebraic notation MOVE for POSITION to a ply." (unless (string-match chess-algebraic-regexp move) (error "Cannot parse non-algebraic move notation: %s" move)) @@ -62,12 +62,8 @@ This regexp handles both long and short form.") (if (eq piece ?O) (let ((rank (if color 7 0)) (long (= (length (match-string 1 move)) 5))) - ;; jww (2002-04-07): This should be moderated by - ;; chess-standard!! (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)))) + (chess-rf-to-index rank (if long 2 6)))) (let ((source (match-string 4 move)) (target (chess-coord-to-index (match-string 7 move)))) (if (and source (= (length source) 2)) @@ -82,10 +78,9 @@ This regexp handles both long and short form.") ;; move, to determine which piece is meant by the ;; piece indicator (when (setq candidates - (funcall (or search-func - 'chess-standard-search-position) - position target (if color piece - (downcase piece)))) + (chess-search-position position target + (if color piece + (downcase piece)))) (if (= (length candidates) 1) (list (car candidates) target) (if (null source) @@ -104,12 +99,11 @@ This regexp handles both long and short form.") (if mate (nconc changes (list (if (equal mate "#") - ':checkmate - ':check)))) - (and changes - (apply 'chess-ply-create position changes)))) + :checkmate + :check)))) + (and changes (apply 'chess-ply-create position changes)))) -(defun chess-ply-to-algebraic (ply &optional long search-func) +(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))) @@ -129,9 +123,7 @@ If LONG is non-nil, render the move into long notation." (if (= to (chess-rf-to-index (if color 7 0) 2)) "O-O-O")))) str - (let ((candidates (funcall (or search-func - 'chess-standard-search-position) - pos to from-piece)) + (let ((candidates (chess-search-position pos to from-piece)) (rank 0) (file 0) (from-rank (/ from 8)) (from-file (mod from 8)) @@ -162,12 +154,12 @@ If LONG is non-nil, render the move into long notation." (if (/= ? (chess-pos-piece pos to)) "x" (if long "-")) (chess-index-to-coord to) - (let ((promote (memq ':promote changes))) + (let ((promote (memq :promote changes))) (if promote (concat "=" (char-to-string (cadr promote)))))))))) (concat notation - (if (memq ':check changes) "+" - (if (memq ':checkmate changes) "#")))))) + (if (memq :check changes) "+" + (if (memq :checkmate changes) "#")))))) (provide 'chess-algebraic) diff --git a/chess-crafty.el b/chess-crafty.el index d3f1da0..0c0ffe0 100644 --- a/chess-crafty.el +++ b/chess-crafty.el @@ -67,10 +67,7 @@ ((eq event 'move) (unless chess-crafty-now-moving - (chess-engine-send - nil (concat (chess-ply-to-algebraic - (car args) nil - (chess-engine-search-function nil)) "\n")))))) + (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n")))))) (provide 'chess-crafty) diff --git a/chess-display.el b/chess-display.el index 7b83e67..6d65fa3 100644 --- a/chess-display.el +++ b/chess-display.el @@ -7,6 +7,7 @@ ;;; Code: (require 'chess-game) +(require 'chess-var) (require 'chess-algebraic) (require 'chess-fen) @@ -47,7 +48,6 @@ ;; (defvar chess-display-game) -(defvar chess-display-search-function) (defvar chess-display-variation) (defvar chess-display-index) (defvar chess-display-ply) @@ -59,7 +59,6 @@ (defvar chess-display-mode-line "") (make-variable-buffer-local 'chess-display-game) -(make-variable-buffer-local 'chess-display-search-function) (make-variable-buffer-local 'chess-display-variation) (make-variable-buffer-local 'chess-display-index) (make-variable-buffer-local 'chess-display-ply) @@ -77,7 +76,7 @@ ,@body) ,@body))) -(defun chess-display-create (style perspective &optional search-func) +(defun chess-display-create (style perspective) "Create a chess display, for displaying chess objects." (let* ((name (symbol-name style)) (draw (intern-soft (concat name "-draw"))) @@ -89,8 +88,7 @@ (setq cursor-type nil chess-display-draw-function draw chess-display-highlight-function highlight - chess-display-perspective perspective - chess-display-search-function search-func) + chess-display-perspective perspective) (chess-display-mode) (if initialize (funcall initialize)) @@ -111,23 +109,6 @@ (setq chess-display-perspective perspective) (chess-display-update nil))) -(defun chess-display-set-search-function (display search-func) - (chess-with-current-buffer display - (if chess-display-game - (error "Cannot alter a display's search function when viewing a game") - (setq chess-display-search-function search-func)))) - -(defun chess-display-search-function (display) - (chess-with-current-buffer display - (if chess-display-game - (chess-game-search-function chess-display-game) - (or chess-display-search-function - 'chess-standard-search-position)))) - -(defsubst chess-display-search-position (display position target piece) - (chess-with-current-buffer display - (funcall (chess-display-search-function nil) - position target piece))) (defun chess-display-set-position (display position &optional search-func) "Set the display position. @@ -140,7 +121,6 @@ that was passed in." (if chess-display-game (chess-display-detach-game nil)) (setq chess-display-game nil - chess-display-search-function search-func chess-display-variation nil chess-display-index nil chess-display-ply nil @@ -153,13 +133,12 @@ that was passed in." (or (and chess-display-game (chess-game-pos chess-display-game chess-display-index)) (and chess-display-variation - (chess-ply-next-pos - (nth chess-display-index chess-display-variation))) + (chess-var-pos chess-display-variation chess-display-index)) (and chess-display-ply (chess-ply-next-pos chess-display-ply)) chess-display-position))) -(defun chess-display-set-ply (display ply &optional search-func) +(defun chess-display-set-ply (display ply) "Set the display ply. This differs from a position display, only in that the algebraic form of the move made to the reach the displayed position will be shown in @@ -168,7 +147,6 @@ the modeline." (if chess-display-game (chess-display-detach-game nil)) (setq chess-display-game nil - chess-display-search-function search-func chess-display-variation nil chess-display-index nil chess-display-ply ply @@ -180,10 +158,10 @@ the modeline." (or (and chess-display-game (chess-game-ply chess-display-game chess-display-index)) (and chess-display-variation - (nth chess-display-index chess-display-variation)) + (chess-var-ply chess-display-variation chess-display-index)) chess-display-ply))) -(defun chess-display-set-variation (display plies &optional index search-func) +(defun chess-display-set-variation (display variation &optional index) "Set the display variation. This will cause the first ply in the variation to be displayed, with the user able to scroll back and forth through the moves in the @@ -193,8 +171,7 @@ variation that was passed in." (if chess-display-game (chess-display-detach-game nil)) (setq chess-display-game nil - chess-display-search-function search-func - chess-display-variation plies + chess-display-variation variation chess-display-index (or index 0) chess-display-ply nil chess-display-position nil) @@ -203,7 +180,7 @@ variation that was passed in." (defun chess-display-variation (display) (chess-with-current-buffer display (or (and chess-display-game - (chess-game-plies chess-display-game)) + (chess-game-main-var chess-display-game)) chess-display-variation))) (defun chess-display-set-game (display game &optional index) @@ -215,7 +192,6 @@ modeline." (if chess-display-game (chess-display-detach-game nil)) (setq chess-display-game game - chess-display-search-function nil chess-display-variation nil chess-display-index (or index 0) chess-display-ply nil @@ -245,7 +221,7 @@ modeline." (< index 0) (> index (if chess-display-game (chess-game-index chess-display-game) - (1+ (length chess-display-variation))))) + (chess-var-index chess-display-variation)))) (setq chess-display-index index) (chess-display-update nil)))) @@ -277,9 +253,8 @@ If only START is given, it must be in algebraic move notation." (chess-game-move chess-display-game ply) (error "What to do here?? NYI"))) (chess-display-variation - ;; jww (2002-04-02): what if we're in the middle? - (nconc chess-display-variation (list ply)) - (setq chess-display-index (1- (length chess-display-variation)))) + (chess-var-move chess-display-variation ply) + (chess-display-set-index nil (chess-var-index chess-display-variation))) (chess-display-ply (setq chess-display-ply ply)) (chess-display-position ; an ordinary position @@ -304,20 +279,21 @@ that is supported by most displays, and is the default mode." (defun chess-display-event-handler (game display event &rest args) "This display module presents a standard chessboard. See `chess-display-type' for the different kinds of displays." - (cond - ((eq event 'shutdown) - (chess-display-destroy display)) + (with-current-buffer display + (cond + ((eq event 'shutdown) + (chess-display-destroy nil)) - ((eq event 'pass) - (chess-display-set-perspective - display (not (chess-display-perspective display)))) + ((eq event 'pass) + (chess-display-set-perspective + nil (not (chess-display-perspective nil)))) - ((eq event 'move) - (chess-display-set-index - display (chess-game-index (chess-display-game display))))) + ((memq event '(move game-over)) + (chess-display-set-index + nil (chess-game-index (chess-display-game nil))))) - (unless (eq event 'shutdown) - (chess-display-update display))) + (unless (eq event 'shutdown) + (chess-display-update nil)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; @@ -400,7 +376,7 @@ The key bindings available in this mode are: (chess-display-game (setq ply (chess-game-ply chess-display-game (1- index)))) (chess-display-variation - (setq ply (nth chess-display-variation (1- index))))) + (setq ply (chess-var-ply chess-display-variation (1- index))))) (if ply (setq chess-display-mode-line (concat @@ -413,10 +389,7 @@ The key bindings available in this mode are: (/ index 2) (1+ (/ index 2)))))) (if ply (concat ". " (if color "... ") - (or (chess-ply-to-algebraic - ply nil - (chess-display-search-function nil)) - "???"))))))))) + (or (chess-ply-to-algebraic ply) "???"))))))))) (defsubst chess-display-active-p () "Return non-nil if the displayed chessboard reflects an active game. @@ -440,7 +413,7 @@ Basically, it means we are playing, not editing or reviewing." "Send the current board configuration to the user." (interactive) (let* ((x-select-enable-clipboard t) - (fen (chess-fen-from-pos (chess-display-position nil)))) + (fen (chess-pos-to-fen (chess-display-position nil)))) (kill-new fen) (message "Copied board: %s" fen))) @@ -476,9 +449,7 @@ Basically, it means we are playing, not editing or reviewing." (if (chess-pos-side-to-move (chess-display-position nil)) "White" "Black") (1+ (/ (or (chess-display-index nil) 0) 2)))))) - (let ((ply (chess-algebraic-to-ply - (chess-display-position nil) move - (chess-display-search-function nil)))) + (let ((ply (chess-algebraic-to-ply (chess-display-position nil) move))) (unless ply (error "Illegal move notation: %s" move)) (chess-display-move nil ply))) @@ -495,7 +466,7 @@ to the end or beginning." nil (or index (if chess-display-game (chess-game-index chess-display-game) - (1- (length chess-display-variation))))) + (chess-var-index chess-display-variation)))) (unless (chess-display-active-p) (message "Use '>' to return to the current position")))) @@ -636,24 +607,19 @@ to the end or beginning." (setq chess-move-string (concat chess-move-string (char-to-string (downcase last-command-char))))) - (let ((position (chess-display-position nil)) - (search-func (chess-display-search-function nil))) + (let ((position (chess-display-position nil))) (unless (and chess-legal-moves (eq position chess-legal-moves-pos)) (setq chess-legal-moves-pos position chess-legal-moves - (sort (mapcar (function - (lambda (ply) - (chess-ply-to-algebraic ply nil search-func))) - (chess-legal-plies position search-func)) + (sort (mapcar 'chess-ply-to-algebraic (chess-legal-plies position)) 'string-lessp))) (let ((moves (delq nil (mapcar 'chess-keyboard-test-move chess-legal-moves)))) (cond ((= (length moves) 1) - (let ((ply (chess-algebraic-to-ply - (chess-display-position nil) (car moves) - (chess-display-search-function nil)))) + (let ((ply (chess-algebraic-to-ply (chess-display-position nil) + (car moves)))) (unless ply (error "Illegal move notation: %s" (car moves))) (chess-display-move nil ply)) @@ -691,22 +657,41 @@ to the end or beginning." "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))) + (let ((coord (get-text-property (point) 'chess-coord)) + (position (chess-display-position nil))) (when coord - (if chess-display-last-selected - (let ((last-sel chess-display-last-selected)) - ;; if they select the same square again, just deselect it - (if (/= (point) (car last-sel)) - (chess-display-move - nil (chess-ply-create (chess-display-position nil) - (cadr last-sel) coord)) - ;; put the board back to rights - (chess-display-update nil)) - (setq chess-display-last-selected nil)) - (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 right away - (chess-display-highlight nil coord 'selected))))) + (catch 'invalid + (if chess-display-last-selected + (let ((last-sel chess-display-last-selected)) + ;; if they select the same square again, just deselect it + (if (= (point) (car last-sel)) + (chess-display-update nil) + (let ((s-piece (chess-pos-piece position (cadr last-sel))) + (t-piece (chess-pos-piece position coord)) ply) + (when (and (not (eq t-piece ? )) + (if (chess-pos-side-to-move position) + (< t-piece ?a) + (> t-piece ?a))) + (message "Cannot capture your own pieces.") + (throw 'invalid t)) + (setq ply (chess-ply-create position (cadr last-sel) coord)) + (unless ply + (message "That piece cannot move there in this position.") + (throw 'invalid t)) + (chess-display-move nil ply))) + (setq chess-display-last-selected nil)) + (let ((piece (chess-pos-piece position coord))) + (cond + ((eq piece ? ) + (message "Cannot select an empty square.") + (throw 'invalid t)) + ((if (chess-pos-side-to-move position) + (> piece ?a) + (< piece ?a)) + (message "Cannot move your opponent's pieces.") + (throw 'invalid t))) + (setq chess-display-last-selected (list (point) coord)) + (chess-display-highlight nil coord 'selected))))))) (defun chess-display-mouse-select-piece (event) "Select the piece the user clicked on." diff --git a/chess-engine.el b/chess-engine.el index 19bd4cc..bfd30c7 100644 --- a/chess-engine.el +++ b/chess-engine.el @@ -17,14 +17,12 @@ (defvar chess-engine-response-handler nil) (defvar chess-engine-position nil) (defvar chess-engine-game nil) -(defvar chess-engine-search-function nil) (make-variable-buffer-local 'chess-engine-regexp-alist) (make-variable-buffer-local 'chess-engine-event-handler) (make-variable-buffer-local 'chess-engine-response-handler) (make-variable-buffer-local 'chess-engine-position) (make-variable-buffer-local 'chess-engine-game) -(make-variable-buffer-local 'chess-engine-search-function) (defvar chess-engine-last-pos nil) (defvar chess-engine-working nil) @@ -58,7 +56,7 @@ ((eq event 'move) (chess-engine-do-move (car args))))) -(defun chess-engine-create (module &optional user-handler search-func) +(defun chess-engine-create (module &optional user-handler) (let ((regexp-alist (intern-soft (concat (symbol-name module) "-regexp-alist"))) (handler (intern-soft (concat (symbol-name module) "-handler")))) @@ -83,23 +81,9 @@ (chess-with-current-buffer engine (apply chess-engine-event-handler event args))) -(defun chess-engine-search-function (engine) - (chess-with-current-buffer engine - (if chess-engine-game - (chess-game-search-function chess-engine-game) - (or chess-engine-search-function - 'chess-standard-search-position)))) - -(defun chess-engine-set-search-function (engine search-func) - (chess-with-current-buffer engine - (if chess-engine-game - (error "Engine is currently linked to a game") - (setq chess-engine-search-function search-func)))) - -(defsubst chess-engine-search-position (engine position target piece) - (chess-with-current-buffer engine - (funcall (chess-engine-search-function nil) - position target piece))) +;; 'ponder +;; 'search-depth +;; 'wall-clock (defun chess-engine-set-option (engine option value) (chess-with-current-buffer engine @@ -152,7 +136,7 @@ (chess-engine-do-move ply) (chess-engine-command engine 'move ply))) -(defun chess-engine-pass (engine ply) +(defun chess-engine-pass (engine) (chess-with-current-buffer engine (chess-engine-command engine 'pass))) diff --git a/chess-game.el b/chess-game.el index 6abdc20..d0bfe12 100644 --- a/chess-game.el +++ b/chess-game.el @@ -53,23 +53,13 @@ (apply (car hook) game (cdr hook) args))) -(defsubst chess-game-search-function (game) - "Return the tags alist associated with GAME." - (cadr game)) - -(defsubst chess-game-set-search-function (game func) - "Return the tags alist associated with GAME." - (setcar (cdr game) func) - (chess-game-run-hooks game 'rule-change)) - - (defsubst chess-game-tags (game) "Return the tags alist associated with GAME." - (nth 2 game)) + (cadr game)) (defsubst chess-game-set-tags (game tags) "Return the tags alist associated with GAME." - (setcar (nthcdr 2 game) tags) + (setcar (cdr game) tags) (chess-game-run-hooks game 'set-tags)) (defsubst chess-game-tag (game tag) @@ -96,13 +86,19 @@ (defsubst chess-game-plies (game) "Return the tags alist associated with GAME." - (nth 3 game)) + (nth 2 game)) + +(defalias 'chess-game-main-var 'chess-game-plies) (defsubst chess-game-set-plies (game plies) "Return the tags alist associated with GAME." - (setcdr (nthcdr 2 game) plies) + (setcdr (nthcdr 1 game) plies) (chess-game-run-hooks game 'set-plies)) +(defsubst chess-game-pos (game &optional index) + "Return the position related to GAME's INDEX position." + (chess-ply-pos (chess-game-ply game index))) + (defsubst chess-game-index (game) "Return the GAME's current position index." (1- (length (chess-game-plies game)))) @@ -127,24 +123,14 @@ (nconc plies (list ply)) (chess-game-set-plies game (list ply))))) -(defsubst chess-game-pos (game &optional index) - "Return the position related to GAME's INDEX position." - (chess-ply-pos (chess-game-ply game index))) - -(defun chess-game-create (&optional position search-func tags) +(defun chess-game-create (&optional position tags) "Create a new chess game object. -Optionally use the given starting POSITION (which is recorded using -the game's FEN tag). -SEARCH-FUNC specifies the function used to test the legality of moves. +Optionally use the given starting POSITION. TAGS is the starting set of game tags (which can always be changed later using the various tag-related methods)." - (let ((game - (list nil - (or search-func 'chess-standard-search-position) - tags - (list (chess-ply-create (or position - (chess-pos-create))))))) + (let ((game (list nil tags (list (chess-ply-create (or position + (chess-pos-create))))))) (dolist (tag (cons (cons "Date" (format-time-string "%Y.%m.%d")) chess-game-default-tags)) (unless (chess-game-tag game (car tag)) @@ -161,23 +147,23 @@ progress (nil), if it is drawn, resigned, mate, etc." (position (chess-ply-pos ply))) (unless (equal position (chess-ply-pos current-ply)) (error "Positions do not match")) - (unless (funcall (chess-game-search-function game) - position (cadr (chess-ply-changes ply)) - (chess-pos-piece position (car (chess-ply-changes ply)))) + (unless (chess-search-position + position (cadr (chess-ply-changes ply)) + (chess-pos-piece position (car (chess-ply-changes ply)))) (signal 'chess-illegal "Illegal move")) (chess-ply-set-changes current-ply changes) (chess-game-add-ply game (chess-ply-create (chess-ply-next-pos current-ply))) (cond - ((or (memq ':draw changes) - (memq ':perpetual changes) - (memq ':repetition changes) - (memq ':stalemate changes)) + ((or (memq :draw changes) + (memq :perpetual changes) + (memq :repetition changes) + (memq :stalemate changes)) (chess-game-set-tag game "Result" "1/2-1/2") (chess-game-run-hooks game 'game-over)) - ((or (memq ':resign changes) - (memq ':checkmate changes)) + ((or (memq :resign changes) + (memq :checkmate changes)) (chess-game-set-tag game "Result" (if (chess-game-side-to-move game) "0-1" "1-0")) (chess-game-run-hooks game 'game-over)) @@ -185,21 +171,6 @@ progress (nil), if it is drawn, resigned, mate, etc." (t (chess-game-run-hooks game 'move current-ply))))) -;; A few convenience functions - -(defsubst chess-game-legal-plies (game) - "Return all legal plies from GAME's current position." - (chess-legal-plies (chess-game-pos game) - (chess-game-search-function game))) - -(defsubst chess-game-algebraic-to-ply (game move) - (chess-algebraic-to-ply (chess-game-pos game) move - (chess-game-search-function game))) - -(defsubst chess-game-ply-to-algebraic (game &optional ply long) - (chess-ply-to-algebraic (or ply (chess-game-ply game)) long - (chess-game-search-function game))) - (provide 'chess-game) ;;; chess-game.el ends here diff --git a/chess-gnuchess.el b/chess-gnuchess.el index 1f0e68b..e53c871 100644 --- a/chess-gnuchess.el +++ b/chess-gnuchess.el @@ -48,10 +48,7 @@ ((eq event 'move) (unless chess-gnuchess-now-moving - (chess-engine-send nil (concat (chess-ply-to-algebraic - (car args) nil - (chess-engine-search-function nil)) - "\n")))))) + (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n")))))) (provide 'chess-gnuchess) diff --git a/chess-images.el b/chess-images.el index b4b9488..e02c92e 100644 --- a/chess-images.el +++ b/chess-images.el @@ -38,8 +38,8 @@ (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)))) + (expand-file-name "pieces" (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 diff --git a/chess-maint.el b/chess-maint.el index dc7a8c8..cf0f629 100644 --- a/chess-maint.el +++ b/chess-maint.el @@ -1,2 +1,28 @@ -(require 'cl) (add-to-list 'load-path ".") + +(require 'cl) + +(defun chess-generate-texinfo-file () + (require 'lispdoc) + (require 'texinfo) + (require 'pp) + (with-temp-buffer + (insert-file-contents-literally "chess.texi") + (texinfo-mode) + (require 'chess-algebraic) + (require 'chess-display) + (require 'chess-engine) + (require 'chess-fen) + (require 'chess-game) + (require 'chess-pgn) + (require 'chess-ply) + (require 'chess-pos) + (require 'chess-var) + (require 'chess) + (texinfo-insert-node-lines (point-min) (point-max) t) + (texinfo-every-node-update) + (texinfo-all-menus-update t) + (texinfo-every-node-update) + (texinfo-all-menus-update t) + (update-lispdoc-tags) + (write-file "chess-final.texi"))) diff --git a/chess-pgn.el b/chess-pgn.el index db13793..5437a6d 100644 --- a/chess-pgn.el +++ b/chess-pgn.el @@ -19,7 +19,8 @@ (goto-char (match-end 0)) (setq prevpos position) (let* ((move (match-string 0)) - (ply (chess-game-algebraic-to-ply game (match-string 0)))) + (ply (chess-algebraic-to-ply (chess-game-pos game) + (match-string 0)))) (unless ply (error "Error reading move: %s" move)) (setq position (chess-ply-next-pos ply)) @@ -80,8 +81,7 @@ (while plies (unless for-black (when (chess-ply-changes (car plies)) - (insert (format "%d. %s" index - (chess-game-ply-to-algebraic game (car plies)))) + (insert (format "%d. %s" index (chess-ply-to-algebraic (car plies)))) (unless no-annotations (chess-pgn-insert-annotations game index (car plies)))) (setq plies (cdr plies) index (1+ index))) @@ -90,7 +90,7 @@ (when for-black (insert (format "%d. ..." index)) (setq for-black nil)) - (insert (format " %s" (chess-game-ply-to-algebraic game (car plies)))) + (insert (format " %s" (chess-ply-to-algebraic (car plies)))) (unless no-annotations (chess-pgn-insert-annotations game index (car plies)))) (setq plies (cdr plies))) diff --git a/chess-ply.el b/chess-ply.el index c49dba4..643c60c 100644 --- a/chess-ply.el +++ b/chess-ply.el @@ -45,7 +45,6 @@ ;;; Code: (require 'chess-pos) -(require 'chess-standard) (defgroup chess-ply nil "Routines for manipulating chess plies." @@ -63,41 +62,100 @@ (defsubst chess-ply-set-changes (ply changes) (setcdr ply changes)) -(defun chess-ply-next-pos (ply) +(defsubst 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) - ;; jww (2002-04-02): if `changes' is a castling maneuver, then - ;; annotate and extend the ply correctly - (cons (chess-pos-copy position) changes)) +(defun chess-ply-create (position &rest changes) + "Create a ply from the given POSITION by applying the suppiled CHANGES. +This function will guarantee the resulting ply is legal, and will also +annotate the ply with :check or other modifiers as necessary. It will +also extend castling, and will prompt for a promotion piece. + +Note: Do not pass in the rook move if CHANGES represents a castling +maneuver." + (let ((ply (cons (chess-pos-copy position) changes))) + (if (null changes) + ply + ;; validate that `changes' can be legally applied to the given + ;; position + (when (member (car changes) + (chess-search-position position (cadr changes) + (chess-pos-piece position + (car changes)))) + ;; is this a castling maneuver? + (let ((color (chess-pos-side-to-move position))) + (when (and (eq (if color ?K ?k) + (chess-pos-piece position (car changes))) + (> (abs (- (chess-index-file (cadr changes)) + (chess-index-file (car changes)))) 1)) + (let ((kingside (> (chess-index-file (cadr changes)) + (chess-index-file (car changes))))) + ;; if so, add the rook moves + (nconc changes (if kingside + (list (chess-rf-to-index (if color 7 0) 7) + (chess-rf-to-index (if color 7 0) 5)) + (list (chess-rf-to-index (if color 7 0) 0) + (chess-rf-to-index (if color 7 0) 3))))))) + + ;; is the opponent's king in check/mate or stalemate now, as a + ;; result of the changes? NOTE: engines, whom we should + ;; trust, may already have determine if check/checkmate + ;; applies. + (unless (or (memq :check changes) + (memq :checkmate changes)) + (let* ((next-pos (chess-ply-next-pos ply)) + (color (chess-pos-side-to-move next-pos)) + (can-move (catch 'can-move + (dotimes (rank 8) + (dotimes (file 8) + (let* ((to (chess-rf-to-index rank file)) + (piece (chess-pos-piece next-pos to))) + (when (or (eq piece ? ) + (if color + (> piece ?a) + (< piece ?a))) + (if (chess-search-position next-pos + to color) + (throw 'can-move t))))))))) + (if (chess-search-position next-pos + (car (chess-pos-search + next-pos (if color ?K ?k))) + (not color)) + ;; yes, well is in he in checkmate? + (if can-move + (nconc changes (list :check)) + (nconc changes (list :checkmate))) + ;; no, but is he in stalemate? + (unless can-move + (nconc changes (list :stalemate)))))) + + ;; return the annotated ply + ply)))) (defun chess-ply-final-p (ply) "Return non-nil if this is the last ply of a game/variation." (let ((changes (chess-ply-changes ply))) - (or (memq ':draw changes) - (memq ':perpetual changes) - (memq ':repetition changes) - (memq ':stalemate changes) - (memq ':resign changes) - (memq ':checkmate changes)))) - -(defun chess-legal-plies (position &optional search-func) + (or (memq :draw changes) + (memq :perpetual changes) + (memq :repetition changes) + (memq :stalemate changes) + (memq :resign changes) + (memq :checkmate changes)))) + +(defun chess-legal-plies (position) "Return a list of all legal plies in POSITION." - (let (plies) + (let ((color (chess-pos-side-to-move position)) 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 (chess-pos-side-to-move position) + (if color (> piece ?a) (< piece ?a))) - (dolist (candidate (funcall (or search-func - 'chess-standard-search-position) - position to t)) - (push (chess-ply-create position candidate to) - plies)))))) + (dolist (candidate (chess-search-position position to color)) + (push (chess-ply-create position candidate to) plies)))))) plies)) (provide 'chess-ply) diff --git a/chess-pos.el b/chess-pos.el index b67070a..df3e511 100644 --- a/chess-pos.el +++ b/chess-pos.el @@ -248,6 +248,176 @@ trying to move a blank square." (not (chess-pos-side-to-move position))) position) +(defun chess-search-position (position target piece) + "Look on POSITION from TARGET for a PIECE that can move there. +This routine looks along legal paths of movement for PIECE. It +differs from `chess-pos-search', which is a more basic function that +doesn't take piece movement into account. + +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* ((color (if (char-valid-p piece) + (< piece ?a) + piece)) + (bias (if color -1 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-search-position 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 color 2 5)) + (setq pos (chess-add-index target bias 0)) + (chess-pos-piece-p position pos (if color ?p ?P)) + (and (chess-pos-en-passant position) + (= (chess-pos-en-passant position) target)) + (setq candidates (list pos))) + (if color (> 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 color 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 color 7 0))) + ;; if we can still castle, then the king and rook are in their + ;; squares; also, make sure that the user is not attempting to + ;; castle through check + (if (and + (null candidates) + (or (and (equal target (chess-rf-to-index rank 6)) + (chess-pos-can-castle position (if color ?K ?k)) + (setq pos (chess-rf-to-index rank 5)) + (chess-pos-piece-p position pos ? ) + (not (chess-search-position position pos (not color))) + (setq pos (chess-rf-to-index rank 6)) + (chess-pos-piece-p position pos ? ) + (not (chess-search-position position pos (not color)))) + (and (equal target (chess-rf-to-index rank 2)) + (chess-pos-can-castle position (if color ?Q ?q)) + (setq pos (chess-rf-to-index rank 1)) + (chess-pos-piece-p position pos ? ) + (not (chess-search-position position pos (not color))) + (setq pos (chess-rf-to-index rank 2)) + (chess-pos-piece-p position pos ? ) + (not (chess-search-position position pos (not color))) + (setq pos (chess-rf-to-index rank 3)) + (chess-pos-piece-p position pos ? ) + (not (chess-search-position position pos (not color)))))) + (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"))) + + ;; prune from the discovered candidates list any moves which would + ;; leave the king in check; castling through check has already + ;; been eliminated. + (if (char-valid-p piece) + (let ((cand candidates) last-cand pos king-pos) + (while cand + ;; determine the resulting position + (setq pos (chess-pos-move (chess-pos-copy position) + (car cand) target)) + ;; find the king (only once if the king isn't moving) + (if (or (null king-pos) + (eq (downcase piece) ?k)) + (setq king-pos (chess-pos-search pos (if color ?K ?k)))) + ;; can anybody from the opposite side reach him? if so, + ;; drop the candidate + (if (or (null king-pos) + (chess-search-position pos (car king-pos) (not color))) + (if last-cand + (setcdr last-cand (cdr cand)) + (setq candidates (cdr candidates))) + (setq last-cand cand)) + (setq cand (cdr cand))))) + + ;; return the final list of candidate moves + candidates)) + (provide 'chess-pos) ;;; chess-pos.el ends here diff --git a/chess-standard.el b/chess-standard.el deleted file mode 100644 index b4b0267..0000000 --- a/chess-standard.el +++ /dev/null @@ -1,237 +0,0 @@ -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; -;; 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 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: - -(defun chess-standard-validate-ply (ply &optoinal search-func) - "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 (funcall (or search-func - 'chess-standard-search-position) pos target piece) - (signal 'chess-illegal "Illegal move")))) - -(defun chess-standard-search-position (position target piece) - "Look on POSITION from TARGET for a PIECE that can move there. -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* ((color (if (char-valid-p piece) - (< piece ?a) - piece)) - (bias (if color -1 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 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 color 2 5)) - (setq pos (chess-add-index target bias 0)) - (chess-pos-piece-p position pos (if color ?p ?P)) - (and (chess-pos-en-passant position) - (= (chess-pos-en-passant position) target)) - (setq candidates (list pos))) - (if color (> 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 color 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 color 7 0))) - ;; if we can still castle, then the king and rook are in their - ;; squares; also, make sure that the user is not attempting to - ;; castle through check - (if (and - (null candidates) - (or (and (equal target (chess-rf-to-index rank 6)) - (chess-pos-can-castle position (if color ?K ?k)) - (setq pos (chess-rf-to-index rank 5)) - (chess-pos-piece-p position pos ? ) - (not (chess-standard-search-position position - pos (not color))) - (setq pos (chess-rf-to-index rank 6)) - (chess-pos-piece-p position pos ? ) - (not (chess-standard-search-position position - pos (not color)))) - (and (equal target (cons rank 2)) - (chess-pos-can-castle position (if color ?Q ?q)) - (setq pos (chess-rf-to-index rank 1)) - (chess-pos-piece-p position pos ? ) - (not (chess-standard-search-position position - pos (not color))) - (setq pos (chess-rf-to-index rank 2)) - (chess-pos-piece-p position pos ? ) - (not (chess-standard-search-position position - pos (not color))) - (setq pos (chess-rf-to-index rank 3)) - (chess-pos-piece-p position pos ? ) - (not (chess-standard-search-position position - pos (not color)))))) - (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"))) - - ;; prune from the discovered candidates list any moves which would - ;; leave the king in check; castling through check has already - ;; been eliminated. - (if (char-valid-p piece) - (let ((cand candidates) last-cand pos king-pos) - (while cand - ;; determine the resulting position - (setq pos (chess-pos-move (chess-pos-copy position) - (car cand) target)) - ;; find the king (only once if the king isn't moving) - (if (or (null king-pos) - (eq (downcase piece) ?k)) - (setq king-pos (chess-pos-search pos (if color ?K ?k)))) - ;; can anybody from the opposite side reach him? if so, - ;; drop the candidate - (if (chess-standard-search-position pos (car king-pos) - (not color)) - (if last-cand - (setcdr last-cand (cdr cand)) - (setq candidates (cdr candidates))) - (setq last-cand cand)) - (setq cand (cdr cand))))) - - ;; return the final list of candidate moves - candidates)) - -(provide 'chess-standard) - -;;; chess-standard.el ends here diff --git a/chess-var.el b/chess-var.el new file mode 100644 index 0000000..a3972af --- /dev/null +++ b/chess-var.el @@ -0,0 +1,73 @@ +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; +;; Manipulate variations (which are really just lists of plies) +;; +;; $Revision$ + +;;; Commentary: + +;; A chess variations is a simple list of plies. This module provides +;; an abstraction layer for applications. + +(require 'chess-ply) + +(defsubst chess-var-plies (var) + "Return the tags alist associated with VAR." + var) + +(defsubst chess-var-pos (var &optional index) + "Return the position related to VAR's INDEX position." + (chess-ply-pos (chess-var-ply var index))) + +(defsubst chess-var-index (var) + "Return the VAR's current position index." + (1- (length (chess-var-plies var)))) + +(defsubst chess-var-seq (var) + "Return the current VAR sequence." + (1+ (/ (chess-var-index var) 2))) + +(defsubst chess-var-side-to-move (var) + (chess-pos-side-to-move (chess-var-pos var))) + +(defun chess-var-ply (var &optional index) + "Return the position related to VAR's INDEX position." + (if index + (nth index (chess-var-plies var)) + (car (last (chess-var-plies var))))) + +(defun chess-var-add-ply (var ply) + "Return the position related to VAR's INDEX position." + (let ((plies (chess-var-plies var))) + (assert plies) + (nconc plies (list ply)))) + +(defsubst chess-var-create (&optional position) + "Create a new chess variation object. +Optionally use the given starting POSITION. +SEARCH-FUNC specifies the function used to test the legality of moves. +TAGS is the starting set of var tags (which can always be changed +later using the various tag-related methods)." + (list (chess-ply-create (or position (chess-pos-create))))) + +(defun chess-var-move (var ply) + "Make a move in the current VAR, 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 var is currently in +progress (nil), if it is drawn, resigned, mate, etc." + (let ((current-ply (chess-var-ply var)) + (changes (chess-ply-changes ply)) + (position (chess-ply-pos ply))) + (unless (equal position (chess-ply-pos current-ply)) + (error "Positions do not match")) + (unless (chess-search-position + position (cadr (chess-ply-changes ply)) + (chess-pos-piece position (car (chess-ply-changes ply)))) + (signal 'chess-illegal "Illegal move")) + (chess-ply-set-changes current-ply changes) + (chess-var-add-ply var (chess-ply-create + (chess-ply-next-pos current-ply))))) + +(provide 'chess-var) + +;;; chess-var.el ends here diff --git a/chess.texi b/chess.texi index 359ef5a..d82f2d7 100644 --- a/chess.texi +++ b/chess.texi @@ -75,44 +75,25 @@ any later version published by the Free Software Foundation. @c ================================================================ @ifinfo -@node Top, The Chess.el library, (dir), (dir) +@node Top, Chess.el, (dir), (dir) @top Chess.el -Chess.el is an Emacs chess environment, designed in a modular fashion to -be used either as a library for writing chess-related programs, or as a -plain client for playing chess, analyzing variations, or browsing -historical games. +Chess.el is an Emacs chess client and library, designed to be used for +writing chess-related programs, or for playing games of chess against +various chess engines, including Internet servers. The library can be +used for analyzing variations, browsing historical games, or a +multitude of other purposes. The purpose of this manual is to help you understand how Chess.el is -structured for use as a library, and also how to use the optional -modules which make it useful as a client. These modules also serve as -an example of how to make use of the library. +structured for use as a library, and also how to use it as a client. @end ifinfo -@menu -* The Chess.el library:: -* Displays:: -* Play sessions:: -* Display modules:: -* Ply sources:: -@end menu - -@node The Chess.el library, Displays, Top, Top @chapter The Chess.el library @cindex library -@menu -* Positions:: -* Plies:: -* Variations:: -* Games:: -* Collections:: -@end menu - -@node Positions, Plies, The Chess.el library, The Chess.el library @section Positions -A chess @dfn{position} is a given layout of pieces on the chess board, +A chess @dfn{position} is a given layout of pieces on a chess board, reflecting also which side is next to move, and what privileges are currently available to each side (castling short or long, en passant capture, etc). @@ -129,109 +110,73 @@ notation. Chess puzzles are most often provided as a set of positions. -@menu -* Creating positions:: -* Position coordinates:: -* Manipulating pieces:: -* Position details:: -* Annotations:: -* FEN notation:: -@end menu - -@node Creating positions, Position coordinates, Positions, Positions @subsection Creating positions -@defun chess-pos-create &optional blank -@end defun +@c lispfun chess-pos-create -@defun chess-pos-copy position -@end defun +@c lispfun chess-pos-copy @defvar chess-starting-position @end defvar -@node Position coordinates, Manipulating pieces, Creating positions, Positions @subsection Position coordinates -@defun chess-index-rank index -@end defun +@c lispfun chess-index-rank -@defun chess-index-file index -@end defun +@c lispfun chess-index-file -@defun chess-rf-to-index rank file -@end defun +@c lispfun chess-rf-to-index -@defun chess-coord-to-index coord -@end defun +@c lispfun chess-coord-to-index -@defun chess-index-to-coord index -@end defun +@c lispfun chess-index-to-coord -@defun chess-add-index index rank-move file-move -@end defun +@c lispfun chess-add-index -@node Manipulating pieces, Position details, Position coordinates, Positions -@subsection Manipulating pieces +@subsection Position details -@defun chess-pos-piece position index -@end defun +@c lispfun chess-pos-piece -@defun chess-pos-piece-p position index piece-or-color -@end defun +@c lispfun chess-pos-piece-p -@defun chess-pos-set-piece position index piece -@end defun +@c lispfun chess-pos-set-piece -@defun chess-pos-search position piece-or-color -@end defun +@c lispfun chess-pos-search -@node Position details, Annotations, Manipulating pieces, Positions -@subsection Position details +@c lispfun chess-search-position -@defun chess-pos-can-castle position side -@end defun +@c lispfun chess-pos-can-castle -@defun chess-pos-set-can-castle position side value -@end defun +@c lispfun chess-pos-set-can-castle -@defun chess-pos-en-passant position -@end defun +@c lispfun chess-pos-en-passant -@defun chess-pos-set-en-passant position index -@end defun +@c lispfun chess-pos-set-en-passant -@defun chess-pos-status position -@end defun +@c lispfun chess-pos-status -@defun chess-pos-set-status position status -@end defun +@c lispfun chess-pos-set-status -@defun chess-pos-side-to-move position -@end defun +@c lispfun chess-pos-side-to-move -@defun chess-pos-set-side-to-move position color -@end defun +@c lispfun chess-pos-set-side-to-move + +@c lispfun chess-pos-move + +Missing documentation for 'chess-pos-move' -@node Annotations, FEN notation, Position details, Positions @subsection Annotations -@defun chess-pos-annotation position -@end defun +@c lispfun chess-pos-annotations -@defun chess-pos-add-annotation position annotation -@end defun +@c lispfun chess-pos-add-annotation -@node FEN notation, , Annotations, Positions @subsection FEN notation -@defun chess-fen-to-pos fen-string -@end defun +@c lispfun chess-fen-to-pos -@defun chess-pos-to-fen position &optional full -@end defun +@c lispfun chess-pos-to-fen -@node Plies, Variations, Positions, The Chess.el library @section Plies A @dfn{ply} is the differential between two positions. Or, it is the @@ -251,56 +196,37 @@ 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. -@menu -* Creating plies:: -* Ply details:: -* The "next" position:: -* Algebraic notation:: -@end menu - -@node Creating plies, Ply details, Plies, Plies @subsection Creating plies -@defun chess-ply-create position &rest changes -@end defun +@c lispfun chess-ply-create -@defun chess-legal-plies position color -@end defun +@c lispfun chess-legal-plies -@node Ply details, The "next" position, Creating plies, Plies @subsection Ply details -@defun chess-ply-pos ply -@end defun +@c lispfun chess-ply-pos -@defun chess-ply-set-pos ply position -@end defun +@c lispfun chess-ply-set-pos -@defun chess-ply-changes ply -@end defun +@c lispfun chess-ply-changes -@defun chess-ply-set-changes ply changes -@end defun +@c lispfun chess-ply-set-changes -@node The "next" position, Algebraic notation, Ply details, Plies @subsection The "next" position -@defun chess-ply-next-pos ply -@end defun +@c lispfun chess-ply-next-pos + +@c lispfun chess-ply-final-p -@node Algebraic notation, , The "next" position, Plies @subsection Algebraic notation -@defun chess-ply-to-algebraic ply &optional long -@end defun +@c lispfun chess-ply-to-algebraic -@defun chess-algebraic-to-ply position move -@end defun +@c lispfun chess-algebraic-to-ply @defvar chess-algebraic-regexp @end defvar -@node Variations, Games, Plies, The Chess.el library @section Variations A @dfn{variation} is a sequence of plies that occur after some starting @@ -319,7 +245,32 @@ allowing the user to navigate each of the subsequent positions in turn. They may be represented verbally by announcing each of the plies in turn, as mentioned above. -@node Games, Collections, Variations, The Chess.el library +@subsection Creating variations + +@c lispfun chess-var-create + +@subsection Variation positions + +@c lispfun chess-var-pos + +@c lispfun chess-var-index + +@c lispfun chess-var-seq + +@c lispfun chess-var-side-to-move + +@subsection Varation plies + +@c lispfun chess-var-ply + +@subsection Making a move in a variation + +@c lispfun chess-var-move + +@c lispfun chess-var-add-ply + +@c lispfun chess-var-plies + @section Games A @dfn{game} includes its main variation, incidental information about @@ -333,77 +284,66 @@ A game may be represented in ASCII using standard PGN notation. Representing them graphically or verbally is similar to what is done for variations. -@menu -* Creating games:: -* Game tags:: -* Game positions:: -* Game plies:: -@end menu +@c lispfun chess-game-add-hook + +@c lispfun chess-game-add-ply + +@c lispfun chess-game-hooks + +@c lispfun chess-game-plies + +@c lispfun chess-game-remove-hook + +@c lispfun chess-game-run-hooks + +@c lispfun chess-game-set-hooks + +@c lispfun chess-game-set-plies -@node Creating games, Game tags, Games, Games @subsection Creating games -@defun chess-game-create &optional tags position -@end defun +@c lispfun chess-game-create -@node Game tags, Game positions, Creating games, Games @subsection Game tags -@defun chess-game-tags game -@end defun +@c lispfun chess-game-tags -@defun chess-game-set-tags game tags -@end defun +@c lispfun chess-game-set-tags -@defun chess-game-tag game tag -@end defun +@c lispfun chess-game-tag -@defun chess-game-set-tag game tag value -@end defun +@c lispfun chess-game-set-tag -@defun chess-game-del-tag game tag -@end defun +@c lispfun chess-game-del-tag -@node Game positions, Game plies, Game tags, Games @subsection Game positions -@defun chess-game-pos game &optional index -@end defun +@c lispfun chess-game-pos -@defun chess-game-index game -@end defun +@c lispfun chess-game-index -@defun chess-game-seq game -@end defun +@c lispfun chess-game-seq -@defun chess-game-side-to-move game -@end defun +@c lispfun chess-game-side-to-move -@node Game plies, , Game positions, Games @subsection Game plies -@defun chess-game-ply game &optional index -@end defun +@c lispfun chess-game-ply @subsection Making a move -@defun chess-game-move game ply -@end defun +@c lispfun chess-game-move @subsection PGN notation -@defun chess-pgn-to-game -@end defun +@c lispfun chess-pgn-to-game -@defun chess-game-to-pgn game &optional indented -@end defun +@c lispfun chess-game-to-pgn -@defun chess-pgn-insert-plies index plies &optional for-black indented no-ann -@end defun +@c lispfun chess-pgn-insert-plies @subsubsection PGN mode -@node Collections, , Games, The Chess.el library @section Collections A @dfn{collection} is a set of games archived for later perusal. A set @@ -417,7 +357,6 @@ with a chess database engine for the purpose of storing and retrieving games from the library, or performing library-wide analyses and searches. -@node Displays, Play sessions, The Chess.el library, Top @chapter Displays The previous chapter described all the objects found in @@ -427,138 +366,89 @@ functions given so far. In order to present them in a meaningful fashion to a human reader, it is necessary to create and use a display object. -@defun chess-display-create style perspective &optional session search-func -Create a display, using the given @var{style}. The initial -@var{perspective}---non-nil for white, nil for black---determines the -orientation, which can be inverted by the user afterward. +@c lispfun chess-display-create + +@c lispfun chess-display-destroy + +@chapter Chessboard displays + +@c lispfun chess-display-active-p + +@c lispfun chess-display-clear-board -If @var{session} is given, the display is linked to that -@var{session}, and any moves made on the board that pertain to the -current game's final position, will be transmitted to the -@var{session}. If there is no @var{session}, then moves are made -directly to the game itself. Thus, use @var{session} when you want to -play, and don't when you want to review/edit games. +@c lispfun chess-display-detach-game -@var{search-func} can be a function which is used to search out legal -chess moves when editing position, plies and variations. Since game -object already know the search function to use for that game, this -argument is ignored when a game object is being manipulated. The -default value is @code{chess-standard-search-position}. +@c lispfun chess-display-game -The return value is a display object, which must be passed to all of -the other functions in the section. It is the buffer containing the -chessboard. -@end defun +@c lispfun chess-display-highlight -@defun chess-display-destroy display -Destroy the given @var{display} object, freeing all memory used by it. -@end defun +@c lispfun chess-display-index -@defun chess-display-set-perspective display perspective -Change the perspective on @var{display} to @var{perspective}, which -must be non-nil for a board from white's perspective, and nil for a -board from black's perspective. -@end defun +@c lispfun chess-display-invert -@defun chess-display-search-function display -Return the search function being used by the @var{display} to validate -moves. -@end defun +@c lispfun chess-display-move -@defun chess-display-search-position display position target piece -@end defun +@c lispfun chess-display-move-backward -@defun chess-display-set-position display position &optional search-func -@end defun +@c lispfun chess-display-move-first -@defun chess-display-position display -@end defun +@c lispfun chess-display-move-forward -@defun chess-display-set-ply display ply &optional search-func -@end defun +@c lispfun chess-display-move-last -@defun chess-display-ply display -@end defun +@c lispfun chess-display-perspective -@defun chess-display-set-variation display plies &optional index search-func -@end defun +@c lispfun chess-display-ply -@defun chess-display-variation display -@end defun +@c lispfun chess-display-position -@defun chess-display-set-game display game &optional index -@end defun +@c lispfun chess-display-quit -@defun chess-display-game display -@end defun +@c lispfun chess-display-set-game -@defun chess-display-set-index display index -@end defun +@c lispfun chess-display-set-index -@defun chess-display-index display -@end defun +@c lispfun chess-display-set-perspective -@defun chess-display-update display -@end defun +@c lispfun chess-display-set-ply -@defun chess-display-move display start &optional target -@end defun +@c lispfun chess-display-set-position -@defun chess-display-highlight display index &optional mode -@end defun +@c lispfun chess-display-set-variation -@node Play sessions, Display modules, Displays, Top -@chapter Play sessions +@c lispfun chess-display-update -@node Display modules, Ply sources, Play sessions, Top -@chapter Display modules +@c lispfun chess-display-variation -@node Ply sources, , Display modules, Top -@chapter Ply sources +@chapter Engines -@menu -* Chess engines:: -@end menu +@c lispfun chess-engine-create -@node Chess engines, , Ply sources, Ply sources -@section Engines +@c lispfun chess-engine-set-option -@defun chess-engine-create style callback &optional session -@end defun +@c lispfun chess-engine-option -@defun chess-engine-set-option engine option value -@end defun +@c lispfun chess-engine-destroy -@defun chess-engine-option engine option -@end defun +@c lispfun chess-engine-set-position -@c 'ponder -@c 'search-depth -@c 'wall-clock +@c lispfun chess-engine-position -@defun chess-engine-destroy engine -@end defun +@c lispfun chess-engine-set-game -@defun chess-engine-set-position engine position ; uses 'edit' command -@end defun +@c lispfun chess-engine-game -@defun chess-engine-position engine -@end defun +@c lispfun chess-engine-index -@defun chess-engine-set-game engine game -@end defun +@c lispfun chess-engine-move -@defun chess-engine-game engine -@end defun +@c lispfun chess-engine-command -@defun chess-engine-index engine -@end defun +@c lispfun chess-engine-detach-game -@defun chess-engine-move engine ply -@end defun +@c lispfun chess-engine-pass -@defun chess-engine-command engine string -@end defun +@c lispfun chess-engine-send @unnumbered Concept Index diff --git a/lispdoc.el b/lispdoc.el new file mode 100644 index 0000000..88994b2 --- /dev/null +++ b/lispdoc.el @@ -0,0 +1,47 @@ +(defun update-lispdoc-tags () + (interactive) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^@c lispfun \\(.+\\)" nil t) + (let ((name (match-string 1)) begin end) + (message "Update lispdoc for function '%s'" name) + (if (re-search-forward (concat "^@defun " name) nil t) + (setq begin (match-beginning 0))) + (if (re-search-forward "^@end defun" nil t) + (setq end (match-end 0))) + (if (and begin end) + (delete-region begin end)) + (let* ((sym (or (intern-soft name) + (error "'%s' is not a function!" name))) + (data (symbol-function sym)) + (args (pp-to-string (if (listp data) + (cadr data) + (aref data 0)))) + (doc (documentation sym))) + (if (or (null doc) (= (length doc) 0)) + (message "warning: no documentation available for '%s'" name) + (unless (and begin end) + (insert ?\n ?\n)) + (insert (format "@defun %s %s\n" name + (substring args 1 (- (length args) 2)))) + (setq begin (point)) + (insert doc ?\n) + (save-restriction + (narrow-to-region begin (point)) + (goto-char (point-min)) + (let ((case-fold-search nil)) + (while (re-search-forward "[A-Z][A-Z-]+" nil t) + (replace-match (format "@var{%s}" + (downcase (match-string 0))) t t))) + (goto-char (point-max))) + (insert "@end defun"))))))) + +(defun chess-undocd-functions () + (interactive) + (save-excursion + (dolist (func (apropos-internal "^chess-" 'functionp)) + (goto-char (point-min)) + (unless (search-forward (concat "@c lispfun " (symbol-name func)) nil t) + (message "Missing documentation for '%s'" (symbol-name func)))))) + +(provide 'lispdoc) -- cgit v1.2.3