diff options
Diffstat (limited to 'chess-ics.el')
| -rw-r--r-- | chess-ics.el | 126 |
1 files changed, 62 insertions, 64 deletions
diff --git a/chess-ics.el b/chess-ics.el index 6b93559..908d42a 100644 --- a/chess-ics.el +++ b/chess-ics.el @@ -11,6 +11,21 @@ "Engine for interacting with Internet Chess Servers." :group 'chess-engine) +(defcustom chess-ics-server "freechess.org" + "The default ICS server to connect to." + :type 'string + :group 'chess-ics) + +(defcustom chess-ics-port 5000 + "The port to use when connecting to `chess-ics-server'." + :type 'integer + :group 'chess-ics) + +(defcustom chess-ics-handle "jwiegley" + "The default handle used when logging into `chess-ics-server'." + :type 'string + :group 'chess-ics) + (defvar chess-ics-ensure-ics12 nil) (make-variable-buffer-local 'chess-ics-ensure-ics12) @@ -29,7 +44,7 @@ who is black." (position (chess-pos-create t)) white black ply) - (assert (= (length parts) 31)) + (assert (= (length parts) 32)) ;; first, handle the layout of the position (dotimes (i 8) @@ -90,15 +105,14 @@ who is black." (setq parts (cdr parts)) ;; move in elaborated notation - (setq ply (if (string= (car parts) "none") - (chess-ply-create position) - (chess-algebraic-to-ply position (substring (car parts) 2)))) (setq parts (cdr parts)) ;; time elapsed (setq parts (cdr parts)) ;; move in algebraic notation + (setq move (unless (string= (car parts) "none") + (car parts))) (setq parts (cdr parts)) ;; unknown @@ -106,25 +120,39 @@ who is black." (setq parts (cdr parts)) (setq parts (cdr parts)) - (list ply white black))) + (list position move white black))) (defun chess-ics-handle-move () - (let ((begin (match-beginning 1)) + (let ((chess-engine-handling-event t) + (begin (match-beginning 1)) (end (match-end 1)) - (info (chess-ics12-parse (match-string 2))) + (info (chess-ics12-parse (match-string 3))) (game (chess-engine-game nil))) (assert game) - (if (> (chess-game-index game) 0) - (if (eq (chess-pos-side-to-move (chess-ply-pos (car info))) - (chess-pos-side-to-move (chess-engine-position nil))) - (chess-engine-do-move (car info))) - (chess-engine-set-start-position nil (chess-ply-pos (car info)) - (string= (cadr info) ics-handle))) - (delete-region begin end) + (unwind-protect + (if (and (chess-game-data game 'active) + (> (chess-game-index game) 0)) + (if (and (cadr info) + (eq (chess-pos-side-to-move (car info)) + (chess-game-data game 'my-color))) + (let ((last-ply (last (chess-game-plies game)))) + (setcar last-ply + (chess-algebraic-to-ply (chess-ply-pos (car last-ply)) + (cadr info) t)) + (chess-game-add-ply game (chess-ply-create (car info))) + (chess-game-run-hooks game 'update))) + (let ((chess-game-inhibit-events t) plies) + (chess-game-set-data game 'my-color (string= (nth 2 info) + chess-ics-handle)) + (chess-game-set-data game 'active t) + (chess-game-set-start-position game (car info))) + (chess-game-run-hooks game 'orient)) + (delete-region begin end)) t)) (defvar chess-ics-regexp-alist - (list (cons "\\(<12> \\(.+\\)\\)" 'chess-ics-handle-move) + (list (cons "\\(\\(\n*fics%\n*\\)?<12> \\(.+\\)\\)\n" + 'chess-ics-handle-move) (cons "Challenge: \\(\\S-+\\) \\S-+ \\S-+ \\S-+ .+" (function (lambda () @@ -134,50 +162,20 @@ who is black." (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) + (kill-buffer (current-buffer)) + (message "Connecting to Internet Chess Server '%s'..." chess-ics-server) - (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) - (set (make-local-variable 'comint-preoutput-filter-functions) - '(chess-ics-strip-cr)) + (let ((buf (make-comint "chess-ics" + (cons chess-ics-server chess-ics-port)))) + (message "Connecting to Internet Chess Server '%s'...done" + chess-ics-server) - (display-buffer buffer) - (kill-buffer old-buffer) + (display-buffer buf) + (set-buffer buf) + (add-hook 'comint-output-filter-functions 'chess-ics-filter t t) + (set (make-local-variable 'comint-preoutput-filter-functions) + '(chess-ics-strip)) nil)) ((eq event 'match) @@ -187,12 +185,12 @@ who is black." ((eq event 'move) (unless chess-ics-ensure-ics12 - (comint-send-string (get-buffer-process (current-buffer)) - "set style 12\n") + (chess-engine-send nil "set style 12\n") (setq chess-ics-ensure-ics12 t)) (chess-network-handler 'move (car args))) ((eq event 'send) + (message "sending string: %s" (car args)) (comint-send-string (get-buffer-process (current-buffer)) (car args))) @@ -204,12 +202,12 @@ who is black." (if chess-engine-last-pos (goto-char chess-engine-last-pos) (goto-char (point-min))) - (beginning-of-line) - (while (not (eobp)) + (while (and (not (eobp)) + (/= (line-end-position) (point-max))) (let ((triggers chess-ics-regexp-alist)) (while triggers - ;; this could be accelerated by joining together the - ;; regexps + ;; this could be accelerated by joining + ;; together the regexps (if (and (looking-at (concat "[^\n\r]*" (caar triggers))) (funcall (cdar triggers))) (setq triggers nil) @@ -217,8 +215,8 @@ who is black." (forward-line)) (setq chess-engine-last-pos (point)))) -(defun chess-ics-strip-cr (string) - (while (string-match "\r" string) +(defun chess-ics-strip (string) + (while (string-match "[\r\a]" string) (setq string (replace-match "" t t string))) string) |