blob: 678f5c37a72cc6a9f20a55f9e5c2e33a45fc1b91 (
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Obtain movements and other information from a subprocess
;;
;; $Revision$
;;; Commentary:
(require 'chess-session)
(require 'chess-game)
(defgroup chess-engine nil
"Code for reading movements and other commands from a subprocess."
:group 'chess)
(defvar chess-engine-regexp-alist nil)
(defvar chess-engine-event-handler nil)
(defvar chess-engine-response-handler nil)
(defvar chess-engine-session nil)
(defvar chess-engine-position nil)
(defvar chess-engine-game nil)
(defvar chess-engine-search-function 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-session)
(make-variable-buffer-local 'chess-engine-position)
(make-variable-buffer-local 'chess-engine-game)
(make-variable-buffer-local 'chess-engine-search-function)
(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-default-handler (event &rest args)
(cond
((eq event 'move)
(cond
((chess-engine-session nil)
(apply 'chess-session-event (chess-engine-session nil) event args))
((chess-engine-game nil)
(chess-game-move (chess-engine-game nil) (car args)))
(t
(apply 'chess-pos-move (chess-ply-pos (car args))
(chess-ply-changes (car args))))))))
(defun chess-engine-create (module &optional user-handler session search-func)
(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 (funcall handler 'initialize)))
(unless (and proc (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))
(chess-engine-set-game nil (chess-game-create nil search-func))
(current-buffer))))
(defun chess-engine-destroy (engine)
(let ((buf (or display (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)))
(defun chess-engine-search-function (engine)
(chess-with-current-buffer engine
chess-engine-search-function))
(defun chess-engine-set-search-function (engine search-func)
(chess-with-current-buffer engine
(if chess-engine-game
(chess-game-search-function chess-engine-game)
(or chess-engine-search-function
'chess-standard-search-position))))
(defun chess-engine-session (engine)
(chess-with-current-buffer engine
chess-engine-session))
(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
(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
(setq chess-engine-game game
chess-engine-position nil)
(chess-engine-command nil 'setup (chess-game-pos game))))
(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
(cond
(chess-engine-game
(chess-game-move chess-engine-game ply))
(chess-engine-position
(apply 'chess-pos-move ply)))
(chess-engine-command engine 'move ply)))
(defun chess-engine-pass (engine ply)
(chess-with-current-buffer engine
(chess-engine-command engine 'pass)))
(defun chess-engine-send (engine string)
(chess-with-current-buffer engine
(process-send-string (get-buffer-process (current-buffer)) string)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Module method
;;
;;;###autoload
(defun chess-engine (session buffer event &rest args)
"Handle any commands being sent to this instance of this module."
(if (eq event 'initialize)
(chess-engine-create (car args) 'chess-engine-session-callback session)
(ignore
(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)
"Process filter for receiving text from a chess process."
(let ((buf (process-buffer proc)))
(when (buffer-live-p buf)
(with-current-buffer buf
(let ((moving (= (point) (process-mark proc))))
(save-excursion
;; Insert the text, advancing the process marker.
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point)))
(if moving (goto-char (process-mark proc))))
(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
|
