blob: 125bccb53e06e98af879d9394a9181d1e7a7cb1b (
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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-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-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 &rest args)
(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 ((proc (apply handler 'initialize args)))
(when (processp proc)
(unless (memq (process-status proc) '(run open))
(error "Failed to start chess engine process"))
(set-process-buffer proc (current-buffer))
(set-process-filter proc 'chess-engine-filter))
(setq chess-engine-current-marker (point-marker)))
(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 ((proc (get-buffer-process (current-buffer))))
(if proc
(if (memq (process-status proc) '(run open))
(process-send-string proc 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 ((proc (get-buffer-process (current-buffer))))
(if (and (processp proc)
(not (memq (process-status proc) '(run open))))
(error "The engine you were using is no longer running"))
(chess-engine-filter nil 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 (proc string)
"Filter for receiving text for an engine from an outside source."
(let ((buf (if (processp proc)
(process-buffer proc)
(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
|
