[elpa] 02/06: Misc. fixes.

[Mario Lang]

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

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