code.delx.au - gnu-emacs-elpa/blob - chess-fen.el

   1 ;;; chess-fen.el --- Convert a chess position to/from FEN notation
   2
   3 ;; Copyright (C) 2002, 2004, 2014  Free Software Foundation, Inc.
   4
   5 ;; Author: John Wiegley <johnw@gnu.org>
   6 ;; Maintainer: Mario Lang <mlang@delysid.org>
   7 ;; Keywords: games
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; FEN notation encodes a chess position using a simple string.  The
  25 ;; format is:
  26 ;;
  27 ;;   POSITION SIDE CASTLING EN-PASSANT
  28 ;;
  29 ;; The POSITION gives all eight ranks, by specifying a letter for each
  30 ;; piece on the position, and a number for any intervening spaces.
  31 ;; Trailing spaces need not be counted.  Uppercase letters signify
  32 ;; white, and lowercase black.  For example, if your position only had
  33 ;; a black king on d8, your POSITION string would be:
  34 ;;
  35 ;;   3k////////
  36 ;;
  37 ;; For the three spaces (a, b and c file), the black king, and then
  38 ;; all the remaining ranks (which are all empty, so their spaces can
  39 ;; be ignored).
  40 ;;
  41 ;; The SIDE is w or b, to indicate whose move it is.
  42 ;;
  43 ;; CASTLING can contain K, Q, k or q, to signify whether the white or
  44 ;; black king can still castle on the king or queen side.  EN-PASSANT
  45 ;; signifies the target sqaure of an en passant capture, such as "e3" or "a6".
  46 ;;
  47 ;; The starting chess position always looks like this:
  48 ;;
  49 ;;   rnbqkbnr/pppppppp/////PPPPPPPP/RNBQKBNR/ w KQkq -
  50 ;;
  51 ;; And in "full" mode (where all spaces are accounted for):
  52 ;;
  53 ;;   rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq -
  54 ;;
  55 ;; It may also have the current game sequence appended, but this
  56 ;; relate to the game, not the position.
  57
  58 ;;; Code:
  59
  60 (require 'chess-pos)
  61 (eval-when-compile (require 'cl-lib))
  62
  63 (defconst chess-fen-regexp
  64   "^\\([bnrqkpBNRQKP1-8]*/?\\)+ [bw] \\(-\\|[KQkq]+\\) \\(-\\|[1-8]\\)")
  65
  66 (defun chess-fen-to-pos (fen)
  67   "Convert a FEN-like notation string to a chess position."
  68   (cl-check-type fen string)
  69   (let ((i 0) (l (length fen))
  70         (rank 0) (file 0) (c ?0)
  71         (position (chess-pos-create t))
  72         error (space-count 0))
  73     (setq c (aref fen i))
  74     (while (and (null error)
  75                 (/= c ? ) (< i l))
  76       (cond
  77        ((= c ?/)
  78         (setq file 0 rank (1+ rank)))
  79        ((and (>= c ?1) (<= c ?9))
  80         (setq file (+ file (- c ?0))))
  81        ((memq (upcase c) '(?K ?Q ?B ?N ?R ?P))
  82         (chess-pos-set-piece position (chess-rf-to-index rank file) c)
  83         (setq file (1+ file)))
  84        (t
  85         (setq error t)))
  86       (setq i (1+ i) c (aref fen i)))
  87     (if (= (aref fen i) ? )
  88         (setq i (1+ i)))
  89     (if (memq (aref fen i) '(?b ?w))
  90         (progn
  91           (chess-pos-set-side-to-move position (= (aref fen i) ?w))
  92           (setq i (+ i 2)))
  93       (setq error t))
  94     (setq c (aref fen i))
  95     (while (and (null error)
  96                 (< space-count 2) (< i l))
  97       (cond
  98        ((= c ?-))
  99        ((= c ? ) (setq space-count (1+ space-count)))
 100        ((= c ?K) (chess-pos-set-can-castle position ?K t))
 101        ((= c ?Q) (chess-pos-set-can-castle position ?Q t))
 102        ((= c ?k) (chess-pos-set-can-castle position ?k t))
 103        ((= c ?q) (chess-pos-set-can-castle position ?q t))
 104        ((and (>= c ?a) (<= c ?h))
 105         (chess-pos-set-en-passant
 106          position
 107          (let ((target (chess-coord-to-index (substring fen i (+ i 2)))))
 108            (chess-incr-index target (if (= (chess-index-rank target) 2)
 109                                         1 (if (= (chess-index-rank target) 5)
 110                                               -1 (setq error t) 0)) 0)))
 111         (setq i (1+ i)))
 112        (t
 113         (setq error t)))
 114       (setq i (1+ i) c (and (< i l) (aref fen i))))
 115     (unless error
 116       position)))
 117
 118 (defun chess-pos-to-fen (position &optional full)
 119   "Convert a chess POSITION to FEN-like notation.
 120 If FULL is non-nil, represent trailing spaces as well."
 121   (cl-check-type position chess-pos)
 122   (let ((blank 0) (str "") output)
 123     (dotimes (rank 8)
 124       (dotimes (file 8)
 125         (let ((p (chess-pos-piece position (chess-rf-to-index rank file))))
 126           (if (= p ? )
 127               (setq blank (1+ blank))
 128             (if (> blank 0)
 129                 (setq str (concat str (int-to-string blank)) blank 0))
 130             (setq str (concat str (char-to-string p))))))
 131       (if (and full (> blank 0))
 132           (setq str (concat str (int-to-string blank))))
 133       (if (< rank 7) (setq blank 0 str (concat str "/"))))
 134     (setq str (if (chess-pos-side-to-move position)
 135                   (concat str " w ")
 136                 (concat str " b ")))
 137     (mapc (lambda (castle)
 138             (if (chess-pos-can-castle position castle)
 139                 (setq str (concat str (string castle)) output t)))
 140           '(?K ?Q ?k ?q))
 141     (if output
 142         (setq str (concat str " "))
 143       (setq str (concat str "- ")))
 144     (let ((index (chess-pos-en-passant position)))
 145       (if (and index
 146                (let ((pawn (if (chess-pos-side-to-move position) ?P ?p)))
 147                  (or (and (chess-incr-index index 0 -1)
 148                           (eq (chess-pos-piece position (chess-incr-index
 149                                                          index 0 -1)) pawn))
 150                      (and (chess-incr-index index 0 1)
 151                           (eq (chess-pos-piece position (chess-incr-index
 152                                                          index 0 1)) pawn)))))
 153           (concat str (chess-index-to-coord
 154                        (if (chess-pos-side-to-move position)
 155                            (chess-incr-index index -1 0)
 156                          (chess-incr-index index 1 0))))
 157         (concat str "-")))))
 158
 159 (provide 'chess-fen)
 160
 161 ;;; chess-fen.el ends here