mlang pushed a commit to branch externals/chess
in repository elpa.
commit 8d03eceef113557406163d110f6a2b04b4a1596b
Author: Mario Lang <ml...@delysid.org>
Date: Mon Jul 7 14:33:21 2014 +0200
Misc. fixes.
---
chess-algebraic.el | 12 +++---
chess-display.el | 51 +++++++++++++++-------------
chess-input.el | 93 +++++++++++++++++++++++----------------------------
chess-ply.el | 27 +++++++--------
chess-polyglot.el | 4 +-
chess-pos.el | 32 ++++++++++++++----
chess-uci.el | 11 +++---
7 files changed, 121 insertions(+), 109 deletions(-)
diff --git a/chess-algebraic.el b/chess-algebraic.el
index 42b64f1..3a07310 100644
--- a/chess-algebraic.el
+++ b/chess-algebraic.el
@@ -140,10 +140,10 @@ This regexp matches short, long and figurine notation.")
(chess-error 'clarify-piece)
(while candidates
(if (if (>= source ?a)
- (eq (chess-index-file (car candidates))
- (- source ?a))
+ (= (chess-index-file (car candidates))
+ (chess-file-from-char source))
(= (chess-index-rank (car candidates))
- (- 7 (- source ?1))))
+ (chess-rank-from-char source)))
(setq which (car candidates)
candidates nil)
(setq candidates (cdr candidates))))
@@ -219,8 +219,8 @@ Finally, `:numeric' generates ICCF numeric notation (like
\"2133\"."
(setq rank (1+ rank)))
(when (= (chess-index-file candidate) from-file)
(setq file (1+ file))))
- (cond ((= file 1) (setq differentiator (+ from-file ?a)))
- ((= rank 1) (setq differentiator (+ (- 7 from-rank) ?1)))
+ (cond ((= file 1) (setq differentiator (chess-file-to-char
from-file)))
+ ((= rank 1) (setq differentiator (chess-rank-to-char
from-rank)))
(t (chess-error 'could-not-diff)))
(chess-ply-set-keyword ply :which differentiator))))
(concat
@@ -234,7 +234,7 @@ Finally, `:numeric' generates ICCF numeric notation (like
\"2133\"."
(differentiator (char-to-string differentiator))
((and (not (eq type :lan)) (= (upcase from-piece) ?P)
(/= from-file (chess-index-file to)))
- (char-to-string (+ from-file ?a))))
+ (char-to-string (chess-file-to-char from-file))))
(if (or (/= ? (chess-pos-piece pos to))
(chess-ply-keyword ply :en-passant))
"x" (if (eq type :lan) "-"))
diff --git a/chess-display.el b/chess-display.el
index fa4358c..857e86d 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -395,35 +395,38 @@ also view the same game."
"Return non-nil if the displayed chessboard reflects an active game.
Basically, it means we are playing, not editing or reviewing."
(and (chess-game-data chess-module-game 'active)
- (= chess-display-index
- (chess-game-index chess-module-game))
+ (= chess-display-index (chess-game-index chess-module-game))
(not (chess-game-over-p chess-module-game))
(not chess-display-edit-mode)))
(defun chess-display-move (display ply)
"Move a piece on DISPLAY, by applying the given PLY.
-The position of PLY must match the currently displayed position."
+The position of PLY must match the currently displayed position.
+
+This adds PLY to the game associated with DISPLAY."
(chess-with-current-buffer display
- (if (and (chess-display-active-p)
- ;; `active' means we're playing against an engine
- (chess-game-data chess-module-game 'active)
- (not (eq (chess-game-data chess-module-game 'my-color)
- (chess-game-side-to-move chess-module-game))))
- (chess-error 'not-your-move)
- (if (and (= chess-display-index
- (chess-game-index chess-module-game))
- (chess-game-over-p chess-module-game))
- (chess-error 'game-is-over)))
- (if (= chess-display-index (chess-game-index chess-module-game))
- (let ((chess-display-handling-event t))
- (chess-game-move chess-module-game ply)
- (chess-display-paint-move nil ply)
- (chess-display-set-index* nil (chess-game-index chess-module-game))
- (redisplay) ; FIXME: This is clearly necessary, but
why?
- (chess-game-run-hooks chess-module-game 'post-move))
- ;; jww (2002-03-28): This should beget a variation within the
- ;; game, or alter the game, just as SCID allows
- (chess-error 'cannot-yet-add))))
+ (cond ((and (chess-display-active-p)
+ ;; `active' means we're playing against an engine
+ (chess-game-data chess-module-game 'active)
+ (not (eq (chess-game-data chess-module-game 'my-color)
+ (chess-game-side-to-move chess-module-game))))
+ (chess-error 'not-your-move))
+
+ ((and (= chess-display-index (chess-game-index chess-module-game))
+ (chess-game-over-p chess-module-game))
+ (chess-error 'game-is-over))
+
+ ((= chess-display-index (chess-game-index chess-module-game))
+ (let ((chess-display-handling-event t))
+ (chess-game-move chess-module-game ply)
+ (chess-display-paint-move nil ply)
+ (chess-display-set-index* nil (chess-game-index chess-module-game))
+ (redisplay) ; FIXME: This is clearly necessary,
but why?
+ (chess-game-run-hooks chess-module-game 'post-move)))
+
+ (t ;; jww (2002-03-28): This should beget a variation within the
+ ;; game, or alter the game, just as SCID allows
+ (chess-error 'cannot-yet-add)))))
(defun chess-display-highlight (display &rest args)
"Highlight the square at INDEX on the current position.
@@ -1109,7 +1112,7 @@ to the end or beginning."
chess-display-edit-position))
(defun chess-display-restore-board ()
- "Setup the current board for editing."
+ "Cancel editing."
(interactive)
(chess-display-end-edit-mode)
;; reset the modeline
diff --git a/chess-input.el b/chess-input.el
index 500fd21..e34ee50 100644
--- a/chess-input.el
+++ b/chess-input.el
@@ -118,63 +118,54 @@
?k
last-command-event))
(if (or (memq (upcase char) '(?K ?Q ?N ?B ?R ?P))
- (and (>= char ?a) (<= char ?h)))
+ (and (>= char ?a) (<= char ?h))
+ (and (>= char ?1) (<= char ?8)))
(setq chess-input-moves-pos position
chess-input-moves
(cons
char
(sort
- (if (eq char ?b)
- (append (chess-legal-plies
- position :piece (if color ?P ?p) :file 1)
- (chess-legal-plies
- position :piece (if color ?B ?b)))
- (if (and (>= char ?a)
- (<= char ?h))
- (chess-legal-plies position
- :piece (if color ?P ?p)
- :file (- char ?a))
- (chess-legal-plies position
- :piece (if color
- (upcase char)
- (downcase char)))))
- (function
- (lambda (left right)
- (string-lessp (chess-ply-to-algebraic left)
- (chess-ply-to-algebraic right)))))))
- (if (and (>= char ?1) (<= char ?8))
- (setq chess-input-moves-pos position
- chess-input-moves
- (cons
- char
- (sort
- (chess-legal-plies position :color color :file (- char ?1))
- (function
- (lambda (left right)
- (string-lessp (chess-ply-to-algebraic left)
- (chess-ply-to-algebraic right)))))))))))
- (let ((moves (delq nil (mapcar 'chess-input-test-move
+ (cond ((eq char ?b)
+ (nconc (chess-legal-plies
+ position :piece (if color ?P ?p) :file 1)
+ (chess-legal-plies
+ position :piece (if color ?B ?b))))
+ ((and (>= char ?a) (<= char ?h))
+ (chess-legal-plies
+ position :piece (if color ?P ?p)
+ :file (chess-file-from-char char)))
+ ((and (>= char ?1) (<= char ?8))
+ (chess-legal-plies
+ position :color color :file (- char ?1)))
+ (t (chess-legal-plies
+ position :piece (if color
+ (upcase char)
+ (downcase char)))))
+ (lambda (left right)
+ (string-lessp (chess-ply-to-algebraic left)
+ (chess-ply-to-algebraic right)))))))))
+ (let ((moves (delq nil (mapcar #'chess-input-test-move
(cdr chess-input-moves)))))
- (cond
- ((or (= (length moves) 1)
- ;; if there is an exact match except for case, it must be an
- ;; abiguity between a bishop and a b-pawn move. In this
- ;; case, always take the b-pawn move; to select the bishop
- ;; move, use B to begin the keyboard shortcut
- (and (= (length moves) 2)
- (string= (downcase (chess-ply-to-algebraic (car moves)))
- (downcase (chess-ply-to-algebraic (cadr moves))))
- (setq moves (cdr moves))))
- (funcall chess-input-move-function nil (car moves))
- (when chess-display-highlight-legal
- (chess-display-redraw nil))
- (setq chess-input-move-string nil
- chess-input-moves nil
- chess-input-moves-pos nil))
- ((null moves)
- (chess-input-shortcut-delete))
- (t
- (chess-input-display-moves moves)))))
+ (cond ((or (= (length moves) 1)
+ ;; if there is an exact match except for case, it must be an
+ ;; abiguity between a bishop and a b-pawn move. In this
+ ;; case, always take the b-pawn move; to select the bishop
+ ;; move, use B to begin the keyboard shortcut
+ (and (= (length moves) 2)
+ (string= (downcase (chess-ply-to-algebraic (car moves)))
+ (downcase (chess-ply-to-algebraic (cadr moves))))
+ (setq moves (cdr moves))))
+ (funcall chess-input-move-function nil (car moves))
+ (when chess-display-highlight-legal
+ (chess-display-redraw nil))
+ (setq chess-input-move-string nil
+ chess-input-moves nil
+ chess-input-moves-pos nil))
+
+ ((null moves)
+ (chess-input-shortcut-delete))
+
+ (t (chess-input-display-moves moves)))))
(provide 'chess-input)
diff --git a/chess-ply.el b/chess-ply.el
index 35b30c9..907e8aa 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -299,6 +299,9 @@ maneuver."
(let ((ply (chess-ply-create position t candidate target)))
(when ply (push ply plies)))))))))
+(defconst chess-white-pieces '(?P ?N ?B ?R ?Q ?K))
+(defconst chess-black-pieces '(?p ?n ?b ?r ?q ?k))
+
(defun chess-legal-plies (position &rest keywords)
"Return a list of all legal plies in POSITION.
KEYWORDS allowed are:
@@ -350,20 +353,16 @@ position object passed in."
;; since we're looking for moves of a particular piece, do a
;; more focused search
(dolist (candidate
- (cond
- ((cadr (memq :candidates keywords))
- (cadr (memq :candidates keywords)))
- ((setq pos (cadr (memq :index keywords)))
- (list pos))
- ((setq file (cadr (memq :file keywords)))
- (let (candidates)
- (dotimes (rank 8)
- (setq pos (chess-rf-to-index rank file))
- (if (chess-pos-piece-p position pos (or piece color))
- (push pos candidates)))
- candidates))
- (t
- (chess-pos-search position piece))))
+ (cond ((cadr (memq :candidates keywords)))
+ ((setq pos (cadr (memq :index keywords))) (list pos))
+ ((setq file (cadr (memq :file keywords)))
+ (let (candidates)
+ (dotimes (rank 8)
+ (setq pos (chess-rf-to-index rank file))
+ (if (chess-pos-piece-p position pos (or piece color))
+ (push pos candidates)))
+ candidates))
+ (t (chess-pos-search position piece))))
(cond
;; pawn movement, which is diagonal 1 when taking, but forward
;; 1 or 2 when moving (the most complex piece, actually)
diff --git a/chess-polyglot.el b/chess-polyglot.el
index 96a918c..09fc6a0 100644
--- a/chess-polyglot.el
+++ b/chess-polyglot.el
@@ -490,8 +490,8 @@ Returns a buffer object which contains the binary data."
The resulting list is ordered, most interesting plies come first.
The :polyglot-book-weight ply keyword is used to store the actual move weights.
Use `chess-ply-keyword' on elements of the returned list to retrieve them."
- (cl-assert (bufferp book))
- (cl-assert (vectorp position))
+ (cl-check-type book buffer)
+ (cl-check-type position chess-pos)
(let (plies)
(dolist (move
(with-current-buffer book
diff --git a/chess-pos.el b/chess-pos.el
index 76a4bc9..732893d 100644
--- a/chess-pos.el
+++ b/chess-pos.el
@@ -308,16 +308,34 @@ color will do."
(cl-check-type index (integer 0 63))
(mod index 8))
+(defsubst chess-rank-to-char (rank)
+ (cl-check-type rank (integer 0 7))
+ (+ (- 7 rank) ?1))
+
+(defsubst chess-rank-from-char (character)
+ (cl-check-type character character)
+ (- 7 (- character ?1)))
+
+(defsubst chess-file-to-char (file)
+ (cl-check-type file (integer 0 7))
+ (+ file ?a))
+
+(defsubst chess-file-from-char (character)
+ (cl-check-type character character)
+ (- character ?a))
+
(defsubst chess-coord-to-index (coord)
"Convert a COORD string (such as \"e4\" into an index value."
(cl-check-type coord string)
(cl-assert (= (length coord) 2))
- (chess-rf-to-index (- 7 (- (aref coord 1) ?1)) (- (aref coord 0) ?a)))
+ (chess-rf-to-index (chess-rank-from-char (aref coord 1))
+ (chess-file-from-char (aref coord 0))))
(defsubst chess-index-to-coord (index)
"Convert the chess position INDEX into a coord string."
(cl-check-type index (integer 0 63))
- (string (+ (chess-index-file index) ?a) (+ (- 7 (chess-index-rank index))
?1)))
+ (string (chess-file-to-char (chess-index-file index))
+ (chess-rank-to-char (chess-index-rank index))))
(defsubst chess-incr-index (index rank-move file-move)
"Create a new INDEX from an old one, by adding RANK-MOVE and FILE-MOVE."
@@ -693,8 +711,8 @@ The current side-to-move is always white."
(defun chess-pos-material-value (position color)
"Return the aggregate material value in POSITION for COLOR."
- (cl-assert (vectorp position))
- (cl-assert (memq color '(nil t)))
+ (cl-check-type position chess-pos)
+ (cl-check-type color (member nil t))
(let ((pieces (chess-pos-search position color))
(value 0))
(dolist (index pieces)
@@ -889,9 +907,9 @@ indices which indicate where a piece may have moved from.
If CHECK-ONLY is non-nil and PIECE is either t or nil, only consider
pieces which can give check (not the opponents king).
If NO-CASTLING is non-nil, do not consider castling moves."
- (cl-assert (vectorp position))
- (cl-assert (and (>= target 0) (< target 64)))
- (cl-assert (memq piece '(t nil ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p)))
+ (cl-check-type position chess-pos)
+ (cl-check-type target (integer 0 63))
+ (cl-check-type piece (member t nil ?K ?Q ?N ?B ?R ?P ?k ?q ?n ?b ?r ?p))
(let* ((color (if (characterp piece)
(< piece ?a)
piece))
diff --git a/chess-uci.el b/chess-uci.el
index 99796a5..f54e9c0 100644
--- a/chess-uci.el
+++ b/chess-uci.el
@@ -38,8 +38,8 @@
(defun chess-uci-long-algebraic-to-ply (position move)
"Convert the long algebraic notation MOVE for POSITION to a ply."
- (cl-assert (vectorp position))
- (cl-assert (stringp move))
+ (cl-check-type position chess-pos)
+ (cl-check-type move string)
(let ((case-fold-search nil))
(when (string-match chess-uci-long-algebraic-regexp move)
(let ((color (chess-pos-side-to-move position))
@@ -54,9 +54,10 @@
(chess-ply-castling-changes
position
(< (- (chess-index-file to) (chess-index-file from)) 0))
- (nconc (list from to)
- (when promotion
- (list :promote (upcase (aref promotion 0)))))))))))
+ (cons from (cons to
+ (when promotion
+ (list :promote
+ (upcase (aref promotion 0))))))))))))
(defsubst chess-uci-convert-long-algebraic (move)
"Convert long algebraic MOVE to a ply in reference to the engine position.
