-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Convert a ply to/from standard chess algebraic notation
-;;
+;;; chess-algebraic.el --- Convert a ply to/from standard chess algebraic notation
+
+;; Copyright (C) 2002, 2004, 2008, 2014 Free Software Foundation, Inc.
+
+;; Author: John Wiegley <johnw@gnu.org>
+;; Maintainer: Mario Lang <mlang@delysid.org>
+;; Keywords: games
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
;; A thing to deal with in chess is algebraic move notation, such as
;; Nxf3+. (I leave description of this notation to better manuals
;; than this). This notation is a shorthand way of representing where
;; buffer:
;;
;; chess-algebraic-regexp
-;;
-(require 'chess-ply)
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(require 'chess-message)
+(require 'chess-pos)
(defconst chess-algebraic-pieces-regexp "[RNBKQ]")
+;; jww (2008-09-01): use rx here, like in chess-ics
(defconst chess-algebraic-regexp
(format (concat "\\("
"O-O\\(-O\\)?\\|"
- "\\(%s?\\)"
+ "\\(%s?\\)/?" ; what is the / doing here?
"\\([a-h]?[1-8]?\\)"
"\\([x-]?\\)"
"\\([a-h][1-8]\\)"
(defconst chess-algebraic-regexp-entire
(concat chess-algebraic-regexp "$"))
+(defconst chess-algebraic-regexp-ws
+ (concat chess-algebraic-regexp "\\s-"))
+
(chess-message-catalog 'english
'((clarify-piece . "Clarify piece to move by rank or file")
(could-not-clarify . "Could not determine which piece to use")
(could-not-diff . "Could not differentiate piece")
- (no-candidates . "There are no candidate moves for '%s'")))
+ (no-candidates . "There are no candidate moves for '%s'")
+ (at-move-string . "At algebraic move '%s': %s")))
(defun chess-algebraic-to-ply (position move &optional trust)
"Convert the algebraic notation MOVE for POSITION to a ply."
- (when (string-match chess-algebraic-regexp-entire move)
- (let ((color (chess-pos-side-to-move position))
- (mate (match-string 9 move))
- (piece (aref move 0))
- changes ply)
- (if (eq piece ?O)
- (let ((long (= (length (match-string 1 move)) 5)))
- (if (chess-pos-can-castle position (if long (if color ?Q ?q)
- (if color ?K ?k)))
- (setq changes (chess-ply-create-castle position long))))
- (let ((promotion (match-string 8 move)))
- (setq changes
- (let ((source (match-string 4 move))
- (target (chess-coord-to-index (match-string 6 move))))
- (if (and source (= (length source) 2))
- (list (chess-coord-to-index source) target)
- (if (= (length source) 0)
- (setq source nil)
- (setq source (aref source 0)))
- (let (candidates which)
- (unless (< piece ?a)
- (setq source piece piece ?P))
- ;; we must use our knowledge of how pieces can
- ;; move, to determine which piece is meant by the
- ;; piece indicator
- (if (setq candidates
- (chess-search-position position target
- (if color piece
- (downcase piece))))
- (if (= (length candidates) 1)
- (list (car candidates) target)
- (if (null source)
- (chess-error 'clarify-piece)
- (nconc changes (list :which source))
- (while candidates
- (if (if (>= source ?a)
- (eq (chess-index-file (car candidates))
- (- source ?a))
- (eq (chess-index-rank (car candidates))
- (- 7 (- source ?1))))
- (setq which (car candidates)
- candidates nil)
- (setq candidates (cdr candidates))))
- (if (null which)
- (chess-error 'could-not-clarify)
- (list which target))))
- (chess-error 'no-candidates move))))))
- (if promotion
- (nconc changes (list :promote (aref promotion 0))))))
-
- (if (and trust mate)
- (nconc changes (list (if (equal mate "#") :checkmate :check))))
-
- (or ply (apply 'chess-ply-create position trust changes)))))
+ (cl-assert (vectorp position))
+ (cl-assert (stringp move))
+ (let ((case-fold-search nil))
+ (when (string-match chess-algebraic-regexp-entire move)
+ (let ((color (chess-pos-side-to-move position))
+ (mate (match-string 9 move))
+ (piece (aref move 0))
+ changes long-style)
+ (if (eq piece ?O)
+ (setq changes (chess-ply-castling-changes
+ position (= (length (match-string 1 move)) 5)))
+ (let ((promotion (match-string 8 move)))
+ (setq
+ changes
+ (let ((source (match-string 4 move))
+ (target (chess-coord-to-index (match-string 6 move))))
+ (if (and source (= (length source) 2))
+ (prog1
+ (list (chess-coord-to-index source) target)
+ (setq long-style t))
+ (if (= (length source) 0)
+ (setq source nil)
+ (setq source (aref source 0)))
+ (let (candidates which)
+ (unless (< piece ?a)
+ (setq source piece piece ?P))
+ ;; we must use our knowledge of how pieces can
+ ;; move, to determine which piece is meant by the
+ ;; piece indicator
+ (if (setq candidates
+ (chess-search-position position target
+ (if color piece
+ (downcase piece))
+ nil t))
+ (if (= (length candidates) 1)
+ (list (car candidates) target)
+ (if (null source)
+ (chess-error 'clarify-piece)
+ (nconc changes (list :which source))
+ (while candidates
+ (if (if (>= source ?a)
+ (eq (chess-index-file (car candidates))
+ (- source ?a))
+ (eq (chess-index-rank (car candidates))
+ (- 7 (- source ?1))))
+ (setq which (car candidates)
+ candidates nil)
+ (setq candidates (cdr candidates))))
+ (if (null which)
+ (chess-error 'could-not-clarify)
+ (list which target))))
+ (chess-error 'no-candidates move))))))
+ (if promotion
+ (nconc changes (list :promote (aref promotion 0))))))
+
+ (when changes
+ (if (and trust mate)
+ (nconc changes (list (if (equal mate "#")
+ :checkmate
+ :check))))
+ (unless long-style
+ (nconc changes (list :san move)))
+
+ (condition-case err
+ (apply 'chess-ply-create position trust changes)
+ (error
+ (chess-error 'at-move-string
+ move (error-message-string err)))))))))
+
+(defun chess-ply--move-text (ply long)
+ (or
+ (and (chess-ply-keyword ply :castle) "O-O")
+ (and (chess-ply-keyword ply :long-castle) "O-O-O")
+ (let* ((pos (chess-ply-pos ply))
+ (from (chess-ply-source ply))
+ (to (chess-ply-target ply))
+ (from-piece (chess-pos-piece pos from))
+ (rank 0) (file 0)
+ (from-rank (chess-index-rank from))
+ (from-file (chess-index-file from))
+ (differentiator (chess-ply-keyword ply :which)))
+ (unless differentiator
+ (let ((candidates (chess-search-position pos to from-piece nil t)))
+ (when (> (length candidates) 1)
+ (dolist (candidate candidates)
+ (if (= (/ candidate 8) from-rank)
+ (setq rank (1+ rank)))
+ (if (= (mod candidate 8) from-file)
+ (setq file (1+ file))))
+ (cond
+ ((= file 1)
+ (setq differentiator (+ from-file ?a)))
+ ((= rank 1)
+ (setq differentiator (+ (- 7 from-rank) ?1)))
+ (t (chess-error 'could-not-diff)))
+ (chess-ply-set-keyword ply :which differentiator))))
+ (concat
+ (unless (= (upcase from-piece) ?P)
+ (char-to-string (upcase from-piece)))
+ (if long
+ (chess-index-to-coord from)
+ (if differentiator
+ (prog1
+ (char-to-string differentiator)
+ (chess-ply-changes ply))
+ (if (and (not long) (= (upcase from-piece) ?P)
+ (/= (chess-index-file from)
+ (chess-index-file to)))
+ (char-to-string (+ (chess-index-file from) ?a)))))
+ (if (or (/= ? (chess-pos-piece pos to))
+ (chess-ply-keyword ply :en-passant))
+ "x" (if long "-"))
+ (chess-index-to-coord to)
+ (let ((promote (chess-ply-keyword ply :promote)))
+ (if promote
+ (concat "=" (char-to-string promote))))
+ (if (chess-ply-keyword ply :check) "+"
+ (if (chess-ply-keyword ply :checkmate) "#"))))))
(defun chess-ply-to-algebraic (ply &optional long)
"Convert the given PLY to algebraic notation.
If LONG is non-nil, render the move into long notation."
- (if (let ((source (chess-ply-source ply)))
- (or (null source) (symbolp source)))
- ""
- (or (and (chess-ply-keyword ply :castle) "O-O")
- (and (chess-ply-keyword ply :long-castle) "O-O-O")
- (let* ((pos (chess-ply-pos ply))
- (from (chess-ply-source ply))
- (to (chess-ply-target ply))
- (from-piece (chess-pos-piece pos from))
- (color (chess-pos-side-to-move pos))
- (rank 0) (file 0)
- (from-rank (/ from 8))
- (from-file (mod from 8))
- (differentiator (chess-ply-keyword ply :which)))
- (unless differentiator
- (let ((candidates (chess-search-position pos to from-piece)))
- (when (> (length candidates) 1)
- (dolist (candidate candidates)
- (if (= (/ candidate 8) from-rank)
- (setq rank (1+ rank)))
- (if (= (mod candidate 8) from-file)
- (setq file (1+ file))))
- (cond
- ((= file 1)
- (setq differentiator (+ from-file ?a)))
- ((= rank 1)
- (setq differentiator (+ (- 7 from-rank) ?1)))
- (t (chess-error 'could-not-diff)))
- (nconc (chess-ply-changes ply)
- (list :which differentiator)))))
- (concat
- (unless (= (upcase from-piece) ?P)
- (char-to-string (upcase from-piece)))
- (if long
- (chess-index-to-coord from)
- (if differentiator
- (prog1
- (char-to-string differentiator)
- (chess-ply-changes ply))
- (if (and (not long) (= (upcase from-piece) ?P)
- (/= (chess-index-file from)
- (chess-index-file to)))
- (char-to-string (+ (chess-index-file from) ?a)))))
- (if (or (/= ? (chess-pos-piece pos to))
- (chess-ply-keyword ply :en-passant))
- "x" (if long "-"))
- (chess-index-to-coord to)
- (let ((promote (chess-ply-keyword ply :promote)))
- (if promote
- (concat "=" (char-to-string
- (upcase (cadr promote))))))
- (if (chess-ply-keyword ply :check) "+"
- (if (chess-ply-keyword ply :checkmate) "#")))))))
+ (cl-assert (listp ply))
+ (or (and (not long) (chess-ply-keyword ply :san))
+ (and (null (chess-ply-source ply)) "")
+ (let ((move (chess-ply--move-text ply long)))
+ (unless long (chess-ply-set-keyword ply :san move))
+ move)))
(provide 'chess-algebraic)