mlang pushed a commit to branch externals/chess
in repository elpa.
commit d3c4eb4058c275b205fb63139a703cdf1c543c13
Author: Mario Lang <ml...@delysid.org>
Date: Sun May 25 16:53:20 2014 +0200
Remove chess-ply-allow-interactive-query.
Now that chess-input can correctly handle promotions, this hack can and
should be removed. chess-legal-plies will now always generate all possible
promotions, and chess-input can select among them.
---
chess-ai.el | 95 ++++++++++++++++++++++++++---------------------------
chess-display.el | 3 +-
chess-german.el | 1 -
chess-ics.el | 2 -
chess-perft.el | 12 ++----
chess-ply.el | 44 ++++++++----------------
6 files changed, 67 insertions(+), 90 deletions(-)
diff --git a/chess-ai.el b/chess-ai.el
index bc6f400..b0a0bcf 100644
--- a/chess-ai.el
+++ b/chess-ai.el
@@ -250,54 +250,53 @@ for all leave nodes of the resulting tree.
A `cons' cell is returned where `cdr' is the supposedly best move from POSITION
and `car' is the score of that move. If there is no legal move from POSITION
\(or DEPTH is 0), `cdr' will be nil."
- (let ((chess-ply-allow-interactive-query nil))
- (if (zerop depth)
- (cons (funcall eval-fn position) nil)
- (let ((plies (let ((chess-ai-mobility nil)
- (chess-ai-quiescence nil))
- (sort
- (mapcar
- (lambda (ply)
- (chess-ply-set-keyword
- ply :score
- (- (chess-ai-search (chess-ply-next-pos ply)
- 1
- (1+ most-negative-fixnum)
- most-positive-fixnum
- #'chess-ai-eval-static)))
- ply)
- (chess-legal-plies
- position :color (chess-pos-side-to-move position)))
- (lambda (lhs rhs)
- (> (chess-ply-keyword lhs :score)
- (chess-ply-keyword rhs :score)))))))
- (if (null plies)
- (cons (funcall eval-fn position) nil)
- (let* ((best-ply (car plies))
- (progress (make-progress-reporter
- (format "Thinking... (%s) "
- (chess-ply-to-algebraic best-ply))
- 0 (length plies))))
- (cl-loop for i from 1
- for ply in plies
- do (let ((value (- (chess-ai-search
- (chess-ply-next-pos ply)
- (1- depth) (- upper-bound) (-
lower-bound)
- eval-fn))))
- (progress-reporter-update progress i)
- (accept-process-output nil 0.05)
- (when (> value lower-bound)
- (setq lower-bound value
- best-ply ply)
- (progress-reporter-force-update
- progress
- i
- (format "Thinking... (%s {cp=%d}) "
- (chess-ply-to-algebraic best-ply)
- lower-bound))))
- until (>= lower-bound upper-bound))
- (progress-reporter-done progress)
- (cons lower-bound best-ply)))))))
+ (if (zerop depth)
+ (cons (funcall eval-fn position) nil)
+ (let ((plies (let ((chess-ai-mobility nil)
+ (chess-ai-quiescence nil))
+ (sort
+ (mapcar
+ (lambda (ply)
+ (chess-ply-set-keyword
+ ply :score
+ (- (chess-ai-search (chess-ply-next-pos ply)
+ 1
+ (1+ most-negative-fixnum)
+ most-positive-fixnum
+ #'chess-ai-eval-static)))
+ ply)
+ (chess-legal-plies
+ position :color (chess-pos-side-to-move position)))
+ (lambda (lhs rhs)
+ (> (chess-ply-keyword lhs :score)
+ (chess-ply-keyword rhs :score)))))))
+ (if (null plies)
+ (cons (funcall eval-fn position) nil)
+ (let* ((best-ply (car plies))
+ (progress (make-progress-reporter
+ (format "Thinking... (%s) "
+ (chess-ply-to-algebraic best-ply))
+ 0 (length plies))))
+ (cl-loop for i from 1
+ for ply in plies
+ do (let ((value (- (chess-ai-search
+ (chess-ply-next-pos ply)
+ (1- depth) (- upper-bound) (-
lower-bound)
+ eval-fn))))
+ (progress-reporter-update progress i)
+ (accept-process-output nil 0.05)
+ (when (> value lower-bound)
+ (setq lower-bound value
+ best-ply ply)
+ (progress-reporter-force-update
+ progress
+ i
+ (format "Thinking... (%s {cp=%d}) "
+ (chess-ply-to-algebraic best-ply)
+ lower-bound))))
+ until (>= lower-bound upper-bound))
+ (progress-reporter-done progress)
+ (cons lower-bound best-ply))))))
(defun chess-ai-best-move (position &optional depth eval-fn)
"Find the best move for POSITION.
diff --git a/chess-display.el b/chess-display.el
index cd1c802..acc103c 100644
--- a/chess-display.el
+++ b/chess-display.el
@@ -850,8 +850,7 @@ The key bindings available in this mode are:
(if (chess-pos-side-to-move (chess-display-position nil))
"White" "Black")
(1+ (/ (or chess-display-index 0) 2))))))
- (let ((ply (let ((chess-ply-allow-interactive-query t))
- (chess-algebraic-to-ply (chess-display-position nil) move))))
+ (let ((ply (chess-algebraic-to-ply (chess-display-position nil) move)))
(unless ply
(chess-error 'illegal-notation move))
(chess-display-move nil ply)))
diff --git a/chess-german.el b/chess-german.el
index 6630fd0..881ddaa 100644
--- a/chess-german.el
+++ b/chess-german.el
@@ -114,7 +114,6 @@
(opp-undo-dec . "Your request to undo %d moves was decline")
(opp-undo-ret . "Your opponent has retracted their request to
undo %d moves")
(opponent-says . "Dein Gegner sagt: %s")
- (pawn-promote-query . "Promote pawn to queen/rook/knight/bishop? ")
(pgn-parse-error . "Error parsing PGN syntax")
(pgn-read-error . "Error reading move: %s")
(piece-images-loaded . "Loading chess piece images...done")
diff --git a/chess-ics.el b/chess-ics.el
index e95a1ea..f260e06 100644
--- a/chess-ics.el
+++ b/chess-ics.el
@@ -466,8 +466,6 @@ See `chess-ics-game'.")
(chess-session 'chess-ics))
chess-ics-sessions)
(cl-assert (caar chess-ics-sessions))
- (with-current-buffer (caar chess-ics-sessions)
- (setq chess-ply-allow-interactive-query t))
(let ((game (chess-engine-game (caar chess-ics-sessions))))
(chess-game-set-data game 'ics-game-number game-number)
(chess-game-set-data game 'ics-buffer (current-buffer))
diff --git a/chess-perft.el b/chess-perft.el
index 8e4535a..662d854 100644
--- a/chess-perft.el
+++ b/chess-perft.el
@@ -185,32 +185,28 @@ If not called interactively the result is a list of the
form
(should (equal (chess-perft position 5) '(674624 52051 1165 0 0 52950
0)))))
(ert-deftest chess-perft-pos4-depth1 ()
- (let ((chess-ply-allow-interactive-query nil)
- (position
+ (let ((position
(chess-fen-to-pos
"r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
(should (equal (chess-perft position 1) '(6 0 0 0 0 0 0)))))
(ert-deftest chess-perft-pos4-depth2 ()
:tags '(:capture :castle :promotion :check)
- (let ((chess-ply-allow-interactive-query nil)
- (position
+ (let ((position
(chess-fen-to-pos
"r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
(should (equal (chess-perft position 2) '(264 87 0 6 48 10 0)))))
(ert-deftest chess-perft-pos4-depth3 ()
:tags '(:capture :en-passant :promotion :check :checkmate)
- (let ((chess-ply-allow-interactive-query nil)
- (position
+ (let ((position
(chess-fen-to-pos
"r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
(should (equal (chess-perft position 3) '(9467 1021 4 0 120 38 22)))))
(ert-deftest chess-perft-pos4-depth4 ()
:tags '(:capture :castle :promotion :check :checkmate)
- (let ((chess-ply-allow-interactive-query nil)
- (position
+ (let ((position
(chess-fen-to-pos
"r3k2r/Pppp1ppp/1b3nbN/nP6/BBP1P3/q4N2/Pp1P2PP/R2Q1RK1 w kq -")))
(should (equal (chess-perft position 4) '(422333 131393 0 7795 60032 15492
5)))))
diff --git a/chess-ply.el b/chess-ply.el
index 036ff96..51b85fb 100644
--- a/chess-ply.el
+++ b/chess-ply.el
@@ -178,11 +178,9 @@
(if long :long-castle :castle))))))
(chess-message-catalog 'english
- '((pawn-promote-query . "Promote to queen? ")
- (ambiguous-promotion . "Promotion without :promote keyword")))
+ '((ambiguous-promotion . "Promotion without :promote keyword")))
(defvar chess-ply-checking-mate nil)
-(defvar chess-ply-allow-interactive-query nil)
(defsubst chess-ply-create* (position)
(cl-assert (vectorp position))
@@ -230,21 +228,12 @@ maneuver."
(setcdr ply new-changes)))
(when (eq piece (if color ?P ?p))
- ;; is this a pawn move to the ultimate rank? if so, and
- ;; we haven't already been told, ask for the piece to
- ;; promote it to
+ ;; is this a pawn move to the ultimate rank? if so, check
+ ;; that the :promote keyword is present.
(when (and (not (memq :promote changes))
(= (if color 0 7)
(chess-index-rank (cadr changes))))
- ;; This does not always clear ALL input events
- (discard-input) (sit-for 0) (sleep-for 0 1)
- (discard-input)
- (unless chess-ply-allow-interactive-query
- (chess-error 'ambiguous-promotion))
- (let ((new-piece (if (yes-or-no-p
- (chess-string 'pawn-promote-query))
- ?Q ?N)))
- (nconc changes (list :promote (upcase new-piece)))))
+ (chess-error 'ambiguous-promotion))
;; is this an en-passant capture?
(when (let ((ep (chess-pos-en-passant position)))
@@ -306,20 +295,17 @@ maneuver."
(list candidate)))
(if chess-ply-throw-if-any
(throw 'any-found t)
- (if (not chess-ply-allow-interactive-query)
- (let ((promotion (and (chess-pos-piece-p position candidate
- (if color ?P ?p))
- (= (chess-index-rank target)
- (if color 0 7)))))
- (if promotion
- (dolist (promote '(?Q ?R ?B ?N))
- (let ((ply (chess-ply-create position t candidate target
- :promote promote)))
- (when ply (push ply plies))))
- (let ((ply (chess-ply-create position t candidate target)))
- (when ply (push ply plies)))))
- (let ((ply (chess-ply-create position t candidate target)))
- (when ply (push ply plies))))))))
+ (let ((promotion (and (chess-pos-piece-p position candidate
+ (if color ?P ?p))
+ (= (chess-index-rank target)
+ (if color 0 7)))))
+ (if promotion
+ (dolist (promote '(?Q ?R ?B ?N))
+ (let ((ply (chess-ply-create position t candidate target
+ :promote promote)))
+ (when ply (push ply plies))))
+ (let ((ply (chess-ply-create position t candidate target)))
+ (when ply (push ply plies)))))))))
(defun chess-legal-plies (position &rest keywords)
"Return a list of all legal plies in POSITION.
