blob: 23fedfda2f2e1feb1450a7ce306e79fc9379a368 (
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Obtain movements and other information from a subprocess
;;
;; $Revision$
;;; Commentary:
(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-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-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 ((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)
(set-marker (process-mark proc) (point)))
(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)
(chess-with-current-buffer engine
(let ((proc (get-buffer-process (current-buffer))))
(if (and proc (memq (process-status proc) '(run open)))
(process-send-string proc string)
(error "The engine you're using is no longer running")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; 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)
"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
|
