emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] 01/01: Remove chess-ply-allow-interactive-query.


From: Mario Lang
Subject: [elpa] 01/01: Remove chess-ply-allow-interactive-query.
Date: Sun, 25 May 2014 14:54:03 +0000

mlang pushed a commit to branch externals/chess
in repository elpa.

commit d3c4eb4058c275b205fb63139a703cdf1c543c13
Author: Mario Lang <address@hidden>
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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]