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?\\(\\([a-h]\\|[1-8]\\)?\\|[a-h][1-8]\\)\\)?"
  44                     "\\([x-]\\)?"
  45                     "\\([a-h][1-8]\\)"
  46                     "\\(=\\(%s\\)\\)?"
  47                   "\\)"
  48                   "\\([#+]\\)?")
  49           chess-algebraic-pieces-regexp
  50           chess-algebraic-pieces-regexp)
  51   "A regular expression that matches all possible algebraic moves.
  52 This regexp handles both long and short form.")
  53
  54 (defun chess-algebraic-to-ply (position move)
  55   "Convert the algebraic notation MOVE for POSITION to a ply."
  56   (unless (string-match chess-algebraic-regexp move)
  57     (error "Cannot parse non-algebraic move notation: %s" move))
  58   (let* ((color (chess-pos-side-to-move position))
  59          (mate (match-string 10 move))
  60          (piece (aref move 0))
  61          (changes
  62           (if (eq piece ?O)
  63               (let ((rank (if color 7 0))
  64                     (long (= (length (match-string 1 move)) 5)))
  65                 (list (chess-rf-to-index rank 4)
  66                       (chess-rf-to-index rank (if long 2 6))))
  67             (let ((source (match-string 4 move))
  68                   (target (chess-coord-to-index (match-string 7 move))))
  69               (if (and source (= (length source) 2))
  70                   (list (chess-coord-to-index source) target)
  71                 (if (= (length source) 0)
  72                     (setq source nil)
  73                   (setq source (aref source 0)))
  74                 (let (candidates which)
  75                   (unless (< piece ?a)
  76                     (setq piece ?P))
  77                   ;; we must use our knowledge of how pieces can
  78                   ;; move, to determine which piece is meant by the
  79                   ;; piece indicator
  80                   (when (setq candidates
  81                               (chess-search-position position target
  82                                                      (if color piece
  83                                                        (downcase piece))))
  84                     (if (= (length candidates) 1)
  85                         (list (car candidates) target)
  86                       (if (null source)
  87                           (error "Clarify piece to move by rank or file")
  88                         (while candidates
  89                           (if (if (>= source ?a)
  90                                   (eq (chess-index-file (car candidates))
  91                                       (- source ?a))
  92                                 (eq (chess-index-rank (car candidates))
  93                                     (- 7 (- source ?1))))
  94                               (setq which (car candidates) candidates nil)
  95                             (setq candidates (cdr candidates))))
  96                         (if (null which)
  97                             (error "Could not determine which piece to use")
  98                           (list which target)))))))))))
  99     (if mate
 100         (nconc changes
 101                (list (if (equal mate "#")
 102                          :checkmate
 103                        :check))))
 104     (and changes (apply 'chess-ply-create position changes))))
 105
 106 (defun chess-ply-to-algebraic (ply &optional long)
 107   "Convert the given PLY to algebraic notation.
 108 If LONG is non-nil, render the move into long notation."
 109   (if (null (car (chess-ply-changes ply)))
 110       ""
 111     (let* ((pos (chess-ply-pos ply))
 112            (changes (chess-ply-changes ply))
 113            (from (car changes))
 114            (to (cadr changes))
 115            (from-piece (chess-pos-piece pos from))
 116            (color (chess-pos-side-to-move pos)) str
 117            (notation
 118             (if (setq str
 119                       (if (memq :castle changes) "O-O"
 120                         (if (memq :long-castle changes) "O-O-O")))
 121                 str
 122               (let ((candidates (chess-search-position pos to from-piece))
 123                     (rank 0) (file 0)
 124                     (from-rank (/ from 8))
 125                     (from-file (mod from 8))
 126                     differentiator notation)
 127                 (when (> (length candidates) 1)
 128                   (dolist (candidate candidates)
 129                     (if (= (/ candidate 8) from-rank)
 130                         (setq rank (1+ rank)))
 131                     (if (= (mod candidate 8) from-file)
 132                         (setq file (1+ file))))
 133                   (cond
 134                    ((= file 1)
 135                     (setq differentiator (+ from-file ?a)))
 136                    ((= rank 1)
 137                     (setq differentiator (+ (- 7 from-rank) ?1)))
 138                    (t (error "Could not differentiate piece"))))
 139                 (concat
 140                  (unless (= (upcase from-piece) ?P)
 141                    (char-to-string (upcase from-piece)))
 142                  (if long
 143                      (chess-index-to-coord from)
 144                    (if differentiator
 145                        (char-to-string differentiator)
 146                      (if (and (not long) (= (upcase from-piece) ?P)
 147                               (/= (chess-index-file from)
 148                                   (chess-index-file to)))
 149                          (char-to-string (+ (chess-index-file from) ?a)))))
 150                  (if (/= ?  (chess-pos-piece pos to))
 151                      "x" (if long "-"))
 152                  (chess-index-to-coord to)
 153                  (let ((promote (memq :promote changes)))
 154                    (if promote
 155                        (concat "=" (char-to-string (cadr promote))))))))))
 156       (concat notation
 157               (if (memq :check changes) "+"
 158                 (if (memq :checkmate changes) "#"))))))
 159
 160 (provide 'chess-algebraic)
 161
 162 ;;; chess-algebraic.el ends here