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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Convert a ply to/from standard chess algebraic notation
   4 ;;
   5 ;; A thing to deal with in chess is algebraic move notation, such as
   6 ;; Nxf3+.  (I leave description of this notation to better manuals
   7 ;; than this).  This notation is a shorthand way of representing where
   8 ;; a piece is moving from and to, by specifying the piece is involved,
   9 ;; where it's going, and whether or not a capture or check is
  10 ;; involved.
  11 ;;
  12 ;; You can convert from algebraic notation to a ply (one pair in most
  13 ;; cases, but two for a castle) using the following function (NOTE:
  14 ;; POSITION determines which side is on move (by calling
  15 ;; `chess-pos-side-to-move')):
  16 ;;
  17 ;;    (chess-algebraic-to-ply POSITION STRING)
  18 ;;
  19 ;; The function also checks if a move is legal, and will raise an
  20 ;; error if not.
  21 ;;
  22 ;; To convert from a ply to algebraic notation, use:
  23 ;;
  24 ;;    (chess-ply-to-algebraic PLY)
  25 ;;
  26 ;; Castling is determined by the movement of both a king and a rook.
  27 ;;
  28 ;; Lastly, there is a regexp for quickly checking if a string is in
  29 ;; algebraic notation or not, or searching out algebraic strings in a
  30 ;; buffer:
  31 ;;
  32 ;;    chess-algebraic-regexp
  33 ;;
  34
  35 (eval-when-compile (require 'cl))
  36
  37 (require 'chess-message)
  38
  39 (defconst chess-algebraic-pieces-regexp "[RNBKQ]")
  40
  41 ;; jww (2008-09-01): use rx here, like in chess-ics
  42 (defconst chess-algebraic-regexp
  43   (format (concat "\\("
  44                     "O-O\\(-O\\)?\\|"
  45                     "\\(%s?\\)/?"       ; what is the / doing here?
  46                     "\\([a-h]?[1-8]?\\)"
  47                     "\\([x-]?\\)"
  48                     "\\([a-h][1-8]\\)"
  49                     "\\(=\\(%s\\)\\)?"
  50                   "\\)"
  51                   "\\([#+]\\)?")
  52           chess-algebraic-pieces-regexp
  53           chess-algebraic-pieces-regexp)
  54   "A regular expression that matches all possible algebraic moves.
  55 This regexp handles both long and short form.")
  56
  57 (defconst chess-algebraic-regexp-entire
  58   (concat chess-algebraic-regexp "$"))
  59
  60 (defconst chess-algebraic-regexp-ws
  61   (concat chess-algebraic-regexp "\\s-"))
  62
  63 (chess-message-catalog 'english
  64   '((clarify-piece     . "Clarify piece to move by rank or file")
  65     (could-not-clarify . "Could not determine which piece to use")
  66     (could-not-diff    . "Could not differentiate piece")
  67     (no-candidates     . "There are no candidate moves for '%s'")
  68     (at-move-string    . "At algebraic move '%s': %s")))
  69
  70 (defun chess-algebraic-to-ply (position move &optional trust)
  71   "Convert the algebraic notation MOVE for POSITION to a ply."
  72   (assert (vectorp position))
  73   (assert (stringp move))
  74   (let ((case-fold-search nil))
  75     (when (string-match chess-algebraic-regexp-entire move)
  76       (let ((color (chess-pos-side-to-move position))
  77             (mate (match-string 9 move))
  78             (piece (aref move 0))
  79             changes long-style)
  80         (if (eq piece ?O)
  81             (setq changes (chess-ply-castling-changes
  82                            position (= (length (match-string 1 move)) 5)))
  83           (let ((promotion (match-string 8 move)))
  84             (setq
  85              changes
  86              (let ((source (match-string 4 move))
  87                    (target (chess-coord-to-index (match-string 6 move))))
  88                (if (and source (= (length source) 2))
  89                    (prog1
  90                        (list (chess-coord-to-index source) target)
  91                      (setq long-style t))
  92                  (if (= (length source) 0)
  93                      (setq source nil)
  94                    (setq source (aref source 0)))
  95                  (let (candidates which)
  96                    (unless (< piece ?a)
  97                      (setq source piece piece ?P))
  98                    ;; we must use our knowledge of how pieces can
  99                    ;; move, to determine which piece is meant by the
 100                    ;; piece indicator
 101                    (if (setq candidates
 102                              (chess-search-position position target
 103                                                     (if color piece
 104                                                       (downcase piece))
 105                                                     nil t))
 106                        (if (= (length candidates) 1)
 107                            (list (car candidates) target)
 108                          (if (null source)
 109                              (chess-error 'clarify-piece)
 110                            (nconc changes (list :which source))
 111                            (while candidates
 112                              (if (if (>= source ?a)
 113                                      (eq (chess-index-file (car candidates))
 114                                          (- source ?a))
 115                                    (eq (chess-index-rank (car candidates))
 116                                        (- 7 (- source ?1))))
 117                                  (setq which (car candidates)
 118                                        candidates nil)
 119                                (setq candidates (cdr candidates))))
 120                            (if (null which)
 121                                (chess-error 'could-not-clarify)
 122                              (list which target))))
 123                      (chess-error 'no-candidates move))))))
 124             (if promotion
 125                 (nconc changes (list :promote (aref promotion 0))))))
 126
 127         (when changes
 128           (if (and trust mate)
 129               (nconc changes (list (if (equal mate "#")
 130                                        :checkmate
 131                                      :check))))
 132           (unless long-style
 133             (nconc changes (list :san move)))
 134
 135           (condition-case err
 136               (apply 'chess-ply-create position trust changes)
 137             (error
 138              (chess-error 'at-move-string
 139                           move (error-message-string err)))))))))
 140
 141 (defun chess-ply--move-text (ply long)
 142   (or
 143    (and (chess-ply-keyword ply :castle) "O-O")
 144    (and (chess-ply-keyword ply :long-castle) "O-O-O")
 145    (let* ((pos (chess-ply-pos ply))
 146           (from (chess-ply-source ply))
 147           (to (chess-ply-target ply))
 148           (from-piece (chess-pos-piece pos from))
 149           (color (chess-pos-side-to-move pos))
 150           (rank 0) (file 0)
 151           (from-rank (chess-index-rank from))
 152           (from-file (chess-index-file from))
 153           (differentiator (chess-ply-keyword ply :which)))
 154         (unless differentiator
 155           (let ((candidates (chess-search-position pos to from-piece nil t)))
 156             (when (> (length candidates) 1)
 157               (dolist (candidate candidates)
 158                 (if (= (/ candidate 8) from-rank)
 159                     (setq rank (1+ rank)))
 160                 (if (= (mod candidate 8) from-file)
 161                     (setq file (1+ file))))
 162               (cond
 163                ((= file 1)
 164                 (setq differentiator (+ from-file ?a)))
 165                ((= rank 1)
 166                 (setq differentiator (+ (- 7 from-rank) ?1)))
 167                (t (chess-error 'could-not-diff)))
 168               (chess-ply-set-keyword ply :which differentiator))))
 169         (concat
 170          (unless (= (upcase from-piece) ?P)
 171            (char-to-string (upcase from-piece)))
 172          (if long
 173              (chess-index-to-coord from)
 174            (if differentiator
 175                (prog1
 176                    (char-to-string differentiator)
 177                  (chess-ply-changes ply))
 178              (if (and (not long) (= (upcase from-piece) ?P)
 179                       (/= (chess-index-file from)
 180                           (chess-index-file to)))
 181                  (char-to-string (+ (chess-index-file from) ?a)))))
 182          (if (or (/= ?  (chess-pos-piece pos to))
 183                  (chess-ply-keyword ply :en-passant))
 184              "x" (if long "-"))
 185          (chess-index-to-coord to)
 186          (let ((promote (chess-ply-keyword ply :promote)))
 187            (if promote
 188                (concat "=" (char-to-string promote))))
 189          (if (chess-ply-keyword ply :check) "+"
 190            (if (chess-ply-keyword ply :checkmate) "#"))))))
 191
 192 (defun chess-ply-to-algebraic (ply &optional long)
 193   "Convert the given PLY to algebraic notation.
 194 If LONG is non-nil, render the move into long notation."
 195   (assert (listp ply))
 196   (or (and (not long) (chess-ply-keyword ply :san))
 197       (and (null (chess-ply-source ply)) "")
 198       (let ((move (chess-ply--move-text ply long)))
 199         (unless long (chess-ply-set-keyword ply :san move))
 200         move)))
 201
 202 (provide 'chess-algebraic)
 203
 204 ;;; chess-algebraic.el ends here