blob: 99796a5daf9f1eec59eba454b44c2b4b2257e37a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
|
;;; chess-uci.el --- Common functions for the Universal Chess Interface protocol
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; Author: Mario Lang <mlang@delysid.org>
;; Keywords: games, processes
;; 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:
;; Common functions for engines based on the Universal Chess Interface.
;; See <http://en.wikipedia.org/wiki/Universal_Chess_Interface>.
;;; Code:
(eval-when-compile (require 'cl-lib))
(require 'chess-common)
(require 'chess-polyglot)
(defgroup chess-uci nil
"Customisations for Chess engines based on the UCI protocol"
:group 'chess)
(defvar chess-uci-long-algebraic-regexp "\\([a-h][1-8]\\)\\([a-h][1-8]\\)\\([nbrq]\\)?"
"A regular expression matching a UCI log algebraic move.")
(defun chess-uci-long-algebraic-to-ply (position move)
"Convert the long algebraic notation MOVE for POSITION to a ply."
(cl-assert (vectorp position))
(cl-assert (stringp move))
(let ((case-fold-search nil))
(when (string-match chess-uci-long-algebraic-regexp move)
(let ((color (chess-pos-side-to-move position))
(from (chess-coord-to-index (match-string 1 move)))
(to (chess-coord-to-index (match-string 2 move)))
(promotion (match-string 3 move)))
(apply #'chess-ply-create position nil
(if (and (= from (chess-pos-king-index position color))
(= (chess-index-rank from) (chess-index-rank to))
(> (abs (- (chess-index-file from)
(chess-index-file to))) 1))
(chess-ply-castling-changes
position
(< (- (chess-index-file to) (chess-index-file from)) 0))
(nconc (list from to)
(when promotion
(list :promote (upcase (aref promotion 0)))))))))))
(defsubst chess-uci-convert-long-algebraic (move)
"Convert long algebraic MOVE to a ply in reference to the engine position.
If conversion fails, this function fired an 'illegal event."
(or (chess-uci-long-algebraic-to-ply (chess-engine-position nil) move)
(chess-engine-command nil 'illegal)))
(defvar chess-uci-regexp-alist
(list
(cons "^id\\s-+name\\s-+\\(.+\\)$"
(function
(lambda ()
(setq-local chess-engine-opponent-name (match-string 1))
'once)))
(cons (concat "^bestmove\\s-+\\(" chess-uci-long-algebraic-regexp "\\)")
(function
(lambda ()
(funcall chess-engine-response-handler 'move
(chess-uci-convert-long-algebraic (match-string 1)))))))
"Patterns matching responses of a standard UCI chess engine.")
(defun chess-uci-position (game)
"Convert the current GAME position to a UCI position command string."
(concat "position fen " (chess-pos-to-fen (chess-game-pos game 0) t)
" moves " (mapconcat (lambda (ply)
(let ((source (chess-ply-source ply))
(target (chess-ply-target ply)))
(if (and source target)
(concat (chess-index-to-coord source)
(chess-index-to-coord target)
(if (chess-ply-keyword ply :promote)
(string (downcase (chess-ply-keyword ply :promote)))
""))
"")))
(chess-game-plies game) " ")
"\n"))
(defun chess-uci-handler (game event &rest args)
"Default handler for UCI based engines."
(unless chess-engine-handling-event
(cond
((eq event 'initialize)
(when (and chess-polyglot-book-file
(file-exists-p chess-polyglot-book-file))
(unless chess-polyglot-book
(setq chess-polyglot-book (chess-polyglot-book-open
chess-polyglot-book-file))))
(apply #'chess-common-handler game event args))
((eq event 'new)
(chess-engine-send nil "ucinewgame\n")
(chess-engine-set-position nil))
((eq event 'resign)
(chess-game-set-data game 'active nil))
((eq event 'move)
(when (= 1 (chess-game-index game))
(chess-game-set-tag game "White" chess-full-name)
(chess-game-set-tag game "Black" chess-engine-opponent-name))
(if (chess-game-over-p game)
(chess-game-set-data game 'active nil)))
((eq event 'post-move)
(let ((book-ply (and chess-polyglot-book (bufferp chess-polyglot-book)
(buffer-live-p chess-polyglot-book)
(chess-polyglot-book-ply
chess-polyglot-book
(chess-game-pos game)))))
(if book-ply
(let ((chess-display-handling-event nil))
(funcall chess-engine-response-handler 'move book-ply))
(chess-engine-send nil (concat (chess-uci-position game) "go\n")))))
(t
(apply 'chess-common-handler game event args)))))
(provide 'chess-uci)
;;; chess-uci.el ends here
|
