summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Wiegley <johnw@newartisans.com>2002-04-28 16:09:14 +0000
committerJohn Wiegley <johnw@newartisans.com>2002-04-28 16:09:14 +0000
commit80ab4cec14452a641e741d372037dafda16ee871 (patch)
tree352324dc62ffbd3c9c651a7154a2e88338144641
parent7248e5c89f6d53d3f2a4ecf511167af929241f76 (diff)
*** no comment ***
-rw-r--r--PLAN33
-rw-r--r--README56
-rw-r--r--TODO23
-rw-r--r--chess-algebraic.el9
-rw-r--r--chess-clock.el13
-rw-r--r--chess-common.el12
-rw-r--r--chess-crafty.el4
-rw-r--r--chess-database.el41
-rw-r--r--chess-display.el53
-rw-r--r--chess-engine.el17
-rw-r--r--chess-fen.el2
-rw-r--r--chess-file.el9
-rw-r--r--chess-game.el79
-rw-r--r--chess-german.el11
-rw-r--r--chess-ics.el13
-rw-r--r--chess-network.el8
-rw-r--r--chess-ply.el111
-rw-r--r--chess-pos.el334
-rw-r--r--chess-puzzle.el28
-rw-r--r--chess-scid.el35
-rw-r--r--chess-tutorial.el19
-rw-r--r--chess-ucb.el2
-rw-r--r--chess-var.el10
23 files changed, 651 insertions, 271 deletions
diff --git a/PLAN b/PLAN
index 5d3e5dd..0b5d661 100644
--- a/PLAN
+++ b/PLAN
@@ -4,37 +4,26 @@ translate: chess-german
chess
- clean up this code; let people override the chess-default-* lists
-chess-pos
-- in chess-pos-can-castle, the return value should be nil, or the
- position of the rook to be used when castling on that side
-- create chess-pos-legal-move, which returns non-nil if a specific
- move can be made; this makes the castling code much easier to write
-
chess-ply
-- When creating the next position, set the annotations to point to the
- keywords of the ply that led to that position; in fact, just point
- to the creating ply!
-- Add :nag, :rav, :ann and :next-pos keywords to a ply
-- Thus there will be a mirror set of chess-pos-has-keyword, etc.,
- functions
- Need to detect games drawn by three-fold repetition
-- Rename chess-ply-create-castle to chess-ply-castling-changes
-
-chess-display
-- there is no way to call flag right now
-- invert the mode line to show the side on move?
chess-engine
- add a `force' event for forcing an engine to move
+chess-puzzle
+- after hitting chess-puzzle-next, clear out the engine so that it
+ doesn't try to respond
+
chess-ics
- detect draw/retract, etc.
-- add support for ICS observing
+- allow ICS observing
+
+chess-display
+- after Rhe1 in one game, the source rook was not cleared
-chess-clock
-- when a clock runs down, allow the user to call-flag in order to win
- on time; note: the user should be allowed to try anyway, in case our
- clock has become out-of-sync with the server's
+chess-gnuchess
+- setting up game positions does not work at all, such as with
+ chess-puzzle
chess-images
- in a generic emacs, with a light background, there are white lines
diff --git a/README b/README
index 65b86ab..3ffbac2 100644
--- a/README
+++ b/README
@@ -9,3 +9,59 @@ sufficiently challenging, I'm sure. Once they are installed, chess.el
will use them, provided the locations of the binaries is on your PATH.
John Wiegley <johnw@gnu.org>
+
+LAYOUT
+
+Core library
+
+ chess-pos.el
+ chess-fen.el
+
+ chess-ply.el
+ chess-algebraic.el
+
+ chess-var.el
+ chess-game.el
+
+* chess-module.el
+** chess-announce.el
+** chess-sound.el
+** chess-display.el
+*** chess-plain.el
+*** chess-ics1.el
+*** chess-images.el
+** chess-database.el
+*** chess-file.el
+*** chess-pgn.el
+*** chess-scid.el
+** chess-engine.el
+*** chess-none.el
+*** chess-common.el
+**** chess-crafty.el
+**** chess-gnuchess.el
+**** chess-phalanx.el
+*** chess-network.el
+**** chess-irc.el
+**** chess-ics.el
+
+** input modules
+*** chess-input.el
+*** chess-ucb.el
+
+chess-autosave.el
+chess-chat.el
+chess-clock.el
+chess-kibitz.el
+
+* chess-message.el
+** chess-german.el
+
+chess-maint.el
+
+chess.el
+chess-link.el
+chess-puzzle.el
+chess-tutorial.el
+
+chess-random.el
+chess-transport.el
diff --git a/TODO b/TODO
index 34c1e29..2facbb4 100644
--- a/TODO
+++ b/TODO
@@ -4,6 +4,22 @@ These are features scheduled for future 2.x releases.
General Features
+- Write chess-descriptive.el, and have the code in general use
+ chess-ply-to-string and chess-string-to-ply, so that users can use
+ descriptive notationas an alternative to algebraic.
+
+- Write chess-html.el, for outputting a game to HTML
+
+- Write chess-latex.el, for outputting a game to LaTeX
+
+- Use TrueType or other chess fonts for displaying positions; this
+ might be the best way of displaying positions on Windows
+
+- Change chess-announce/sound so that it reads from the text rendition
+ of the move; this way it will work with either descriptive or
+ algebraic notation. Also, chess-announce and chess-sound can be
+ collapsed into one module, with different "styles" of announcing.
+
- Write chess-epd.el, which is based on chess-fen, and is also a
database module for accessing positions within an EPD file
@@ -98,7 +114,12 @@ These are features scheduled for future 2.x releases.
Other variations
-Need a way to play bughouse/crazyhouse games.
+- Need a way to play bughouse/crazyhouse games.
----------------------------------------------------------------------
+ Other features
+
+- Keeping a player database in BBDB
+
+- Managing a tournament, setting up pairings, calculating ratings
diff --git a/chess-algebraic.el b/chess-algebraic.el
index 0ae8016..848a97c 100644
--- a/chess-algebraic.el
+++ b/chess-algebraic.el
@@ -60,16 +60,16 @@ This regexp handles both long and short form.")
(defun chess-algebraic-to-ply (position move &optional trust)
"Convert the algebraic notation MOVE for POSITION to a ply."
+ (assert (vectorp position))
+ (assert (stringp move))
(when (string-match chess-algebraic-regexp-entire move)
(let ((color (chess-pos-side-to-move position))
(mate (match-string 9 move))
(piece (aref move 0))
changes ply)
(if (eq piece ?O)
- (let ((long (= (length (match-string 1 move)) 5)))
- (if (chess-pos-can-castle position (if long (if color ?Q ?q)
- (if color ?K ?k)))
- (setq changes (chess-ply-create-castle position long))))
+ (setq changes (chess-ply-castling-changes
+ position (= (length (match-string 1 move)) 5)))
(let ((promotion (match-string 8 move)))
(setq changes
(let ((source (match-string 4 move))
@@ -172,6 +172,7 @@ This regexp handles both long and short form.")
(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."
+ (assert (listp ply))
(let (source san)
(cond
((or (null (setq source (chess-ply-source ply)))
diff --git a/chess-clock.el b/chess-clock.el
index 8913908..cbb5c37 100644
--- a/chess-clock.el
+++ b/chess-clock.el
@@ -58,17 +58,16 @@
(run-with-timer 0 1 'chess-clock-tick-tock (current-buffer))))
(let ((last-ply (car (last (chess-game-plies game) 2))))
(chess-ply-set-keyword last-ply :white white)
- (chess-ply-set-keyword last-ply :black black)))))
+ (chess-ply-set-keyword last-ply :black black))))
+
+ (if (and chess-clock-timer (chess-game-over-p game))
+ (cancel-timer chess-clock-timer)
+ (setq chess-clock-timer nil)))
((eq event 'set-data)
(if (and (eq (car args) 'active)
(not (chess-game-data game 'active)))
- (chess-clock-handler game 'destroy)))
-
- ((memq event '(destroy resign drawn))
- (when chess-clock-timer
- (cancel-timer chess-clock-timer)
- (setq chess-clock-timer nil)))))
+ (chess-clock-handler game 'destroy)))))
(defvar chess-clock-tick-tocking nil)
diff --git a/chess-common.el b/chess-common.el
index 7f32eb4..2c590a6 100644
--- a/chess-common.el
+++ b/chess-common.el
@@ -64,10 +64,7 @@
((eq event 'draw)
(chess-message 'draw-offer-declined))
- ((eq event 'drawn)
- (chess-game-set-data game 'active nil))
-
- ((memq event '(resign abort new))
+ ((eq event 'new)
(chess-engine-send nil "new\n")
(chess-engine-set-position nil))
@@ -86,7 +83,12 @@
(chess-game-set-tag game "White" chess-full-name)
(chess-game-set-tag game "Black" chess-engine-opponent-name))
- (chess-engine-send nil (concat (chess-ply-to-algebraic (car args)) "\n"))
+ (cond
+ ((chess-ply-keyword (car args) :resign)
+ (chess-engine-send nil "resign\n"))
+ (t
+ (chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
+ "\n"))))
(if (chess-game-over-p game)
(chess-game-set-data game 'active nil)))))
diff --git a/chess-crafty.el b/chess-crafty.el
index 9c3924e..509f749 100644
--- a/chess-crafty.el
+++ b/chess-crafty.el
@@ -32,6 +32,10 @@
(lambda ()
(setq chess-crafty-evaluation
(string-to-number (match-string 1))))))
+ (cons "{\\(Black\\|White\\) resigns}"
+ (function
+ (lambda ()
+ (funcall chess-engine-response-handler 'resign))))
(cons "\\(Illegal move\\|unrecognized/illegal command\\):\\s-*\\(.*\\)"
(function
(lambda ()
diff --git a/chess-database.el b/chess-database.el
index 9c48297..4903884 100644
--- a/chess-database.el
+++ b/chess-database.el
@@ -3,6 +3,17 @@
;; Basic code for manipulating game databases
;;
+(require 'chess-message)
+
+(defgroup chess-database nil
+ "Generic interface to chess database modules."
+ :group 'chess)
+
+(defcustom chess-database-modules '(chess-scid chess-file)
+ "List of database modules to try when `chess-database-open' is called."
+ :type '(repeat (symbol :tag "Module"))
+ :group 'chess-database)
+
(defvar chess-database-handler nil)
(make-variable-buffer-local 'chess-database-handler)
@@ -10,7 +21,7 @@
(chess-message-catalog 'english
'((no-such-database . "There is no such chess database module '%s'")))
-(defun chess-database-open (module file)
+(defun chess-database-do-open (module file)
"Returns the opened database object, or nil."
(let* ((name (symbol-name module))
(handler (intern-soft (concat name "-handler")))
@@ -24,6 +35,19 @@
(add-hook 'after-revert-hook 'chess-database-rescan nil t)
(current-buffer)))))
+(defun chess-database-open (file &optional module)
+ "Returns the opened database object, or nil."
+ (if module
+ (chess-database-do-open module file)
+ (let (result)
+ (setq module chess-database-modules)
+ (while module
+ (if (and (require (car module) nil t)
+ (setq result (chess-database-do-open (car module) file)))
+ (setq module nil)
+ (setq module (cdr module))))
+ result)))
+
(defsubst chess-database-command (database event &rest args)
(with-current-buffer database
(apply chess-database-handler event args)))
@@ -46,19 +70,8 @@
(defun chess-database-count (database)
(chess-database-command database 'count))
-(defun chess-database-read (database index-or-moniker)
- (if (integerp index-or-moniker)
- (chess-database-command database 'read index-or-moniker)
- (if (string-match "\\`\\([^:]+\\):\\([^#]+\\)#\\([0-9]+\\)\\'"
- index-or-moniker)
- (let* ((type (match-string 1 index-or-moniker))
- (path (match-string 2 index-or-moniker))
- (index (string-to-int
- (match-string 3 index-or-moniker)))
- (db (chess-database-open
- (intern (concat "chess-" type)) path)))
- (if db
- (chess-database-read db index))))))
+(defun chess-database-read (database index)
+ (chess-database-command database 'read index))
(defun chess-database-write (database game)
(chess-database-command database 'write game))
diff --git a/chess-display.el b/chess-display.el
index 625c2e8..97a3b9c 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -26,13 +26,15 @@
(mode-black . "Black")
(mode-start . "START")
(mode-checkmate . "CHECKMATE")
+ (mode-aborted . "ABORTED")
(mode-resigned . "RESIGNED")
(mode-stalemate . "STALEMATE")
+ (mode-flag-fell . "FLAG FELL")
(mode-drawn . "DRAWN")
(mode-edit . "EDIT")))
(defcustom chess-display-mode-line-format
- '(" " chess-display-side-to-move " "
+ '(" " chess-display-side-to-move " "
chess-display-move-text " "
(:eval (chess-display-clock-string))
"(" (:eval (chess-game-tag chess-module-game "White")) "-"
@@ -46,6 +48,16 @@ See `mode-line-format' for syntax details."
:type 'sexp
:group 'chess-display)
+(defface chess-display-black-face
+ '((t (:background "Black" :foreground "White")))
+ "*The face used for the word Black in the mode-line."
+ :group 'chess-display)
+
+(defface chess-display-white-face
+ '((t (:background "White" :foreground "Black")))
+ "*The face used for the word White in the mode-line."
+ :group 'chess-display)
+
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -211,15 +223,24 @@ also view the same game."
chess-display-side-to-move
(let ((status (chess-game-status chess-module-game index)))
(cond
+ ((eq status :aborted) (chess-string 'mode-aborted))
((eq status :resign) (chess-string 'mode-resigned))
- ((eq status :draw) (chess-string 'mode-drawn))
+ ((eq status :drawn) (chess-string 'mode-drawn))
((eq status :checkmate) (chess-string 'mode-checkmate))
((eq status :stalemate) (chess-string 'mode-stalemate))
+ ((eq status :flag-fell) (chess-string 'mode-flag-fell))
(t
- (if (or chess-pos-always-white
- (chess-game-side-to-move chess-module-game index))
- (chess-string 'mode-white)
- (chess-string 'mode-black))))))
+ (let* ((color (or chess-pos-always-white
+ (chess-game-side-to-move chess-module-game
+ index)))
+ (str (format " %s " (if color
+ (chess-string 'mode-white)
+ (chess-string 'mode-black)))))
+ (add-text-properties
+ 0 (length str) (list 'face (if color
+ 'chess-display-white-face
+ 'chess-display-black-face)) str)
+ str)))))
(force-mode-line-update)))
(defsubst chess-display-index (display)
@@ -389,7 +410,7 @@ that is supported by most displays, and is the default mode."
:group 'chess-display)
(defcustom chess-display-momentous-events
- '(orient post-undo setup-game pass move resign drawn)
+ '(orient post-undo setup-game pass move)
"Events that will refresh, and cause 'main' displays to popup.
These are displays for which `chess-display-set-main' has been
called."
@@ -486,6 +507,7 @@ See `chess-display-type' for the different kinds of displays."
(define-key map [(control ?c) (control ?d)] 'chess-display-draw)
(define-key map [?E] 'chess-display-edit-board)
(define-key map [?F] 'chess-display-set-from-fen)
+ (define-key map [(control ?c) (control ?f)] 'chess-display-call-flag)
(define-key map [?M] 'chess-display-match)
(define-key map [(control ?c) (control ?r)] 'chess-display-resign)
(define-key map [?R] 'chess-display-retract)
@@ -788,13 +810,17 @@ Basically, it means we are playing, not editing or reviewing."
(chess-game-run-hooks chess-module-game 'retract)
(ding)))
+(defun chess-display-call-flag ()
+ (interactive)
+ (if (chess-display-active-p)
+ (chess-game-run-hooks chess-module-game 'call-flag)
+ (ding)))
+
(defun chess-display-resign ()
"Resign the current game."
(interactive)
(if (chess-display-active-p)
- (progn
- (chess-game-end chess-module-game :resign)
- (chess-game-run-hooks chess-module-game 'resign))
+ (chess-game-end chess-module-game :resign)
(ding)))
(defun chess-display-abort ()
@@ -1071,8 +1097,11 @@ Clicking once on a piece selects it; then click on the target location."
(cdr last-sel)
coord))
(throw 'message (chess-string 'move-not-legal)))
- (chess-display-move nil ply
- (car last-sel) (point)))))
+ (condition-case err
+ (chess-display-move nil ply
+ (car last-sel) (point))
+ (error
+ (throw 'message (error-message-string err)))))))
(setq chess-display-last-selected nil))
(let ((piece (chess-pos-piece position coord)))
(cond
diff --git a/chess-engine.el b/chess-engine.el
index 2beb35e..adce754 100644
--- a/chess-engine.el
+++ b/chess-engine.el
@@ -67,6 +67,7 @@
(opp-abort-ret . "Your opponent has retracted their offer to abort")
(opp-undo-ret . "Your opponent has retracted their request to undo %d moves")
(opp-illegal . "Your opponent states your last command was illegal")
+ (opp-call-flag . "Your flag fell, and your opponent has called time")
(failed-start . "Failed to start chess engine process")))
(defsubst chess-engine-convert-algebraic (move &optional trust-check)
@@ -167,7 +168,7 @@
(if (y-or-n-p (chess-string 'opp-draw))
(progn
(let ((chess-engine-handling-event t))
- (chess-game-end game :draw)
+ (chess-game-end game :drawn)
(chess-game-set-data game 'active nil))
(chess-engine-command nil 'accept))
(chess-engine-command nil 'decline))
@@ -177,6 +178,7 @@
(if (y-or-n-p (chess-string 'opp-abort))
(progn
(let ((chess-engine-handling-event t))
+ (chess-game-end game :aborted)
(chess-game-set-data game 'active nil))
(chess-engine-command nil 'accept))
(chess-engine-command nil 'decline))
@@ -206,11 +208,12 @@
(cond
((eq chess-engine-pending-offer 'draw)
(chess-message 'opp-draw-acc)
- (chess-game-end game :draw)
+ (chess-game-end game :drawn)
(chess-game-set-data game 'active nil))
((eq chess-engine-pending-offer 'abort)
(chess-message 'opp-abort-acc)
+ (chess-game-end game :aborted)
(chess-game-set-data game 'active nil))
((eq chess-engine-pending-offer 'undo)
@@ -260,8 +263,14 @@
(chess-game-undo game 1)))
((eq event 'call-flag)
- ;; jww (2002-04-21): what to do here?
- )
+ (let ((remaining
+ (chess-game-data game (if (chess-game-data game 'my-color)
+ 'white-remaining
+ 'black-remaining))))
+ (when (< remaining 0)
+ (chess-message 'opp-call-flag)
+ (chess-game-end game :flag-fell)
+ (chess-game-set-data game 'active nil))))
((eq event 'kibitz)
(let ((chess-engine-handling-event t))
diff --git a/chess-fen.el b/chess-fen.el
index 91ee683..b428a5f 100644
--- a/chess-fen.el
+++ b/chess-fen.el
@@ -40,6 +40,7 @@
(defun chess-fen-to-pos (fen)
"Convert a FEN-like notation string to a chess position."
+ (assert (stringp fen))
(let ((i 0) (l (length fen))
(rank 0) (file 0) (c ?0)
(position (chess-pos-create t))
@@ -88,6 +89,7 @@
(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."
+ (assert (vectorp position))
(let ((blank 0) (str "") output)
(dotimes (rank 8)
(dotimes (file 8)
diff --git a/chess-file.el b/chess-file.el
index dfbd3b6..1f99b58 100644
--- a/chess-file.el
+++ b/chess-file.el
@@ -13,14 +13,17 @@
(cond
((eq event 'open)
(with-current-buffer (find-file-noselect (car args))
- (chess-file-handler 'rescan)
- (current-buffer)))
+ (when (or (string-match "\\.pgn\\'" (car args))
+ (save-excursion
+ (re-search-forward "^\\[Event" nil t)))
+ (chess-file-handler 'rescan)
+ (current-buffer))))
((eq event 'rescan)
(save-excursion
(goto-char (point-min))
(setq chess-file-locations nil)
- (while (search-forward "[Event " nil t)
+ (while (re-search-forward "^\\[Event " nil t)
(goto-char (match-beginning 0))
(push (point) chess-file-locations)
(forward-char 1))
diff --git a/chess-game.el b/chess-game.el
index 970274e..5bb53a6 100644
--- a/chess-game.el
+++ b/chess-game.el
@@ -24,14 +24,19 @@
(defsubst chess-game-hooks (game)
"Return the tags alist associated with GAME."
+ (assert game)
(car game))
(defsubst chess-game-set-hooks (game hooks)
"Return the tags alist associated with GAME."
+ (assert game)
+ (assert (or hooks (eq hooks nil)))
(setcar game hooks))
(defun chess-game-add-hook (game function &optional data prepend)
"Return the tags alist associated with GAME."
+ (assert game)
+ (assert function)
(let ((hooks (chess-game-hooks game)))
(if (null hooks)
(chess-game-set-hooks game (list (cons function data)))
@@ -43,6 +48,8 @@
"Remove from GAME all event hooks that match FUNCTION.
If DATA is specified, only remove those hooks whose associated data
matches."
+ (assert game)
+ (assert function)
(let* ((hooks (chess-game-hooks game))
(h hooks) last-hook)
(while h
@@ -58,6 +65,7 @@ matches."
(defsubst chess-game-run-hooks (game &rest args)
"Return the tags alist associated with GAME."
+ (assert game)
(unless chess-game-inhibit-events
(let (result)
(dolist (hook (chess-game-hooks game) result)
@@ -66,20 +74,28 @@ matches."
(defsubst chess-game-tags (game)
"Return the tags alist associated with GAME."
+ (assert game)
(cadr game))
(defsubst chess-game-set-tags (game tags)
"Return the tags alist associated with GAME."
+ (assert game)
+ (assert (or tags (eq tags nil)))
(setcar (cdr game) tags)
(chess-game-run-hooks game 'set-tags))
(defsubst chess-game-tag (game tag)
"Return the value for TAG in GAME."
+ (assert game)
+ (assert tag)
(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."
+ (assert game)
+ (assert tag)
+ (assert value)
(let ((tags (chess-game-tags game)))
(if (null tags)
(chess-game-set-tags game (list (cons tag value)))
@@ -91,17 +107,23 @@ matches."
(defsubst chess-game-del-tag (game tag)
"Set a TAG for GAME to VALUE."
+ (assert game)
+ (assert tag)
(chess-game-set-tags game (assq-delete-all tag (chess-game-tags game)))
(chess-game-run-hooks game 'delete-tag tag))
(defsubst chess-game-data-alist (game)
+ (assert game)
(nth 2 game))
(defsubst chess-game-set-data-alist (game value)
+ (assert game)
(setcar (nthcdr 2 game) value))
(defun chess-game-set-data (game key value)
+ (assert game)
+ (assert (symbolp key))
(let* ((alist (chess-game-data-alist game))
(cell (assq key alist)))
(if cell
@@ -113,11 +135,15 @@ matches."
(chess-game-run-hooks game 'set-data key)))
(defun chess-game-data (game key)
+ (assert game)
+ (assert (symbolp key))
(let ((alist (chess-game-data-alist game)))
(if alist
(cdr (assq key alist)))))
(defun chess-game-del-data (game key)
+ (assert game)
+ (assert (symbolp key))
(let ((alist (chess-game-data-alist game)))
(if alist
(assq-delete-all key alist))))
@@ -125,38 +151,46 @@ matches."
(defsubst chess-game-plies (game)
"Return the tags alist associated with GAME."
+ (assert game)
(nth 3 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) (list plies))
+ (assert game)
+ (setcdr (nthcdr 2 game) (if plies (list plies) nil))
(chess-game-run-hooks game 'setup-game game))
(defsubst chess-game-set-start-position (game position)
"Return the tags alist associated with GAME."
+ (assert game)
+ (assert (vectorp position))
(chess-game-set-plies game (list (chess-ply-create* position))))
(defsubst chess-game-pos (game &optional index)
"Return the position related to GAME's INDEX position."
+ (assert game)
(chess-ply-pos (chess-game-ply game index)))
(defun chess-game-status (game &optional index)
"Return a symbol, such as :checkmate, :resign, etc.
This conveys the status of the game at the given index."
- (or (chess-pos-status (chess-game-pos chess-module-game index))
- (let ((final (chess-ply-final-p
- (chess-game-ply chess-module-game index))))
- (and (memq final '(:resign :draw :perpetual :repetition))
+ (assert game)
+ (or (chess-pos-status (chess-game-pos game index))
+ (let ((final (chess-ply-final-p (chess-game-ply game index))))
+ (and (memq final '(:aborted :resign :drawn :perpetual :repetition
+ :flag-fell))
final))))
(defsubst chess-game-index (game)
"Return the GAME's current position index."
+ (assert game)
(1- (length (chess-game-plies game))))
(defun chess-game-seq (game)
"Return the current GAME sequence."
+ (assert game)
(let ((index (chess-game-index game)))
(if (> index 1)
(if (= (mod index 2) 0)
@@ -165,16 +199,20 @@ This conveys the status of the game at the given index."
1)))
(defsubst chess-game-side-to-move (game &optional index)
- (= (mod (or index (chess-game-index game)) 2) 0))
+ (assert game)
+ (chess-pos-side-to-move (chess-game-pos game index)))
(defun chess-game-ply (game &optional index)
"Return the position related to GAME's INDEX position."
+ (assert game)
(if index
(nth index (chess-game-plies game))
(car (last (chess-game-plies game)))))
(defun chess-game-add-ply (game ply)
"Return the position related to GAME's INDEX position."
+ (assert game)
+ (assert (listp ply))
(let ((plies (chess-game-plies game)))
(if plies
(nconc plies (list ply))
@@ -187,6 +225,8 @@ This conveys the status of the game at the given index."
(defun chess-game-undo (game count)
"Undo the last COUNT plies of GAME."
+ (assert game)
+ (assert (integerp count))
(if (> count (chess-game-index game))
(chess-error 'undo-limit-reached))
(let ((chess-game-inhibit-events t))
@@ -196,6 +236,7 @@ This conveys the status of the game at the given index."
(defun chess-game-strip-annotations (game)
"Strip all annotations from the given GAME."
+ (assert game)
(dotimes (i (chess-game-index game))
(let ((position (chess-game-pos game i)))
(chess-pos-set-annotations position nil))))
@@ -203,18 +244,23 @@ This conveys the status of the game at the given index."
(defsubst chess-game-over-p (game)
"Return the position related to GAME's INDEX position."
+ (assert game)
(let ((last-ply (car (last (nth 3 game) 2))))
(and last-ply (chess-ply-final-p last-ply))))
(defsubst chess-game-to-string (game &optional indented)
+ (assert game)
(chess-game-to-pgn game indented t))
(defsubst chess-game-from-string (pgn)
+ (assert (stringp pgn))
(chess-pgn-to-game pgn))
(defsubst chess-game-copy-game (game new-game)
+ (assert game)
+ (assert new-game)
(chess-game-set-tags game (chess-game-tags new-game))
(chess-game-set-plies game (chess-game-plies new-game)))
@@ -238,6 +284,8 @@ later using the various tag-related methods)."
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."
+ (assert game)
+ (assert (listp ply))
(let ((current-ply (chess-game-ply game))
(changes (chess-ply-changes ply))
(position (chess-ply-pos ply)))
@@ -250,8 +298,8 @@ progress (nil), if it is drawn, resigned, mate, etc."
(assert changes)
(chess-ply-set-changes current-ply changes)
- (unless (chess-ply-any-keyword ply :draw :perpetual :repetition
- :resign)
+ (unless (chess-ply-any-keyword ply :drawn :perpetual :repetition
+ :resign :aborted :flag-fell)
(chess-game-add-ply game (chess-ply-create*
(chess-ply-next-pos current-ply))))
@@ -259,17 +307,14 @@ progress (nil), if it is drawn, resigned, mate, etc."
(cond
((and long (chess-ply-any-keyword ply :resign :checkmate))
(let ((color (chess-game-side-to-move game)))
- (chess-game-set-tag game "Result" (if color "0-1" "1-0"))
- (if (chess-ply-keyword ply :resign)
- (chess-game-run-hooks game 'resign color)
- (chess-game-run-hooks game 'move current-ply))))
- ((and long (chess-ply-any-keyword ply :draw :perpetual :repetition
+ (if (chess-ply-any-keyword ply :resign :flag-fell)
+ (chess-game-set-tag game "Result" (if color "0-1" "1-0"))
+ (chess-game-set-tag game "Result" (if color "1-0" "0-1")))))
+ ((and long (chess-ply-any-keyword ply :drawn :perpetual :repetition
:stalemate))
- (chess-game-set-tag game "Result" "1/2-1/2")
- (chess-game-run-hooks game 'drawn))
- (t
- (chess-game-run-hooks game 'move current-ply))))
+ (chess-game-set-tag game "Result" "1/2-1/2"))))
+ (chess-game-run-hooks game 'move current-ply)
(chess-game-run-hooks game 'post-move)))
(defsubst chess-game-end (game keyword)
diff --git a/chess-german.el b/chess-german.el
index 201f2ba..3da88ec 100644
--- a/chess-german.el
+++ b/chess-german.el
@@ -85,20 +85,21 @@
(cannot-mount . "You cannot move pieces on top of each other")
(editing-directly . "Now editing position directly, use S when complete...")
(return-to-current . "Use '>' to return to the current position")
- (draw-offer . "You offer a draw")
+ (draw-offer . "You offer a draw")
(want-to-quit . "Do you really want to quit? ")
(illegal-notation . "Illegal move notation: %s")
(san-not-found . "Could not find a matching move")
(cannot-yet-add . "Cannot insert moves into a game (yet)")
(no-such-style . "There is no such chessboard display style '%s'")
(mode-edit . "EDIT")
- (mode-drawn . "DRAWN")
+ (mode-drawn . "DRAWN")
(mode-stalemate . "STALEMATE")
+ (mode-flag-fell . "FLAG FELL")
(mode-resigned . "RESIGNED")
(mode-checkmate . "CHECKMATE")
- (mode-start . "START")
- (mode-black . "Black")
- (mode-white . "White")
+ (mode-start . "START")
+ (mode-black . "Black")
+ (mode-white . "White")
(game-is-over . "This game is over")
(not-your-move . "It is not your turn to move")
(no-such-module . "There is no module named '%s'")
diff --git a/chess-ics.el b/chess-ics.el
index 4b9c896..509a5ca 100644
--- a/chess-ics.el
+++ b/chess-ics.el
@@ -243,16 +243,13 @@ who is black."
(eq (chess-pos-side-to-move (nth 0 info))
(chess-game-data game 'my-color)))
(let ((ign (setq error 'converting-ply))
- (ply (chess-algebraic-to-ply
- (chess-ply-pos
- ;; jww (2002-04-25): change this, once I
- ;; allow position to refer to their
- ;; causal ply
- (car (last (chess-game-plies game))))
- (nth 1 info) t)))
+ (ply (chess-algebraic-to-ply (chess-game-pos game)
+ (nth 1 info) t)))
(chess-game-set-data game 'white-remaining (nth 4 info))
(chess-game-set-data game 'black-remaining (nth 5 info))
(setq error 'applying-move)
+ (chess-ply-set-keyword ply :next-pos (nth 0 info))
+ (chess-pos-set-preceding-ply (nth 0 info) ply)
(chess-game-move game ply)
(setq error nil))
(setq error nil))
@@ -274,7 +271,7 @@ who is black."
(chess-game-set-tag game "Black" (nth 3 info))
(chess-game-set-tag game "Site" (car chess-ics-server))
(setq error 'setting-start-position)
- (chess-game-set-start-position game (car info)))
+ (chess-game-set-start-position game (nth 0 info)))
(setq error 'orienting-board)
(chess-game-run-hooks game 'orient)
(setq error nil))
diff --git a/chess-network.el b/chess-network.el
index ed1c512..7d22c49 100644
--- a/chess-network.el
+++ b/chess-network.el
@@ -70,7 +70,7 @@
(function
(lambda ()
(funcall chess-engine-response-handler 'illegal))))
- (cons "call flag$"
+ (cons "flag$"
(function
(lambda ()
(funcall chess-engine-response-handler 'call-flag))))
@@ -147,10 +147,6 @@
(setq chess-engine-pending-offer 'match)
(chess-engine-send nil (format "chess match %s\n" chess-full-name)))
- ((eq event 'resign)
- (chess-engine-send nil "resign\n")
- (chess-game-set-data game 'active nil))
-
((eq event 'draw)
(if chess-engine-pending-offer
(chess-engine-command nil 'retract))
@@ -183,7 +179,7 @@
(chess-engine-send nil "illegal\n"))
((eq event 'call-flag)
- (chess-engine-send nil "call flag\n"))
+ (chess-engine-send nil "flag\n"))
((eq event 'kibitz)
(chess-engine-send nil (format "kibitz %s\n"
diff --git a/chess-ply.el b/chess-ply.el
index b21c21f..a016e2e 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -51,24 +51,33 @@
:group 'chess)
(defsubst chess-ply-pos (ply)
+ (assert (listp ply))
(car ply))
(defsubst chess-ply-set-pos (ply position)
+ (assert (listp ply))
+ (assert (vectorp position))
(setcar ply position))
(defsubst chess-ply-changes (ply)
+ (assert (listp ply))
(cdr ply))
(defsubst chess-ply-set-changes (ply changes)
+ (assert (listp ply))
+ (assert (listp changes))
(setcdr ply changes))
(defun chess-ply-any-keyword (ply &rest keywords)
+ (assert (listp ply))
(catch 'found
(dolist (keyword keywords)
(if (memq keyword (chess-ply-changes ply))
(throw 'found keyword)))))
(defun chess-ply-keyword (ply keyword)
+ (assert (listp ply))
+ (assert (symbolp keyword))
(let ((item (memq keyword (chess-ply-changes ply))))
(if item
(if (eq item (last (chess-ply-changes ply)))
@@ -76,6 +85,8 @@
(cadr item)))))
(defun chess-ply-set-keyword (ply keyword &optional value)
+ (assert (listp ply))
+ (assert (symbolp keyword))
(let* ((changes (chess-ply-changes ply))
(item (memq keyword changes)))
(if item
@@ -83,26 +94,37 @@
(setcar (cdr item) value))
(nconc changes (if value
(list keyword value)
- (list keyword))))))
+ (list keyword))))
+ value))
(defsubst chess-ply-source (ply)
+ (assert (listp ply))
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(car changes))))
(defsubst chess-ply-target (ply)
+ (assert (listp ply))
(let ((changes (chess-ply-changes ply)))
(and (listp changes) (not (symbolp (car changes)))
(cadr changes))))
(defsubst chess-ply-next-pos (ply)
- (apply 'chess-pos-move (chess-pos-copy (chess-ply-pos ply))
- (chess-ply-changes ply)))
+ (assert (listp ply))
+ (or (chess-ply-keyword ply :next-pos)
+ (let ((position (apply 'chess-pos-move
+ (chess-pos-copy (chess-ply-pos ply))
+ (chess-ply-changes ply))))
+ (chess-pos-set-preceding-ply position ply)
+ (chess-ply-set-keyword ply :next-pos position))))
(defsubst chess-ply-to-string (ply &optional long)
+ (assert (listp ply))
(chess-ply-to-algebraic ply long))
(defsubst chess-ply-from-string (position move)
+ (assert (vectorp position))
+ (assert (stringp move))
(chess-algebraic-to-ply position move))
(defconst chess-piece-name-table
@@ -111,33 +133,25 @@
("knight" . ?n)
("bishop" . ?b)))
-(defun chess-ply-create-castle (position &optional long king-index)
+(defun chess-ply-castling-changes (position &optional long king-index)
"Create castling changes; this function supports Fischer Random castling."
+ (assert (vectorp position))
(let* ((color (chess-pos-side-to-move position))
(king (or king-index (chess-pos-king-index position color)))
- (king-target (chess-rf-to-index (if color 7 0)
- (if long 2 6)))
- (king-file (chess-index-file king))
- (file (if long 0 7))
- rook)
- (while (funcall (if long '< '>) file king-file)
- (let ((index (chess-rf-to-index (if color 7 0) file)))
- (if (chess-pos-piece-p position index (if color ?R ?r))
- (setq rook index file king-file)
- (setq file (funcall (if long '1+ '1-) file)))))
- (setq file (chess-index-file king)
- file (funcall (if long '1- '1+) file))
- (while (and rook (funcall (if long '>= '<=) file
- (chess-index-file king-target)))
- (let ((index (chess-rf-to-index (if color 7 0) file)))
- (if (chess-pos-piece-p position index ? )
- (setq file (funcall (if long '1- '1+) file))
- (setq rook nil))))
- (if (and rook (chess-pos-legal-moves position color king-target
- (list king)))
- (list king king-target rook
- (chess-rf-to-index (if color 7 0) (if long 3 5))
- (if long :long-castle :castle)))))
+ (rook (chess-pos-can-castle position (if color
+ (if long ?Q ?K)
+ (if long ?q ?k))))
+ (bias (if long -1 1)) pos)
+ (when rook
+ (setq pos (chess-incr-index king 0 bias))
+ (while (and pos (not (equal pos rook))
+ (chess-pos-piece-p position pos ? )
+ (chess-pos-legal-candidates position color pos (list king)))
+ (setq pos (chess-incr-index pos 0 bias)))
+ (if (equal pos rook)
+ (list king (chess-rf-to-index (if color 7 0) (if long 2 6))
+ rook (chess-rf-to-index (if color 7 0) (if long 3 5))
+ (if long :long-castle :castle))))))
(chess-message-catalog 'english
'((pawn-promote-query . "Promote pawn to queen/rook/knight/bishop? ")))
@@ -145,6 +159,7 @@
(defvar chess-ply-checking-mate nil)
(defsubst chess-ply-create* (position)
+ (assert (vectorp position))
(list position))
(defun chess-ply-create (position &optional valid-p &rest changes)
@@ -155,6 +170,7 @@ also extend castling, and will prompt for a promotion piece.
Note: Do not pass in the rook move if CHANGES represents a castling
maneuver."
+ (assert (vectorp position))
(let* ((ply (cons position changes))
(color (chess-pos-side-to-move position))
piece)
@@ -183,8 +199,8 @@ maneuver."
(chess-pos-can-castle position
(if color ?Q ?q))))
(setq new-changes
- (chess-ply-create-castle position long
- (car changes))))
+ (chess-ply-castling-changes position long
+ (car changes))))
(setcdr ply new-changes))))
(when (= piece (if color ?P ?p))
@@ -240,8 +256,8 @@ maneuver."
(defsubst chess-ply-final-p (ply)
"Return non-nil if this is the last ply of a game/variation."
- (chess-ply-any-keyword ply :draw :perpetual :repetition :stalemate
- :resign :checkmate))
+ (chess-ply-any-keyword ply :drawn :perpetual :repetition :stalemate
+ :flag-fell :resign :checkmate :aborted))
(eval-when-compile
(defvar position)
@@ -257,8 +273,8 @@ maneuver."
(let ((target (or pos (chess-incr-index* candidate rank-adj file-adj))))
(if (and (or (not specific-target)
(= target specific-target))
- (chess-pos-legal-moves position color target
- (list candidate)))
+ (chess-pos-legal-candidates position color target
+ (list candidate)))
(if chess-ply-throw-if-any
(throw 'any-found t)
(let ((ply (chess-ply-create position t candidate target)))
@@ -281,6 +297,7 @@ criteria.
NOTE: All of the returned plies will reference the same copy of the
position object passed in."
+ (assert (vectorp position))
(cond
((null keywords)
(let ((plies (list t)))
@@ -367,10 +384,7 @@ position object passed in."
'((-1 -1) (-1 0) (-1 1)
(0 -1) (0 1)
(1 -1) (1 0) (1 1)))))
- ;; up the current file
(setq pos (apply 'chess-incr-index candidate dir))
- ;; jww (2002-04-11): In Fischer Random castling, the rook can
- ;; move in wacky ways
(while pos
(if (chess-pos-piece-p position pos ? )
(progn
@@ -378,7 +392,24 @@ position object passed in."
(setq pos (apply 'chess-incr-index pos dir)))
(if (chess-pos-piece-p position pos (not color))
(chess-ply--add nil nil pos))
- (setq pos nil)))))
+ (setq pos nil)))
+
+ (when (= test-piece ?R)
+ (if (eq candidate
+ (chess-pos-can-castle position (if color ?K ?k)))
+ (let ((changes (chess-ply-castling-changes position)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies)))))
+
+ (if (eq candidate
+ (chess-pos-can-castle position (if color ?Q ?q)))
+ (let ((changes (chess-ply-castling-changes position t)))
+ (if changes
+ (if chess-ply-throw-if-any
+ (throw 'any-found t)
+ (push (cons position changes) plies))))))))
;; the king is a trivial case of the queen, except when castling
((= test-piece ?K)
@@ -391,14 +422,16 @@ position object passed in."
(chess-ply--add nil nil pos)))
(if (chess-pos-can-castle position (if color ?K ?k))
- (let ((changes (chess-ply-create-castle position nil candidate)))
+ (let ((changes (chess-ply-castling-changes position nil
+ candidate)))
(if changes
(if chess-ply-throw-if-any
(throw 'any-found t)
(push (cons position changes) plies)))))
(if (chess-pos-can-castle position (if color ?Q ?q))
- (let ((changes (chess-ply-create-castle position t candidate)))
+ (let ((changes (chess-ply-castling-changes position t
+ candidate)))
(if changes
(if chess-ply-throw-if-any
(throw 'any-found t)
diff --git a/chess-pos.el b/chess-pos.el
index 46a4c1b..71b83a2 100644
--- a/chess-pos.el
+++ b/chess-pos.el
@@ -97,7 +97,7 @@ This variable automatically becomes buffer-local when changed.")
;; index of pawn that can be captured en passant
nil
;; can white and black castle on king or queen side?
- t t t t
+ 63 56 7 0
;; is the side to move in: `check', `checkmate', `stalemate'
nil
;; which color is it to move next?
@@ -107,13 +107,154 @@ This variable automatically becomes buffer-local when changed.")
nil
;; where are the kings?
60 4
- ;; an alist of epd evaluation codes and arguments
+ ;; a pointer to the ply which led to this position
nil]
"Starting position of a chess position.")
+(chess-message-catalog 'english
+ '((chess-nag-1 . "good move [traditional \"!\"]")
+ (chess-nag-2 . "poor move [traditional \"?\"]")
+ (chess-nag-3 . "very good move (traditional \"!!\"")
+ (chess-nag-4 . "very poor move (traditional \"??\")")
+ (chess-nag-5 . "speculative move (traditional \"!?\")")
+ (chess-nag-6 . "questionable move (traditional \"?!\")")
+ (chess-nag-7 . "forced move (all others lose quickly)")
+ (chess-nag-8 . "singular move (no reasonable alternatives)")
+ (chess-nag-9 . "worst move")
+ (chess-nag-10 . "drawish position")
+ (chess-nag-11 . "equal chances, quiet position")
+ (chess-nag-12 . "equal chances, active position")
+ (chess-nag-13 . "unclear position")
+ (chess-nag-14 . "White has a slight advantage")
+ (chess-nag-15 . "Black has a slight advantage")
+ (chess-nag-16 . "White has a moderate advantage")
+ (chess-nag-17 . "Black has a moderate advantage")
+ (chess-nag-18 . "White has a decisive advantage")
+ (chess-nag-19 . "Black has a decisive advantage")
+ (chess-nag-20 . "White has a crushing advantage (Black should resign)")
+ (chess-nag-21 . "Black has a crushing advantage (White should resign)")
+ (chess-nag-22 . "White is in zugzwang")
+ (chess-nag-23 . "Black is in zugzwang")
+ (chess-nag-24 . "White has a slight space advantage")
+ (chess-nag-25 . "Black has a slight space advantage")
+ (chess-nag-26 . "White has a moderate space advantage")
+ (chess-nag-27 . "Black has a moderate space advantage")
+ (chess-nag-28 . "White has a decisive space advantage")
+ (chess-nag-29 . "Black has a decisive space advantage")
+ (chess-nag-30 . "White has a slight time (development) advantage")
+ (chess-nag-31 . "Black has a slight time (development) advantage")
+ (chess-nag-32 . "White has a moderate time (development) advantage")
+ (chess-nag-33 . "Black has a moderate time (development) advantage")
+ (chess-nag-34 . "White has a decisive time (development) advantage")
+ (chess-nag-35 . "Black has a decisive time (development) advantage")
+ (chess-nag-36 . "White has the initiative")
+ (chess-nag-37 . "Black has the initiative")
+ (chess-nag-38 . "White has a lasting initiative")
+ (chess-nag-39 . "Black has a lasting initiative")
+ (chess-nag-40 . "White has the attack")
+ (chess-nag-41 . "Black has the attack")
+ (chess-nag-42 . "White has insufficient compensation for material deficit")
+ (chess-nag-43 . "Black has insufficient compensation for material deficit")
+ (chess-nag-44 . "White has sufficient compensation for material deficit")
+ (chess-nag-45 . "Black has sufficient compensation for material deficit")
+ (chess-nag-46 . "White has more than adequate compensation for material deficit")
+ (chess-nag-47 . "Black has more than adequate compensation for material deficit")
+ (chess-nag-48 . "White has a slight center control advantage")
+ (chess-nag-49 . "Black has a slight center control advantage")
+ (chess-nag-50 . "White has a moderate center control advantage")
+ (chess-nag-51 . "Black has a moderate center control advantage")
+ (chess-nag-52 . "White has a decisive center control advantage")
+ (chess-nag-53 . "Black has a decisive center control advantage")
+ (chess-nag-54 . "White has a slight kingside control advantage")
+ (chess-nag-55 . "Black has a slight kingside control advantage")
+ (chess-nag-56 . "White has a moderate kingside control advantage")
+ (chess-nag-57 . "Black has a moderate kingside control advantage")
+ (chess-nag-58 . "White has a decisive kingside control advantage")
+ (chess-nag-59 . "Black has a decisive kingside control advantage")
+ (chess-nag-60 . "White has a slight queenside control advantage")
+ (chess-nag-61 . "Black has a slight queenside control advantage")
+ (chess-nag-62 . "White has a moderate queenside control advantage")
+ (chess-nag-63 . "Black has a moderate queenside control advantage")
+ (chess-nag-64 . "White has a decisive queenside control advantage")
+ (chess-nag-65 . "Black has a decisive queenside control advantage")
+ (chess-nag-66 . "White has a vulnerable first rank")
+ (chess-nag-67 . "Black has a vulnerable first rank")
+ (chess-nag-68 . "White has a well protected first rank")
+ (chess-nag-69 . "Black has a well protected first rank")
+ (chess-nag-70 . "White has a poorly protected king")
+ (chess-nag-71 . "Black has a poorly protected king")
+ (chess-nag-72 . "White has a well protected king")
+ (chess-nag-73 . "Black has a well protected king")
+ (chess-nag-74 . "White has a poorly placed king")
+ (chess-nag-75 . "Black has a poorly placed king")
+ (chess-nag-76 . "White has a well placed king")
+ (chess-nag-77 . "Black has a well placed king")
+ (chess-nag-78 . "White has a very weak pawn structure")
+ (chess-nag-79 . "Black has a very weak pawn structure")
+ (chess-nag-80 . "White has a moderately weak pawn structure")
+ (chess-nag-81 . "Black has a moderately weak pawn structure")
+ (chess-nag-82 . "White has a moderately strong pawn structure")
+ (chess-nag-83 . "Black has a moderately strong pawn structure")
+ (chess-nag-84 . "White has a very strong pawn structure")
+ (chess-nag-85 . "Black has a very strong pawn structure")
+ (chess-nag-86 . "White has poor knight placement")
+ (chess-nag-87 . "Black has poor knight placement")
+ (chess-nag-88 . "White has good knight placement")
+ (chess-nag-89 . "Black has good knight placement")
+ (chess-nag-90 . "White has poor bishop placement")
+ (chess-nag-91 . "Black has poor bishop placement")
+ (chess-nag-92 . "White has good bishop placement")
+ (chess-nag-93 . "Black has good bishop placement")
+ (chess-nag-84 . "White has poor rook placement")
+ (chess-nag-85 . "Black has poor rook placement")
+ (chess-nag-86 . "White has good rook placement")
+ (chess-nag-87 . "Black has good rook placement")
+ (chess-nag-98 . "White has poor queen placement")
+ (chess-nag-99 . "Black has poor queen placement")
+ (chess-nag-100 . "White has good queen placement")
+ (chess-nag-101 . "Black has good queen placement")
+ (chess-nag-102 . "White has poor piece coordination")
+ (chess-nag-103 . "Black has poor piece coordination")
+ (chess-nag-104 . "White has good piece coordination")
+ (chess-nag-105 . "Black has good piece coordination")
+ (chess-nag-106 . "White has played the opening very poorly")
+ (chess-nag-107 . "Black has played the opening very poorly")
+ (chess-nag-108 . "White has played the opening poorly")
+ (chess-nag-109 . "Black has played the opening poorly")
+ (chess-nag-110 . "White has played the opening well")
+ (chess-nag-111 . "Black has played the opening well")
+ (chess-nag-112 . "White has played the opening very well")
+ (chess-nag-113 . "Black has played the opening very well")
+ (chess-nag-114 . "White has played the middlegame very poorly")
+ (chess-nag-115 . "Black has played the middlegame very poorly")
+ (chess-nag-116 . "White has played the middlegame poorly")
+ (chess-nag-117 . "Black has played the middlegame poorly")
+ (chess-nag-118 . "White has played the middlegame well")
+ (chess-nag-119 . "Black has played the middlegame well")
+ (chess-nag-120 . "White has played the middlegame very well")
+ (chess-nag-121 . "Black has played the middlegame very well")
+ (chess-nag-122 . "White has played the ending very poorly")
+ (chess-nag-123 . "Black has played the ending very poorly")
+ (chess-nag-124 . "White has played the ending poorly")
+ (chess-nag-125 . "Black has played the ending poorly")
+ (chess-nag-126 . "White has played the ending well")
+ (chess-nag-127 . "Black has played the ending well")
+ (chess-nag-128 . "White has played the ending very well")
+ (chess-nag-129 . "Black has played the ending very well")
+ (chess-nag-130 . "White has slight counterplay")
+ (chess-nag-131 . "Black has slight counterplay")
+ (chess-nag-132 . "White has moderate counterplay")
+ (chess-nag-133 . "Black has moderate counterplay")
+ (chess-nag-134 . "White has decisive counterplay")
+ (chess-nag-135 . "Black has decisive counterplay")
+ (chess-nag-136 . "White has moderate time control pressure")
+ (chess-nag-137 . "Black has moderate time control pressure")
+ (chess-nag-138 . "White has severe time control pressure")
+ (chess-nag-139 . "Black has severe time control pressure")))
+
(defsubst chess-pos-piece (position index)
"Return the piece on POSITION at INDEX."
- (assert position)
+ (assert (vectorp position))
(assert (and (>= index 0) (< index 64)))
(aref position index))
@@ -121,16 +262,16 @@ This variable automatically becomes buffer-local when changed.")
"Return the index on POSITION of the king.
If COLOR is non-nil, return the position of the white king, otherwise
return the position of the black king."
- (assert position)
+ (assert (vectorp position))
(assert (memq color '(nil t)))
(or (aref position (if color 72 73))
(aset position (if color 72 73)
(chess-pos-search position (if color ?K ?k)))))
-(defsubst chess-pos-set-king-pos (position color index)
+(defsubst chess-pos-set-king-index (position color index)
"Set the known index of the king on POSITION for COLOR, to INDEX.
It is never necessary to call this function."
- (assert position)
+ (assert (vectorp position))
(assert (memq color '(nil t)))
(assert (and (>= index 0) (< index 64)))
(aset position (if color 72 73) index))
@@ -139,24 +280,38 @@ It is never necessary to call this function."
"Set the piece on POSITION at INDEX to PIECE.
PIECE must be one of K Q N B R or P. Use lowercase to set black
pieces."
- (assert position)
+ (assert (vectorp position))
(assert (and (>= index 0) (< index 64)))
(assert (memq piece '(? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
(aset position index piece)
(if (= piece ?K)
- (chess-pos-set-king-pos position t index)
+ (chess-pos-set-king-index position t index)
(if (= piece ?k)
- (chess-pos-set-king-pos position nil index))))
+ (chess-pos-set-king-index position nil index))))
-(defsubst chess-pos-can-castle (position side)
+(defun chess-pos-can-castle (position side)
"Return whether the king on POSITION can castle on SIDE.
SIDE must be either ?K for the kingside, or ?Q for the queenside (use
lowercase to query if black can castle)."
- (assert position)
+ (assert (vectorp position))
(assert (memq side '(?K ?Q ?k ?q)))
- (aref position (+ 65 (if (< side ?a)
- (if (= side ?K) 0 1)
- (if (= side ?k) 2 3)))))
+ (let* ((index (+ 65 (if (< side ?a)
+ (if (= side ?K) 0 1)
+ (if (= side ?k) 2 3))))
+ (value (aref position index)))
+ (if (or (eq value nil) (integerp value))
+ value
+ (let* ((color (< side ?a))
+ (long (= ?Q (upcase side)))
+ (file (if long 0 7))
+ (king-file (chess-pos-king-index position color))
+ rook)
+ (while (funcall (if long '< '>) file king-file)
+ (let ((index (chess-rf-to-index (if color 7 0) file)))
+ (if (chess-pos-piece-p position index (if color ?R ?r))
+ (setq rook index file king-file)
+ (setq file (funcall (if long '1+ '1-) file)))))
+ (aset position index rook)))))
(defsubst chess-pos-set-can-castle (position side value)
"Set whether the king can castle on the given POSITION on SIDE.
@@ -167,7 +322,7 @@ It is only necessary to call this function if setting up a position
manually. Note that all newly created positions have full castling
priveleges set, unless the position is created blank, in which case
castling priveleges are unset. See `chess-pos-copy'."
- (assert position)
+ (assert (vectorp position))
(assert (memq side '(?K ?Q ?k ?q)))
(assert (memq value '(nil t)))
(aset position (+ 65 (if (< side ?a)
@@ -177,12 +332,12 @@ castling priveleges are unset. See `chess-pos-copy'."
(defsubst chess-pos-en-passant (position)
"Return the index of any pawn on POSITION that can be captured en passant.
Returns nil if en passant is unavailable."
- (assert position)
+ (assert (vectorp position))
(aref position 64))
(defsubst chess-pos-set-en-passant (position index)
"Set the index of any pawn on POSITION that can be captured en passant."
- (assert position)
+ (assert (vectorp position))
(assert (or (eq index nil)
(and (>= index 0) (< index 64))))
(aset position 64 index))
@@ -191,96 +346,89 @@ Returns nil if en passant is unavailable."
"Return whether the side to move in the POSITION is in a special state.
nil is returned if not, otherwise one of the symbols: `check',
`checkmate', `stalemate'."
- (assert position)
+ (assert (vectorp position))
(aref position 69))
(defsubst chess-pos-set-status (position value)
"Set whether the side to move in POSITION is in a special state.
VALUE should either be nil, to indicate that the POSITION is normal,
or one of the symbols: `check', `checkmate', `stalemate'."
- (assert position)
+ (assert (vectorp position))
(assert (or (eq value nil) (symbolp value)))
(aset position 69 value))
(defsubst chess-pos-side-to-move (position)
"Return the color whose move it is in POSITION."
- (assert position)
+ (assert (vectorp position))
(aref position 70))
(defsubst chess-pos-set-side-to-move (position color)
"Set the color whose move it is in POSITION."
- (assert position)
+ (assert (vectorp position))
(assert (memq color '(nil t)))
(aset position 70 color))
(defsubst chess-pos-annotations (position)
"Return the list of annotations for this position."
- (assert position)
+ (assert (vectorp position))
(aref position 71))
(defsubst chess-pos-set-annotations (position annotations)
"Return the list of annotations for this position."
- (assert position)
+ (assert (vectorp position))
(assert (listp annotations))
(aset position 71 annotations))
(defun chess-pos-add-annotation (position annotation)
"Add an annotation for this position."
- (assert position)
+ (assert (vectorp position))
(assert (or (stringp annotation) (listp annotation)))
(let ((ann (chess-pos-annotations position)))
(if ann
(nconc ann (list annotation))
(aset position 71 (list annotation)))))
-(defsubst chess-pos-epd-alist (position)
- "Return the alist of EPD evaluations for this position."
- (assert position)
- (aref position 74))
-
-(defsubst chess-pos-set-epd-alist (position alist)
- "Return the alist of EPD evaluations for this position."
- (assert position)
- (assert (listp alist))
- (aset position 74 alist))
-
(defsubst chess-pos-epd (position opcode)
"Return the value of the given EPD OPCODE, or nil if not set."
- (assert position)
+ (assert (vectorp position))
(assert opcode)
- (let ((epd (chess-pos-epd-alist position)))
- (if epd
- (cdr (assq opcode epd)))))
+ (cdr (assq opcode (chess-pos-annotations position))))
(defun chess-pos-set-epd (position opcode &optional value)
"Set the given EPD OPCODE to VALUE, or t if VALUE is not specified."
- (assert position)
+ (assert (vectorp position))
(assert opcode)
- (let* ((epd (chess-pos-epd-alist position))
- (entry (assq opcode epd)))
+ (let ((entry (assq opcode (chess-pos-annotations position))))
(if entry
(setcdr entry (or value t))
- (push (cons opcode (or value t)) epd))))
+ (chess-pos-add-annotation position (cons opcode (or value t))))))
(defun chess-pos-del-epd (position opcode)
"Delete the given EPD OPCODE."
- (assert position)
+ (assert (vectorp position))
(assert opcode)
- (chess-pos-set-epd-alist position
- (assq-delete-all opcode
- (chess-pos-epd-alist position))))
+ (chess-pos-set-annotations
+ position (assq-delete-all opcode (chess-pos-annotations position))))
+
+(defun chess-pos-preceding-ply (position)
+ "Delete the given EPD OPCODE."
+ (assert (vectorp position))
+ (aref position 74))
+
+(defun chess-pos-set-preceding-ply (position ply)
+ "Delete the given EPD OPCODE."
+ (assert (vectorp position))
+ (assert (listp ply))
+ (aset position 74 ply))
(defsubst chess-pos-copy (position)
"Copy the given chess POSITION.
If there are annotations or EPD opcodes set, these lists are copied as
well, so that the two positions do not share the same lists."
- (assert position)
+ (assert (vectorp position))
(let ((copy (vconcat position)) i)
(setq i (chess-pos-annotations position))
(if i (chess-pos-set-annotations copy (copy-alist i)))
- (setq i (chess-pos-epd-alist position))
- (if (and (not (eq i nil)) (listp i))
- (chess-pos-set-epd-alist copy (copy-alist i)))
copy))
(defsubst chess-pos-create (&optional blank)
@@ -346,7 +494,7 @@ in order to execute faster."
"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."
- (assert position)
+ (assert (vectorp position))
(assert (and (>= index 0) (< index 64)))
(assert (memq piece-or-color
'(t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
@@ -361,7 +509,7 @@ color will do."
"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."
- (assert position)
+ (assert (vectorp position))
(assert (memq piece-or-color
'(t nil ? ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
(let (found)
@@ -374,7 +522,7 @@ color will do."
"Convert the given POSITION into a string.
The returned string can be converted back to a position using
`chess-pos-from-string'."
- (assert position)
+ (assert (vectorp position))
(chess-pos-to-fen position full))
(defsubst chess-pos-from-string (string)
@@ -393,7 +541,7 @@ This string should have been created by `chess-pos-to-string'."
(defun chess-pos-material-value (position color)
"Return the aggregate material value in POSITION for COLOR."
- (assert position)
+ (assert (vectorp position))
(assert (memq color '(nil t)))
(let ((pieces (chess-pos-search position color))
(value 0))
@@ -410,7 +558,7 @@ This string should have been created by `chess-pos-to-string'."
"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."
- (assert position)
+ (assert (vectorp position))
(assert (listp changes))
(assert (> (length changes) 0))
(let ((ch changes))
@@ -510,7 +658,7 @@ 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."
- (assert position)
+ (assert (vectorp position))
(assert (and (>= target 0) (< target 64)))
(assert (memq piece '(t nil ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
(let* ((color (if (char-valid-p piece)
@@ -589,21 +737,33 @@ indices which indicate where a piece may have moved from."
(1 -1) (1 0) (1 1)))))
;; up the current file
(setq pos (apply 'chess-incr-index target dir))
- ;; jww (2002-04-11): In Fischer Random castling, the rook can
- ;; move in wacky ways
(while pos
(if (chess-pos-piece-p position pos piece)
(progn
(chess--add-candidate pos)
(setq pos nil))
(setq pos (and (chess-pos-piece-p position pos ? )
- (apply 'chess-incr-index pos dir)))))))
+ (apply 'chess-incr-index pos dir)))))
+
+ ;; test whether the rook can move to the target by castling
+ (if (= test-piece ?R)
+ (let (rook)
+ (if (and (equal target (chess-rf-to-index (if color 7 0) 5))
+ (setq rook (chess-pos-can-castle position
+ (if color ?K ?k)))
+ (chess-ply-castling-changes position))
+ (chess--add-candidate rook)
+ (if (and (equal target (chess-rf-to-index (if color 7 0) 3))
+ (setq rook (chess-pos-can-castle position
+ (if color ?Q ?q)))
+ (chess-ply-castling-changes position t))
+ (chess--add-candidate rook)))))))
;; the king is a trivial case of the queen, except when castling
((= test-piece ?K)
(let ((dirs '((-1 -1) (-1 0) (-1 1)
- (0 -1) (0 1)
- (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-incr-index target (car dirs)))
@@ -611,33 +771,16 @@ indices which indicate where a piece may have moved from."
(progn
(chess--add-candidate pos)
(setq 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)))
- (and (equal target (chess-rf-to-index rank 2))
- (chess-pos-can-castle position (if color ?Q ?q)))))
- (let* ((king (chess-pos-king-index position color))
- (king-file (chess-index-file king))
- (long (= 2 (chess-index-file target)))
- (file (if long 1 6))
- (legal t))
- ;; jww (2002-04-10): this needs to be a bit more subtle
- ;; for Fischer Random castling
- (while (and legal (funcall (if long '< '>) file king-file))
- (setq pos (chess-rf-to-index rank file))
- (if (or (not (chess-pos-piece-p position pos ? ))
- (chess-search-position position pos (not color)
- check-only))
- (setq legal nil)
- (setq file (funcall (if long '1+ '1-) file))))
- (if legal
- (chess--add-candidate (chess-rf-to-index rank 4)))))))
+ (setq dirs (cdr dirs))))
+
+ ;; test whether the king can move to the target by castling
+ (if (or (and (equal target (chess-rf-to-index (if color 7 0) 6))
+ (chess-pos-can-castle position (if color ?K ?k))
+ (chess-ply-castling-changes position))
+ (and (equal target (chess-rf-to-index (if color 7 0) 2))
+ (chess-pos-can-castle position (if color ?Q ?q))
+ (chess-ply-castling-changes position t)))
+ (chess--add-candidate (chess-pos-king-index position color)))))
;; the knight is a zesty little piece; there may be more than
;; one, but at only one possible square in each direction
@@ -658,12 +801,13 @@ indices which indicate where a piece may have moved from."
;; been eliminated.
(if (and candidates (char-valid-p piece))
(setq candidates
- (chess-pos-legal-moves position color target candidates)))
+ (chess-pos-legal-candidates position color target
+ candidates)))
;; return the final list of candidate moves
candidates))
-(defun chess-pos-legal-moves (position color target candidates)
+(defun chess-pos-legal-candidates (position color target candidates)
"Test if TARGET can legally be reached by any of CANDIDATES.
Return the list of candidates that can reach it.
@@ -674,7 +818,7 @@ Note: All of the pieces specified by CANDIDATES must be of the same
type. Also, it is the callers responsibility to ensure that the piece
can legally reach the square in question. This function merely
assures that the resulting position is valid."
- (assert position)
+ (assert (vectorp position))
(assert (memq color '(nil t)))
(assert (and (>= target 0) (< target 64)))
(assert (listp candidates))
@@ -695,8 +839,10 @@ assures that the resulting position is valid."
(setq king-pos (chess-pos-king-index position color)))
;; can anybody from the opposite side reach him? if so,
;; drop the candidate
- (if (catch 'in-check
- (chess-search-position position king-pos (not color) t))
+ (if (and king-pos
+ (catch 'in-check
+ (chess-search-position position king-pos
+ (not color) t)))
(if last-cand
(setcdr last-cand (cdr cand))
(setq candidates (cdr candidates)))
diff --git a/chess-puzzle.el b/chess-puzzle.el
index 0491275..84ca6f5 100644
--- a/chess-puzzle.el
+++ b/chess-puzzle.el
@@ -6,7 +6,15 @@
(require 'chess-game)
(require 'chess-random)
(require 'chess-database)
-(require 'chess-file)
+
+(defgroup chess-puzzle nil
+ "A mode for playing games from a database of puzzles."
+ :group 'chess)
+
+(defcustom chess-puzzle-auto-next nil
+ "If non-nil, move to the next puzzle once the position is won."
+ :type 'boolean
+ :group 'chess-puzzle)
(defvar chess-puzzle-indices nil)
(defvar chess-puzzle-position nil)
@@ -24,7 +32,7 @@
The spacebar in the display buffer is bound to `chess-puzzle-next',
making it easy to go on to the next puzzle once you've solved one."
(interactive "fRead chess puzzles from: ")
- (let* ((database (chess-database-open 'chess-file file))
+ (let* ((database (chess-database-open file))
(objects (and database (chess-session)))
(engine (car objects))
(display (cadr objects)))
@@ -32,10 +40,10 @@ making it easy to go on to the next puzzle once you've solved one."
(if engine
(chess-engine-set-option engine 'resign nil))
(with-current-buffer display
- ;; make sure the database is closed when the display is shutdown
- (chess-game-add-hook (chess-display-game nil)
- 'chess-database-event-handler database)
(chess-game-set-data (chess-display-game nil) 'database database)
+ (if chess-puzzle-auto-next
+ (chess-game-add-hook (chess-display-game nil)
+ 'chess-puzzle-handler display))
(define-key (current-local-map) [? ] 'chess-puzzle-next)
(let ((count (chess-database-count database)))
(setq chess-puzzle-indices (make-vector count nil))
@@ -65,7 +73,15 @@ making it easy to go on to the next puzzle once you've solved one."
(chess-game-set-data game 'my-color
(chess-pos-side-to-move (chess-game-pos game)))
(dolist (key '(database database-index database-count))
- (chess-game-set-data game key (chess-game-data next-game key)))))))
+ (chess-game-set-data game key (chess-game-data next-game key)))
+ (let ((chess-display-handling-event nil))
+ (chess-game-run-hooks game 'orient))))))
+
+(defun chess-puzzle-handler (game display event &rest args)
+ (if (and (eq event 'move)
+ (chess-game-over-p game))
+ (with-current-buffer display
+ (chess-puzzle-next))))
(provide 'chess-puzzle)
diff --git a/chess-scid.el b/chess-scid.el
index bf16b03..ce526d9 100644
--- a/chess-scid.el
+++ b/chess-scid.el
@@ -22,23 +22,24 @@
(defun chess-scid-handler (event &rest args)
(cond
((eq event 'open)
- (let* ((buffer (generate-new-buffer " *chess-scid*"))
- (proc (start-process "*chess-scid*" buffer
- (executable-find "tcscid"))))
- (if (and proc (eq (process-status proc) 'run))
- (with-current-buffer buffer
- (accept-process-output proc)
- (setq chess-scid-process proc)
- (if (= 1 (string-to-int
- (chess-scid-get-result
- (format "sc_base open %s\n"
- (expand-file-name (car args))))))
- buffer
- (kill-process proc)
- (kill-buffer buffer)
- nil))
- (kill-buffer buffer)
- nil)))
+ (if (file-readable-p (concat (car args) ".sg3"))
+ (let* ((buffer (generate-new-buffer " *chess-scid*"))
+ (proc (start-process "*chess-scid*" buffer
+ (executable-find "tcscid"))))
+ (if (and proc (eq (process-status proc) 'run))
+ (with-current-buffer buffer
+ (accept-process-output proc)
+ (setq chess-scid-process proc)
+ (if (= 1 (string-to-int
+ (chess-scid-get-result
+ (format "sc_base open %s\n"
+ (expand-file-name (car args))))))
+ buffer
+ (kill-process proc)
+ (kill-buffer buffer)
+ nil))
+ (kill-buffer buffer)
+ nil))))
((eq event 'close)
(process-send-string chess-scid-process "sc_base close\nexit\n"))
diff --git a/chess-tutorial.el b/chess-tutorial.el
index a83eed8..565b595 100644
--- a/chess-tutorial.el
+++ b/chess-tutorial.el
@@ -8,24 +8,31 @@
(chess-message-catalog 'english
'((queen-would-take . "The queen would take your knight!")
(congratulations . "Congratulations!")
- (knight-1-done . "Goal: take all the pawns, without letting the queen take your knight")))
+ (knight-1-done . "Goal: take all the pawns, without letting the queen take your knight")
+ (cannot-take-queen . "You cannot take the queen")))
(defun chess-tutorial-knight-1 (game ignore event &rest args)
(if (eq event 'move)
(let ((position (chess-game-pos game)))
(if (null (chess-pos-search position ?p))
(chess-message 'congratulations)
- (when (chess-search-position
- position (car (chess-pos-search position ?N)) ?q)
- (chess-game-run-hooks chess-module-game 'undo 1)
- (chess-display-update nil)
- (chess-error 'queen-would-take))))))
+ (cond
+ ((chess-search-position position
+ (car (chess-pos-search position ?N)) ?q)
+ (let ((chess-display-handling-event nil))
+ (chess-game-undo game 1))
+ (chess-error 'queen-would-take))
+ ((not (chess-pos-search position ?q))
+ (let ((chess-display-handling-event nil))
+ (chess-game-undo game 1))
+ (chess-error 'cannot-take-queen)))))))
(defun chess-tutorial ()
(interactive)
(let* (chess-default-modules
(display (chess-create-display t)))
(with-current-buffer display
+ (chess-module-set-leader nil)
(chess-game-set-start-position
(chess-display-game nil)
(chess-fen-to-pos "8/3p1p/2p3p/4q/2p3p/3p1p/8/N w - -"))
diff --git a/chess-ucb.el b/chess-ucb.el
index 5819f20..c0b37c0 100644
--- a/chess-ucb.el
+++ b/chess-ucb.el
@@ -36,7 +36,7 @@
;; technically the UCB is just an input interface, not a
;; true engine.
(let ((chess-ucb-handling-event t))
- (chess-game-move game move))))))))
+ (chess-game-move (chess-engine-game nil) move))))))))
(defun chess-ucb-handler (game event &rest args)
(unless chess-ucb-handling-event
diff --git a/chess-var.el b/chess-var.el
index 851d06d..859d355 100644
--- a/chess-var.el
+++ b/chess-var.el
@@ -12,31 +12,39 @@
(defsubst chess-var-plies (var)
"Return the tags alist associated with VAR."
+ (assert var)
var)
(defsubst chess-var-pos (var &optional index)
"Return the position related to VAR's INDEX position."
+ (assert var)
(chess-ply-pos (chess-var-ply var index)))
(defsubst chess-var-index (var)
"Return the VAR's current position index."
+ (assert var)
(1- (length (chess-var-plies var))))
(defsubst chess-var-seq (var)
"Return the current VAR sequence."
+ (assert var)
(1+ (/ (chess-var-index var) 2)))
(defsubst chess-var-side-to-move (var)
+ (assert 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."
+ (assert var)
(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."
+ (assert var)
+ (assert (listp ply))
(let ((plies (chess-var-plies var)))
(assert plies)
(nconc plies (list ply))))
@@ -54,6 +62,8 @@ later using the various tag-related methods)."
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."
+ (assert var)
+ (assert (listp ply))
(let ((current-ply (chess-var-ply var))
(changes (chess-ply-changes ply))
(position (chess-ply-pos ply)))