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