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 (eq piece ?O) (eq 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                            (nconc changes (list :which source))
 142                            (while candidates
 143                              (if (if (>= source ?a)
 144                                      (eq (chess-index-file (car candidates))
 145                                          (- source ?a))
 146                                    (eq (chess-index-rank (car candidates))
 147                                        (- 7 (- source ?1))))
 148                                  (setq which (car candidates)
 149                                        candidates nil)
 150                                (setq candidates (cdr candidates))))
 151                            (if (null which)
 152                                (chess-error 'could-not-clarify)
 153                              (list which target))))
 154                      (chess-error 'no-candidates move))))))
 155
 156             (when promotion
 157               (nconc changes
 158                      (list :promote
 159                            (upcase (or (car (rassq (aref promotion 0)
 160                                                    chess-algebraic-figurine-pieces))
 161                                        (aref promotion 0))))))))
 162
 163         (when changes
 164           (if (and trust mate)
 165               (nconc changes (list (if (string-equal mate "#")
 166                                        :checkmate
 167                                      :check))))
 168           ;; If we know the notation type by now, remember the string so that
 169           ;; we do not need to re-generate it later on.
 170           (when type
 171             (cl-check-type type keyword)
 172             (nconc changes (list type move)))
 173
 174           (condition-case err
 175               (apply 'chess-ply-create position trust changes)
 176             (error
 177              (chess-error 'at-move-string
 178                           move (error-message-string err)))))))))
 179
 180 (defun chess-ply-to-algebraic (ply &optional type)
 181   "Convert the given PLY to algebraic notation.
 182 Optional argument TYPE specifies the kind of algebraic notation to generate.
 183 `:san' (the default) generates short (or standard) algebraic notation
 184 \(like \"Nc3\").  `:lan' generates long algebraic notation (like \"Nb1-c3\".
 185 `:fan' generates figurine algebraic notation (like \"♘c3\".
 186 Finally, `:numeric' generates ICCF numeric notation (like \"2133\"."
 187   (cl-check-type ply (and list (not null)))
 188   (cl-check-type type (member nil :san :fan :lan :numeric))
 189   (unless type (setq type :san))
 190   (or (chess-ply-keyword ply type)
 191       (and (null (chess-ply-source ply)) "")
 192       (chess-ply-set-keyword
 193        ply type
 194        (or
 195         (and (eq type :numeric)
 196              (apply
 197               #'string
 198               (+ (chess-index-file (chess-ply-source ply)) ?1)
 199               (+ (chess-index-rank (logxor (chess-ply-source ply) #o70)) ?1)
 200               (+ (chess-index-file (chess-ply-target ply)) ?1)
 201               (+ (chess-index-rank (logxor (chess-ply-target ply) #o70)) ?1)
 202               (when (chess-ply-keyword ply :promote)
 203                 (list (+ (cl-position (chess-ply-keyword ply :promote)
 204                                       '(?Q ?R ?B ?N)) ?1)))))
 205         (and (chess-ply-keyword ply :castle) "O-O")
 206         (and (chess-ply-keyword ply :long-castle) "O-O-O")
 207         (let* ((pos (chess-ply-pos ply))
 208                (from (chess-ply-source ply))
 209                (to (chess-ply-target ply))
 210                (from-piece (chess-pos-piece pos from))
 211                (rank 0) (file 0)
 212                (from-rank (chess-index-rank from))
 213                (from-file (chess-index-file from))
 214                (differentiator (chess-ply-keyword ply :which)))
 215           (unless differentiator
 216             (let ((candidates (chess-search-position pos to from-piece nil t)))
 217               (when (> (length candidates) 1)
 218                 (dolist (candidate candidates)
 219                   (when (= (chess-index-rank candidate) from-rank)
 220                     (setq rank (1+ rank)))
 221                   (when (= (chess-index-file candidate) from-file)
 222                     (setq file (1+ file))))
 223                 (cond
 224                  ((= file 1)
 225                   (setq differentiator (+ from-file ?a)))
 226                  ((= rank 1)
 227                   (setq differentiator (+ (- 7 from-rank) ?1)))
 228                  (t (chess-error 'could-not-diff)))
 229                 (chess-ply-set-keyword ply :which differentiator))))
 230           (concat
 231            (unless (= (upcase from-piece) ?P)
 232              (char-to-string
 233               (cond ((memq type '(:san :lan)) (upcase from-piece))
 234                     ((eq type :fan)
 235                      (cdr (assq from-piece chess-algebraic-figurine-pieces))))))
 236            (cond
 237             ((eq type :lan) (chess-index-to-coord from))
 238             (differentiator (char-to-string differentiator))
 239             ((and (not (eq type :lan)) (= (upcase from-piece) ?P)
 240                   (/= from-file (chess-index-file to)))
 241              (char-to-string (+ from-file ?a))))
 242            (if (or (/= ?  (chess-pos-piece pos to))
 243                    (chess-ply-keyword ply :en-passant))
 244                "x" (if (eq type :lan) "-"))
 245            (chess-index-to-coord to)
 246            (let ((promote (chess-ply-keyword ply :promote)))
 247              (if promote
 248                  (concat "=" (char-to-string
 249                               (cond ((eq type :fan)
 250                                      (cdr (assq (if (chess-pos-side-to-move pos)
 251                                                     promote
 252                                                   (downcase promote))
 253                                                 chess-algebraic-figurine-pieces)))
 254                                     (t promote))))))
 255            (if (chess-ply-keyword ply :check) "+"
 256              (if (chess-ply-keyword ply :checkmate) "#"))))))))
 257
 258 (provide 'chess-algebraic)
 259
 260 ;;; chess-algebraic.el ends here