blob: be1d3abf9ac8e422a4c3f6610b4b27fc01d53cda (
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
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Obtain movements and other information from an engine
;;
;; $Revision$
;;; Commentary:
(require 'chess-game)
(defgroup chess-engine nil
"Code for reading movements and other commands from an engine."
:group 'chess)
(defvar chess-engine-regexp-alist nil)
(defvar chess-engine-event-handler nil)
(defvar chess-engine-response-handler nil)
(defvar chess-engine-internal-object nil)
(defvar chess-engine-current-marker nil)
(defvar chess-engine-position nil)
(defvar chess-engine-game nil)
(make-variable-buffer-local 'chess-engine-regexp-alist)
(make-variable-buffer-local 'chess-engine-event-handler)
(make-variable-buffer-local 'chess-engine-response-handler)
(make-variable-buffer-local 'chess-engine-internal-object)
(make-variable-buffer-local 'chess-engine-current-marker)
(make-variable-buffer-local 'chess-engine-position)
(make-variable-buffer-local 'chess-engine-game)
(defvar chess-engine-last-pos nil)
(defvar chess-engine-working nil)
(make-variable-buffer-local 'chess-engine-last-pos)
(make-variable-buffer-local 'chess-engine-working)
;;; Code:
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; User interface
;;
(defmacro chess-with-current-buffer (buffer &rest body)
`(let ((buf ,buffer))
(if buf
(with-current-buffer buf
,@body)
,@body)))
(defun chess-engine-do-move (ply)
(cond
(chess-engine-game
(chess-game-move chess-engine-game ply))
(chess-engine-position
(setq chess-engine-position (chess-ply-next-pos ply)))))
(defun chess-engine-default-handler (event &rest args)
(cond
((eq event 'move)
(chess-engine-do-move (car args)))))
(defun chess-engine-create (module &optional user-handler)
(let ((regexp-alist (intern-soft (concat (symbol-name module)
"-regexp-alist")))
(handler (intern-soft (concat (symbol-name module) "-handler"))))
(with-current-buffer (generate-new-buffer " *chess-engine*")
(setq chess-engine-regexp-alist (symbol-value regexp-alist)
chess-engine-event-handler handler
chess-engine-response-handler (or 'chess-engine-default-handler
user-handler))
(let ((object (funcall handler 'initialize)))
(when (processp object)
(unless (memq (process-status object) '(run open))
(error "Failed to start chess engine process"))
(set-process-buffer object (current-buffer))
(set-process-filter object 'chess-engine-filter))
(setq chess-engine-current-marker (point-marker)
chess-engine-internal-object object))
(current-buffer))))
(defun chess-engine-destroy (engine)
(let ((buf (or engine (current-buffer))))
(if (buffer-live-p buf)
(kill-buffer buf))))
(defun chess-engine-command (engine event &rest args)
(chess-with-current-buffer engine
(apply chess-engine-event-handler event args)))
;; 'ponder
;; 'search-depth
;; 'wall-clock
(defun chess-engine-set-option (engine option value)
(chess-with-current-buffer engine
))
(defun chess-engine-option (engine option) 'ponder 'search-depth 'wall-clock
(chess-with-current-buffer engine
))
(defun chess-engine-set-position (engine position)
(chess-with-current-buffer engine
(if chess-engine-game
(chess-engine-detach-game nil))
(setq chess-engine-game nil
chess-engine-position position)
(chess-engine-command nil 'setup position)))
(defun chess-engine-position (engine)
(chess-with-current-buffer engine
(or (and chess-engine-game
(chess-game-pos chess-engine-game))
chess-engine-position)))
(defun chess-engine-set-game (engine game)
(chess-with-current-buffer engine
(if chess-engine-game
(chess-engine-detach-game nil))
(setq chess-engine-game game
chess-engine-position nil)
(chess-game-add-hook game 'chess-engine-event-handler engine)
(chess-engine-command nil 'setup (chess-game-pos game))))
(defun chess-engine-detach-game (engine)
(chess-with-current-buffer engine
(if chess-engine-game
(chess-game-remove-hook chess-engine-game
'chess-engine-event-handler))))
(defun chess-engine-game (engine)
(chess-with-current-buffer engine
chess-engine-game))
(defun chess-engine-index (engine)
(chess-with-current-buffer engine
(if chess-engine-game
(chess-game-index chess-engine-game))))
(defun chess-engine-move (engine ply)
(chess-with-current-buffer engine
(chess-engine-do-move ply)
(chess-engine-command engine 'move ply)))
(defun chess-engine-pass (engine)
(chess-with-current-buffer engine
(chess-engine-command engine 'pass)))
(defun chess-engine-send (engine string)
"Send the given STRING to ENGINE."
(chess-with-current-buffer engine
(let ((object chess-engine-internal-object))
(if (and (processp object))
(if (memq (process-status object) '(run open))
(process-send-string object string)
(error "The engine you were using is no longer running"))
(chess-engine-command nil 'send string)))))
(defun chess-engine-submit (engine string)
"Submit the given STRING, so ENGINE sees it in its input stream."
(chess-with-current-buffer engine
(let ((object chess-engine-internal-object))
(if (and (processp object)
(not (memq (process-status object) '(run open))))
(error "The engine you were using is no longer running"))
(chess-engine-filter object string))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Primary event handler
;;
(defun chess-engine-event-handler (game engine event &rest args)
"Handle any commands being sent to this instance of this module."
(with-current-buffer engine
(assert (eq game (chess-engine-game nil)))
(apply chess-engine-event-handler event args)
(cond
((eq event 'shutdown)
(chess-engine-destroy engine))
((eq event 'setup)
(chess-engine-set-game engine (car args)))
((eq event 'pass)
(chess-engine-pass engine)))))
(defun chess-engine-filter (object string)
"Filter for receiving text for an engine from an outside source."
(let ((buf (if (processp object)
(process-buffer object)
(current-buffer))))
(when (buffer-live-p buf)
(with-current-buffer buf
(let ((moving (= (point) chess-engine-current-marker)))
(save-excursion
;; Insert the text, advancing the marker.
(goto-char chess-engine-current-marker)
(insert string)
(set-marker chess-engine-current-marker (point)))
(if moving (goto-char chess-engine-current-marker)))
(unless chess-engine-working
(setq chess-engine-working t)
(unwind-protect
(progn
(if chess-engine-last-pos
(goto-char chess-engine-last-pos)
(goto-char (point-min)))
(beginning-of-line)
(while (not (eobp))
(condition-case err
(let ((triggers chess-engine-regexp-alist))
(while triggers
;; this could be accelerated by joining
;; together the regexps
(if (looking-at (caar triggers))
(funcall (cdar triggers)))
(setq triggers (cdr triggers))))
(chess-illegal (error-message-string err)))
(forward-line)))
(setq chess-engine-last-pos (point)
chess-engine-working nil)))))))
(provide 'chess-engine)
;;; chess-engine.el ends here
|
