code.delx.au - gnu-emacs-elpa/blob - chess-algebraic.el

   1 ;;; chess-algebraic.el --- Convert a ply to/from standard chess algebraic notation
   2
   3 ;; Copyright (C) 2002, 2004, 2008, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; A thing to deal with in chess is algebraic move notation, such as
  25 ;; Nxf3+.  (I leave description of this notation to better manuals
  26 ;; than this).  This notation is a shorthand way of representing where
  27 ;; a piece is moving from and to, by specifying the piece is involved,
  28 ;; where it's going, and whether or not a capture or check is
  29 ;; involved.
  30 ;;
  31 ;; You can convert from algebraic notation to a ply (one pair in most
  32 ;; cases, but two for a castle) using the following function (NOTE:
  33 ;; POSITION determines which side is on move (by calling
  34 ;; `chess-pos-side-to-move')):
  35 ;;
  36 ;;    (chess-algebraic-to-ply POSITION STRING)
  37 ;;
  38 ;; The function also checks if a move is legal, and will raise an
  39 ;; error if not.
  40 ;;
  41 ;; To convert from a ply to algebraic notation, use:
  42 ;;
  43 ;;    (chess-ply-to-algebraic PLY)
  44 ;;
  45 ;; Castling is determined by the movement of both a king and a rook.
  46 ;;
  47 ;; Lastly, there is a regexp for quickly checking if a string is in
  48 ;; algebraic notation or not, or searching out algebraic strings in a
  49 ;; buffer:
  50 ;;
  51 ;;    chess-algebraic-regexp
  52
  53 ;;; Code:
  54
  55 (require 'chess-message)
  56 (require 'chess-ply)
  57 (require 'chess-pos)
  58 (require 'cl-lib)
  59
  60 (defconst chess-algebraic-figurine-pieces
  61   '((?K . #x2654) (?Q . #x2655) (?R . #x2656)
  62     (?B . #x2657) (?N . #x2658) (?P . #x2659)
  63     (?k . #x265A) (?q . #x265B) (?r . #x265C)
  64     (?b . #x265D) (?n . #x265E) (?p . #x265F))
  65   "Map internal piece representation to Unicode chess figures (as used in figurine
  66 notation.")
  67
  68 (defconst chess-algebraic-regexp
  69   (rx (group (or (or "O-O" "O-O-O" "0-0" "0-0-0")
  70                  (and (optional (group (char ?N ?B ?R ?Q ?K
  71                                              ?♔ ?♕ ?♖ ?♗ ?♘
  72                                              ?♚ ?♛ ?♜ ?♝ ?♞)))
  73                       (optional (char ?/))
  74                       (group (optional (char "a-h")) (optional (char "1-8")))
  75                       (optional (group (char ?- ?x)))
  76                       (group (char "a-h") (char "1-8"))
  77                       (optional (group ?= (group (char ?N ?B ?R ?Q ?K
  78                                                        ?♔ ?♕ ?♖ ?♗ ?♘
  79                                                        ?♚ ?♛ ?♜ ?♝ ?♞)))))))
  80       (optional (group (char ?+ ?#))))
  81   "A regular expression that matches all possible algebraic moves.
  82 This regexp matches short, long and figurine notation.")
  83
  84 (defconst chess-algebraic-regexp-entire (concat chess-algebraic-regexp "$"))
  85
  86 (defconst chess-algebraic-regexp-ws (concat chess-algebraic-regexp "\\s-"))
  87
  88 (chess-message-catalog 'english
  89   '((clarify-piece     . "Clarify piece to move by rank or file")
  90     (could-not-clarify . "Could not determine which piece to use")
  91     (could-not-diff    . "Could not differentiate piece")
  92     (no-candidates     . "There are no candidate moves for '%s'")
  93     (at-move-string    . "At algebraic move '%s': %s")))
  94
  95 (defun chess-algebraic-to-ply (position move &optional trust)
  96   "Convert (short, long or figurine) algebraic notation MOVE for POSITION to a ply."
  97   (cl-check-type position chess-pos)
  98   (cl-check-type move string)
  99   (let ((case-fold-search nil))
 100     (when (string-match chess-algebraic-regexp-entire move)
 101       (let ((color (chess-pos-side-to-move position))
 102             (mate (match-string 8 move))
 103             (piece (aref move 0))
 104             changes type)
 105         (if (or (= piece ?O) (= piece ?0))
 106             (setq changes (chess-ply-castling-changes
 107                            position (= (length (match-string 1 move)) 5)))
 108           (let ((promotion (match-string 7 move)))
 109             (setq
 110              changes
 111              (let ((source (match-string 3 move))
 112                    (target (chess-coord-to-index (match-string 5 move))))
 113                (if (and source (= (length source) 2))
 114                    (prog1
 115                        (list (chess-coord-to-index source) target)
 116                      (setq type :lan))
 117                  (if (= (length source) 0)
 118                      (setq source nil)
 119                    (setq source (aref source 0)))
 120                  (let (candidates which)
 121                    (when (and (not type) (< piece ?a))
 122                      (setq type :san))
 123                    (when (rassq piece chess-algebraic-figurine-pieces)
 124                      (unless type (setq type :fan))
 125                      (setq piece (upcase
 126                                   (car (rassq piece chess-algebraic-figurine-pieces)))))
 127                    (unless (< piece ?a)
 128                      (setq source piece piece ?P))
 129                    ;; we must use our knowledge of how pieces can
 130                    ;; move, to determine which piece is meant by the
 131                    ;; piece indicator
 132                    (if (setq candidates
 133                              (chess-search-position position target
 134                                                     (if color piece
 135                                                       (downcase piece))
 136                                                     nil t))
 137                        (if (= (length candidates) 1)
 138                            (list (car candidates) target)
 139                          (if (null source)
 140                              (chess-error 'clarify-piece)
 141                            (while candidates
 142                              (if (if (>= source ?a)
 143                                      (= (chess-index-file (car candidates))
 144                                         (chess-file-from-char source))
 145                                    (= (chess-index-rank (car candidates))
 146                                       (chess-rank-from-char source)))
 147                                  (setq which (car candidates)
 148                                        candidates nil)
 149                                (setq candidates (cdr candidates))))
 150                            (if (null which)
 151                                (chess-error 'could-not-clarify)
 152                              (list which target))))
 153                      (chess-error 'no-candidates move))))))
 154
 155             (when promotion
 156               (nconc changes
 157                      (list :promote
 158                            (upcase (or (car (rassq (aref promotion 0)
 159                                                    chess-algebraic-figurine-pieces))
 160                                        (aref promotion 0))))))))
 161
 162         (when changes
 163           (if (and trust mate)
 164               (nconc changes (list (if (string-equal mate "#")
 165                                        :checkmate
 166                                      :check))))
 167           ;; If we know the notation type by now, remember the string so that
 168           ;; we do not need to re-generate it later on.
 169           (when type
 170             (cl-check-type type keyword)
 171             (nconc changes (list type move)))
 172
 173           (condition-case err
 174               (apply 'chess-ply-create position trust changes)
 175             (error
 176              (chess-error 'at-move-string
 177                           move (error-message-string err)))))))))
 178
 179 (defun chess-ply-to-algebraic (ply &optional type)
 180   "Convert the given PLY to algebraic notation.
 181 Optional argument TYPE specifies the kind of algebraic notation to generate.
 182 `:san' (the default) generates short (or standard) algebraic notation
 183 \(like \"Nc3\").  `:lan' generates long algebraic notation (like \"Nb1-c3\".
 184 `:fan' generates figurine algebraic notation (like \"♘c3\".
 185 Finally, `:numeric' generates ICCF numeric notation (like \"2133\"."
 186   (cl-check-type ply (and list (not null)))
 187   (cl-check-type type (member nil :san :fan :lan :numeric))
 188   (unless type (setq type :san))
 189   (or (chess-ply-keyword ply type)
 190       (and (null (chess-ply-source ply)) "")
 191       (chess-ply-set-keyword
 192        ply type
 193        (or
 194         (and (eq type :numeric)
 195              (apply
 196               #'string
 197               (+ (chess-index-file (chess-ply-source ply)) ?1)
 198               (+ (chess-index-rank (logxor (chess-ply-source ply) #o70)) ?1)
 199               (+ (chess-index-file (chess-ply-target ply)) ?1)
 200               (+ (chess-index-rank (logxor (chess-ply-target ply) #o70)) ?1)
 201               (when (chess-ply-keyword ply :promote)
 202                 (list (+ (cl-position (chess-ply-keyword ply :promote)
 203                                       '(?Q ?R ?B ?N)) ?1)))))
 204         (and (chess-ply-keyword ply :castle) "O-O")
 205         (and (chess-ply-keyword ply :long-castle) "O-O-O")
 206         (let* ((pos (chess-ply-pos ply))
 207                (from (chess-ply-source ply))
 208                (to (chess-ply-target ply))
 209                (from-piece (chess-pos-piece pos from))
 210                (rank 0) (file 0)
 211                (from-rank (chess-index-rank from))
 212                (from-file (chess-index-file from))
 213                (differentiator (chess-ply-keyword ply :which)))
 214           (unless differentiator
 215             (let ((candidates (chess-search-position pos to from-piece nil t)))
 216               (when (> (length candidates) 1)
 217                 (dolist (candidate candidates)
 218                   (when (= (chess-index-rank candidate) from-rank)
 219                     (setq rank (1+ rank)))
 220                   (when (= (chess-index-file candidate) from-file)
 221                     (setq file (1+ file))))
 222                 (cond ((= file 1) (setq differentiator (chess-file-to-char from-file)))
 223                       ((= rank 1) (setq differentiator (chess-rank-to-char from-rank)))
 224                       (t (chess-error 'could-not-diff)))
 225                 (chess-ply-set-keyword ply :which differentiator))))
 226           (concat
 227            (unless (= (upcase from-piece) ?P)
 228              (char-to-string
 229               (cond ((memq type '(:san :lan)) (upcase from-piece))
 230                     ((eq type :fan)
 231                      (cdr (assq from-piece chess-algebraic-figurine-pieces))))))
 232            (cond
 233             ((eq type :lan) (chess-index-to-coord from))
 234             (differentiator (char-to-string differentiator))
 235             ((and (not (eq type :lan)) (= (upcase from-piece) ?P)
 236                   (/= from-file (chess-index-file to)))
 237              (char-to-string (chess-file-to-char from-file))))
 238            (if (or (/= ?  (chess-pos-piece pos to))
 239                    (chess-ply-keyword ply :en-passant))
 240                "x" (if (eq type :lan) "-"))
 241            (chess-index-to-coord to)
 242            (let ((promote (chess-ply-keyword ply :promote)))
 243              (if promote
 244                  (concat "=" (char-to-string
 245                               (cond ((eq type :fan)
 246                                      (cdr (assq (if (chess-pos-side-to-move pos)
 247                                                     promote
 248                                                   (downcase promote))
 249                                                 chess-algebraic-figurine-pieces)))
 250                                     (t promote))))))
 251            (if (chess-ply-keyword ply :check) "+"
 252              (if (chess-ply-keyword ply :checkmate) "#"))))))))
 253
 254 (provide 'chess-algebraic)
 255
 256 ;;; chess-algebraic.el ends here