blob: 69eae891d06bc4ec0e9407a1b481e79c0849ea29 (
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
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; An engine for interacting with Internet Chess Servers
;;
;; $Revision$
(require 'chess-network)
(require 'ics)
(defgroup chess-ics nil
"Engine for interacting with Internet Chess Servers."
:group 'chess-engine)
(defvar chess-ics-ensure-ics12 nil)
(make-variable-buffer-local 'chess-ics-ensure-ics12)
;; ICS12 format:
;; <12> rnbqkbnr pppppppp -------- -------- -------- -------- PPPPPPPP RNBQKBNR W -1 1 1 1 1 0 65 jwiegley GuestZYNJ 1 5 0 39 39 300 300 1 none (0:00) none 0 0 0
(defun chess-ics-handle-move ()
(let ((begin (match-beginning 1))
(end (match-end 1))
(color (string= (match-string 2) "W"))
(white (match-string 3))
(move (match-string 4)))
(if (and (not (string= white ics-handle))
(= 0 (chess-game-index (chess-engine-game nil))))
(chess-game-run-hooks (chess-engine-game nil) 'pass)
(if (eq color (chess-pos-side-to-move
(chess-engine-position nil)))
(funcall chess-engine-response-handler
'move move))
(delete-region begin end))))
(defvar chess-ics-regexp-alist
(list
(cons (concat "\\(<12> \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ \\S-+ "
"\\([BW]\\) [-0-9]+ "
"[-0-9]+ [-0-9]+ [-0-9]+ [-0-9]+ [-0-9]+ "
"[-0-9]+ \\(\\S-+\\) \\S-+ "
"[-0-9]+ [-0-9]+ [-0-9]+ "
"[-0-9]+ [-0-9]+ [-0-9]+ [-0-9]+ "
"[-0-9]+ \\S-+ \\S-+ \\(\\S-+\\)\\)")
'chess-ics-handle-move)
(cons "You accept the match offer from \\([^\\.]+\\)."
(function
(lambda ()
(funcall chess-engine-response-handler 'connect
(match-string 1)))))))
(defun chess-ics-handler (event &rest args)
(cond
((eq event 'initialize)
(let* ((old-buffer (current-buffer))
(address-or-alias (read-from-minibuffer
"ICS Server address or alias: "))
(server-info-list (cdr (assoc address-or-alias
ics-servers-alist)))
(ics-address (or (car (cdr server-info-list))
address-or-alias))
(ics-connect-method (or (car (nthcdr 3 server-info-list))
ics-default-connect-method))
(server-name (or (car server-info-list)
address-or-alias))
(ics-port (or (car (nthcdr 2 server-info-list))
(read-from-minibuffer "ICS port: "
ics-default-port)))
(handle (read-from-minibuffer "ICS Handle: "
ics-default-handle))
(proc (concat server-name ":" handle))
(buffer (concat "*" proc "*")))
(setq ics-handle handle)
(if (comint-check-proc buffer)
(set-buffer buffer)
(run-hooks 'ics-pre-connect-hook)
(set-buffer (make-comint proc (cons ics-address ics-port)))
(run-hooks 'ics-post-connect-hook)
(ics-mode))
(set (make-variable-buffer-local 'ics-last-command-time)
(ics-current-time))
(set (make-variable-buffer-local 'ics-idle-p) nil)
(set (make-variable-buffer-local 'ics-interface-variable-set) nil)
(set (make-variable-buffer-local 'ics-wakeup-last-alarm-time)
(ics-current-time))
(set (make-variable-buffer-local 'ics-last-highlight-end) nil)
(set (make-variable-buffer-local 'ics-last-add-buttons-end) nil)
(add-hook 'comint-output-filter-functions 'chess-ics-filter t t)
(set (make-local-variable 'comint-preoutput-filter-functions)
'(chess-ics-strip-cr))
(display-buffer buffer)
(kill-buffer old-buffer)
nil))
((eq event 'shutdown)
(ignore-errors
(chess-engine-send nil "quit\n")))
((eq event 'move)
(unless chess-ics-ensure-ics12
(comint-send-string (get-buffer-process (current-buffer))
"set style 12\n")
(setq chess-ics-ensure-ics12 t))
(chess-engine-send nil (concat (chess-ply-to-algebraic (car args))
"\n")))
((eq event 'send)
(comint-send-string (get-buffer-process (current-buffer)) (car args)))))
(defun chess-ics-filter (string)
(save-excursion
(if chess-engine-last-pos
(goto-char chess-engine-last-pos)
(goto-char (point-min)))
(beginning-of-line)
(while (not (eobp))
(let ((triggers chess-ics-regexp-alist))
(while triggers
;; this could be accelerated by joining together the
;; regexps
(if (looking-at (concat "[^\n\r]*" (caar triggers)))
(progn
(funcall (cdar triggers))
(setq triggers nil))
(setq triggers (cdr triggers)))))
(forward-line))
(setq chess-engine-last-pos (point))))
(defun chess-ics-strip-cr (string)
(while (string-match "\r" string)
(setq string (replace-match "" t t string)))
string)
(provide 'chess-ics)
;;; chess-ics.el ends here
|
