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

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;
   3 ;; Convert a chess position to/from FEN notation
   4 ;;
   5 ;; FEN notation encodes a chess position using a simple string.  The
   6 ;; format is:
   7 ;;
   8 ;;   POSITION SIDE CASTLING EN-PASSANT
   9 ;;
  10 ;; The POSITION gives all eight ranks, by specifying a letter for each
  11 ;; piece on the position, and a number for any intervening spaces.
  12 ;; Trailing spaces need not be counted.  Uppercase letters signify
  13 ;; white, and lowercase black.  For example, if your position only had
  14 ;; a black king on d8, your POSITION string would be:
  15 ;;
  16 ;;   3k////////
  17 ;;
  18 ;; For the three spaces (a, b and c file), the black king, and then
  19 ;; all the remaining ranks (which are all empty, so their spaces can
  20 ;; be ignored).
  21 ;;
  22 ;; The SIDE is w or b, to indicate whose move it is.
  23 ;;
  24 ;; CASTLING can contain K, Q, k or q, to signify whether the white or
  25 ;; black king can still castle on the king or queen side.  EN-PASSANT
  26 ;; signifies the target sqaure of an en passant capture, such as "e3" or "a6".
  27 ;;
  28 ;; The starting chess position always looks like this:
  29 ;;
  30 ;;   rnbqkbnr/pppppppp/////PPPPPPPP/RNBQKBNR/ w KQkq -
  31 ;;
  32 ;; And in "full" mode (where all spaces are accounted for):
  33 ;;
  34 ;;   rnbqkbnr/pppppppp/8/8/8/8/PPPPPPPP/RNBQKBNR w KQkq -
  35 ;;
  36 ;; It may also have the current game sequence appended, but this
  37 ;; relate to the game, not the position.
  38 ;;
  39
  40 (defconst chess-fen-regexp
  41   "^\\([bnrqkpBNRQKP1-8]*/?\\)+ [bw] \\(-\\|[KQkq]+\\) \\(-\\|[1-8]\\)")
  42
  43 (defun chess-fen-to-pos (fen)
  44   "Convert a FEN-like notation string to a chess position."
  45   (assert (stringp fen))
  46   (let ((i 0) (l (length fen))
  47         (rank 0) (file 0) (c ?0)
  48         (position (chess-pos-create t))
  49         error (space-count 0))
  50     (setq c (aref fen i))
  51     (while (and (null error)
  52                 (/= c ? ) (< i l))
  53       (cond
  54        ((= c ?/)
  55         (setq file 0 rank (1+ rank)))
  56        ((and (>= c ?1) (<= c ?9))
  57         (setq file (+ file (- c ?0))))
  58        ((memq (upcase c) '(?K ?Q ?B ?N ?R ?P))
  59         (chess-pos-set-piece position (chess-rf-to-index rank file) c)
  60         (setq file (1+ file)))
  61        (t
  62         (setq error t)))
  63       (setq i (1+ i) c (aref fen i)))
  64     (if (= (aref fen i) ? )
  65         (setq i (1+ i)))
  66     (if (memq (aref fen i) '(?b ?w))
  67         (progn
  68           (chess-pos-set-side-to-move position (= (aref fen i) ?w))
  69           (setq i (+ i 2)))
  70       (setq error t))
  71     (setq c (aref fen i))
  72     (while (and (null error)
  73                 (< space-count 2) (< i l))
  74       (cond
  75        ((= c ?-))
  76        ((= c ? ) (setq space-count (1+ space-count)))
  77        ((= c ?K) (chess-pos-set-can-castle position ?K t))
  78        ((= c ?Q) (chess-pos-set-can-castle position ?Q t))
  79        ((= c ?k) (chess-pos-set-can-castle position ?k t))
  80        ((= c ?q) (chess-pos-set-can-castle position ?q t))
  81        ((and (>= c ?a) (<= c ?h))
  82         (chess-pos-set-en-passant
  83          position
  84          (let ((target (chess-coord-to-index (substring fen i (+ i 2)))))
  85            (chess-incr-index target (if (= (chess-index-rank target) 2)
  86                                         1 (if (= (chess-index-rank target) 5)
  87                                               -1 (setq error t) 0)) 0)))
  88         (setq i (1+ i)))
  89        (t
  90         (setq error t)))
  91       (setq i (1+ i) c (and (< i l) (aref fen i))))
  92     (unless error
  93       position)))
  94
  95 (defun chess-pos-to-fen (position &optional full)
  96   "Convert a chess POSITION to FEN-like notation.
  97 If FULL is non-nil, represent trailing spaces as well."
  98   (assert (vectorp position))
  99   (let ((blank 0) (str "") output)
 100     (dotimes (rank 8)
 101       (dotimes (file 8)
 102         (let ((p (chess-pos-piece position (chess-rf-to-index rank file))))
 103           (if (= p ? )
 104               (setq blank (1+ blank))
 105             (if (> blank 0)
 106                 (setq str (concat str (int-to-string blank)) blank 0))
 107             (setq str (concat str (char-to-string p))))))
 108       (if (and full (> blank 0))
 109           (setq str (concat str (int-to-string blank))))
 110       (if (< rank 7) (setq blank 0 str (concat str "/"))))
 111     (setq str (if (chess-pos-side-to-move position)
 112                   (concat str " w ")
 113                 (concat str " b ")))
 114     (mapc (lambda (castle)
 115             (if (chess-pos-can-castle position castle)
 116                 (setq str (concat str (string castle)) output t)))
 117           '(?K ?Q ?k ?q))
 118     (if output
 119         (setq str (concat str " "))
 120       (setq str (concat str "- ")))
 121     (let ((index (chess-pos-en-passant position)))
 122       (if (and index
 123                (let ((pawn (if (chess-pos-side-to-move position) ?P ?p)))
 124                  (or (and (chess-incr-index index 0 -1)
 125                           (eq (chess-pos-piece position (chess-incr-index
 126                                                          index 0 -1)) pawn))
 127                      (and (chess-incr-index index 0 1)
 128                           (eq (chess-pos-piece position (chess-incr-index
 129                                                          index 0 1)) pawn)))))
 130           (concat str (chess-index-to-coord
 131                        (if (chess-pos-side-to-move position)
 132                            (chess-incr-index index -1 0)
 133                          (chess-incr-index index 1 0))))
 134         (concat str "-")))))
 135
 136 (provide 'chess-fen)
 137
 138 ;;; chess-fen.el ends here