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 (defconst chess-algebraic-pieces-regexp "[RNBKQ]")
  36
  37 (defconst chess-algebraic-regexp
  38   (format (concat "\\("
  39                     "O-O\\(-O\\)?\\|"
  40                     "\\(%s?\\)/?"
  41                     "\\([a-h]?[1-8]?\\)"
  42                     "\\([x-]?\\)"
  43                     "\\([a-h][1-8]\\)"
  44                     "\\(=\\(%s\\)\\)?"
  45                   "\\)"
  46                   "\\([#+]\\)?")
  47           chess-algebraic-pieces-regexp
  48           chess-algebraic-pieces-regexp)
  49   "A regular expression that matches all possible algebraic moves.
  50 This regexp handles both long and short form.")
  51
  52 (defconst chess-algebraic-regexp-entire
  53   (concat chess-algebraic-regexp "$"))
  54
  55 (chess-message-catalog 'english
  56   '((clarify-piece     . "Clarify piece to move by rank or file")
  57     (could-not-clarify . "Could not determine which piece to use")
  58     (could-not-diff    . "Could not differentiate piece")
  59     (no-candidates     . "There are no candidate moves for '%s'")))
  60
  61 (defun chess-algebraic-to-ply (position move &optional trust)
  62   "Convert the algebraic notation MOVE for POSITION to a ply."
  63   (assert (vectorp position))
  64   (assert (stringp move))
  65   (let ((case-fold-search nil))
  66     (when (string-match chess-algebraic-regexp-entire move)
  67       (let ((color (chess-pos-side-to-move position))
  68             (mate (match-string 9 move))
  69             (piece (aref move 0))
  70             changes long-style)
  71         (if (eq piece ?O)
  72             (setq changes (chess-ply-castling-changes
  73                            position (= (length (match-string 1 move)) 5)))
  74           (let ((promotion (match-string 8 move)))
  75             (setq
  76              changes
  77              (let ((source (match-string 4 move))
  78                    (target (chess-coord-to-index (match-string 6 move))))
  79                (if (and source (= (length source) 2))
  80                    (prog1
  81                        (list (chess-coord-to-index source) target)
  82                      (setq long-style t))
  83                  (if (= (length source) 0)
  84                      (setq source nil)
  85                    (setq source (aref source 0)))
  86                  (let (candidates which)
  87                    (unless (< piece ?a)
  88                      (setq source piece piece ?P))
  89                    ;; we must use our knowledge of how pieces can
  90                    ;; move, to determine which piece is meant by the
  91                    ;; piece indicator
  92                    (if (setq candidates
  93                              (chess-search-position position target
  94                                                     (if color piece
  95                                                       (downcase piece))
  96                                                     nil t))
  97                        (if (= (length candidates) 1)
  98                            (list (car candidates) target)
  99                          (if (null source)
 100                              (chess-error 'clarify-piece)
 101                            (nconc changes (list :which source))
 102                            (while candidates
 103                              (if (if (>= source ?a)
 104                                      (eq (chess-index-file (car candidates))
 105                                          (- source ?a))
 106                                    (eq (chess-index-rank (car candidates))
 107                                        (- 7 (- source ?1))))
 108                                  (setq which (car candidates)
 109                                        candidates nil)
 110                                (setq candidates (cdr candidates))))
 111                            (if (null which)
 112                                (chess-error 'could-not-clarify)
 113                              (list which target))))
 114                      (chess-error 'no-candidates move))))))
 115             (if promotion
 116                 (nconc changes (list :promote (aref promotion 0))))))
 117
 118         (when changes
 119           (when trust
 120             (if mate
 121                 (nconc changes (list (if (equal mate "#") :checkmate :check)))))
 122           (unless long-style
 123             (nconc changes (list :san move)))
 124
 125           (apply 'chess-ply-create position trust changes))))))
 126
 127 (defun chess-ply--move-text (ply long)
 128   (or
 129    (and (chess-ply-keyword ply :castle) "O-O")
 130    (and (chess-ply-keyword ply :long-castle) "O-O-O")
 131    (let* ((pos (chess-ply-pos ply))
 132           (from (chess-ply-source ply))
 133           (to (chess-ply-target ply))
 134           (from-piece (chess-pos-piece pos from))
 135           (color (chess-pos-side-to-move pos))
 136           (rank 0) (file 0)
 137           (from-rank (chess-index-rank from))
 138           (from-file (chess-index-file from))
 139           (differentiator (chess-ply-keyword ply :which)))
 140         (unless differentiator
 141           (let ((candidates (chess-search-position pos to from-piece nil t)))
 142             (when (> (length candidates) 1)
 143               (dolist (candidate candidates)
 144                 (if (= (/ candidate 8) from-rank)
 145                     (setq rank (1+ rank)))
 146                 (if (= (mod candidate 8) from-file)
 147                     (setq file (1+ file))))
 148               (cond
 149                ((= file 1)
 150                 (setq differentiator (+ from-file ?a)))
 151                ((= rank 1)
 152                 (setq differentiator (+ (- 7 from-rank) ?1)))
 153                (t (chess-error 'could-not-diff)))
 154               (chess-ply-set-keyword ply :which differentiator))))
 155         (concat
 156          (unless (= (upcase from-piece) ?P)
 157            (char-to-string (upcase from-piece)))
 158          (if long
 159              (chess-index-to-coord from)
 160            (if differentiator
 161                (prog1
 162                    (char-to-string differentiator)
 163                  (chess-ply-changes ply))
 164              (if (and (not long) (= (upcase from-piece) ?P)
 165                       (/= (chess-index-file from)
 166                           (chess-index-file to)))
 167                  (char-to-string (+ (chess-index-file from) ?a)))))
 168          (if (or (/= ?  (chess-pos-piece pos to))
 169                  (chess-ply-keyword ply :en-passant))
 170              "x" (if long "-"))
 171          (chess-index-to-coord to)
 172          (let ((promote (chess-ply-keyword ply :promote)))
 173            (if promote
 174                (concat "=" (char-to-string promote))))
 175          (if (chess-ply-keyword ply :check) "+"
 176            (if (chess-ply-keyword ply :checkmate) "#"))))))
 177
 178 (defun chess-ply-to-algebraic (ply &optional long)
 179   "Convert the given PLY to algebraic notation.
 180 If LONG is non-nil, render the move into long notation."
 181   (assert (listp ply))
 182   (or (and (not long) (chess-ply-keyword ply :san))
 183       (and (null (chess-ply-source ply)) "")
 184       (let ((move (chess-ply--move-text ply long)))
 185         (unless long (chess-ply-set-keyword ply :san move))
 186         move)))
 187
 188 (provide 'chess-algebraic)
 189
 190 ;;; chess-algebraic.el ends here