-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 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
;;
;; chess-algebraic-regexp
-;; $Revision$
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+(require 'chess-message)
(require 'chess-pos)
-(require 'chess-ply)
(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?\\(\\([a-h]\\|[1-8]\\)?\\|[a-h][1-8]\\)\\)?"
- "\\([x-]\\)?"
+ "\\(%s?\\)/?" ; what is the / doing here?
+ "\\([a-h]?[1-8]?\\)"
+ "\\([x-]?\\)"
"\\([a-h][1-8]\\)"
"\\(=\\(%s\\)\\)?"
"\\)"
"A regular expression that matches all possible algebraic moves.
This regexp handles both long and short form.")
-(defun chess-algebraic-to-ply (position move)
+(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'")
+ (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 move)
- (let* ((color (chess-pos-side-to-move position))
- (mate (match-string 10 move))
- (piece (aref move 0))
- (changes
- (if (eq piece ?O)
- (let ((rank (if color 7 0))
- (long (= (length (match-string 1 move)) 5)))
- (list (chess-rf-to-index rank 4)
- (chess-rf-to-index rank (if long 2 6))
- (chess-rf-to-index rank (if long 0 7))
- (chess-rf-to-index rank (if long 3 5))))
- (let ((source (match-string 4 move))
- (target (chess-coord-to-index (match-string 7 move))))
- (if (and source (= (length source) 2))
- (list (chess-coord-to-index source) target)
- (let (candidates which)
- (unless (< piece ?a)
- (setq piece ?P))
- ;; we must use our knowledge of how pieces can
- ;; move, to determine which piece is meant by the
- ;; piece indicator
- (when (setq candidates
- (funcall (car chess-modules) nil nil
- 'search position target
- (if color piece
- (downcase piece))))
- (if (= (length candidates) 1)
- (list (car candidates) target)
- (if (null source)
- (error "Clarify piece to move by rank or file")
- (while candidates
- (if (if (>= source ?a)
- (eq (cdar candidates) (- source ?a))
- (eq (caar candidates) (- 7 (- source ?1))))
- (setq which (car candidates) candidates nil)
- (setq candidates (cdr candidates))))
- (if (null which)
- (error "Could not determine which piece to use")
- (list which target)))))))))))
- (if mate
- (nconc changes
- (list (if (equal mate "#")
- ':checkmate
- ':check))))
- (apply 'chess-ply-create position 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 (null (car (chess-ply-changes ply)))
- ""
- (let* ((pos (chess-ply-pos ply))
- (changes (chess-ply-changes ply))
- (from (car changes))
- (to (cadr changes))
- (from-piece (chess-pos-piece pos from))
- (color (chess-pos-side-to-move pos)) str
- (notation
- (if (setq str
- (and (= (upcase from-piece) ?K)
- (= from (chess-rf-to-index (if color 7 0) 4))
- (if (= to (chess-rf-to-index (if color 7 0) 6))
- "O-O"
- (if (= to (chess-rf-to-index (if color 7 0) 2))
- "O-O-O"))))
- str
- (let ((candidates
- (funcall (car chess-modules)
- nil nil 'search pos to from-piece))
- (rank 0) (file 0)
- (from-rank (/ from 8))
- (from-file (mod from 8))
- differentiator notation)
- (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 (error "Could not differentiate piece"))))
- (concat
- (unless (= (upcase from-piece) ?P)
- (char-to-string (upcase from-piece)))
- (if long
- (chess-index-to-coord from)
- (if differentiator
- (char-to-string differentiator)
- (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 (/= ? (chess-pos-piece pos to))
- "x" (if long "-"))
- (chess-index-to-coord to)
- (let ((promote (memq ':promote changes)))
- (if promote
- (concat "=" (char-to-string (cadr promote))))))))))
- (concat notation
- (if (memq ':check changes) "+"
- (if (memq ':checkmate changes) "#"))))))
+ (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)