[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] 133/255: igs using a process filter for asynch processing
From: |
Eric Schulte |
Subject: |
[elpa] 133/255: igs using a process filter for asynch processing |
Date: |
Sun, 16 Mar 2014 01:02:34 +0000 |
eschulte pushed a commit to branch go
in repository elpa.
commit 8904737272adfed7ff55bebb6030374226fec762
Author: Eric Schulte <address@hidden>
Date: Thu May 31 23:47:47 2012 -0600
igs using a process filter for asynch processing
---
back-ends/igs.el | 144 ++++++++++++++++++++++++++++++++----------------------
1 files changed, 85 insertions(+), 59 deletions(-)
diff --git a/back-ends/igs.el b/back-ends/igs.el
index f72b1ee..82fc349 100644
--- a/back-ends/igs.el
+++ b/back-ends/igs.el
@@ -91,34 +91,27 @@
(:version . 39) ;; IGS Version
(:yell . 32))) ;; Channel yelling
-(defvar igs-player-re
- "\\([[:alpha:][:digit:]]+\\) +\\[ *\\([[:digit:]]+[kd]\\*\\)\\]"
- "Regular expression used to parse igs player name and rating.")
-
-(defvar igs-game-re
- (format "\\[\\([[:digit:]]+\\)\\] +%s +vs. +%s +\\((.+)\\) \\((.+)\\)$"
- igs-player-re igs-player-re)
- "Regular expression used to parse igs game listings.")
-
(defvar *igs-ready* nil
"Indicates if the IGS server is waiting for input.")
(defvar *igs-games* nil
"List holding the current games on the IGS server.")
-(defun igs-toggle (setting value)
- (insert (format "toggle %s %s" setting (if value "true" "false")))
- (comint-send-input))
-
-(defun igs-filter-process (string)
- (unless (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string)
- (error "igs: malformed response %S" string))
- (let* ((number (match-string 1 string))
- (content (match-string 2 string)))
- (case (car (rassoc number igs-message-types))
- (:prompt (set *igs-ready* t))
- (:info (message "igs-info: %s" content))
- (:games (push (igs-parse-game-string content) *igs-games*)))))
+(defmacro igs-w-proc (proc &rest body)
+ (declare (indent 1))
+ `(with-current-buffer (process-buffer proc) ,@body))
+(def-edebug-spec igs-w-proc (form body))
+
+(defun igs-filter-process (proc string)
+ (when (string-match "^\\([[:digit:]]+\\) \\(.+\\)$" string)
+ (let* ((number (read (match-string 1 string)))
+ (type (car (rassoc number igs-message-types)))
+ (content (match-string 2 string)))
+ (case type
+ (:prompt (igs-w-proc proc (setq *igs-ready* t)))
+ (:info (message "igs-info: %s" content))
+ (:games (igs-w-proc proc (igs-handle-game content)))
+ (:move (igs-w-proc proc (igs-handle-move content)))))))
(defun igs-insertion-filter (proc string)
(with-current-buffer (process-buffer proc)
@@ -127,7 +120,8 @@
(goto-char (process-mark proc))
(insert string)
(set-marker (process-mark proc) (point))
- (igs-filter-process string))
+ (mapc (lambda (s) (igs-filter-process proc s))
+ (split-string string "[\n\r]")))
(when moving (goto-char (process-mark proc))))))
(defun igs-connect ()
@@ -135,7 +129,7 @@
(interactive)
(flet ((wait (prompt)
(while (and (goto-char (or comint-last-input-end (point-min)))
- (not (re-search-forward (prompt) nil t)))
+ (not (re-search-forward prompt nil t)))
(accept-process-output proc))))
(let ((buffer (apply 'make-comint
igs-process-name
@@ -155,23 +149,26 @@
(set-process-filter proc 'igs-insertion-filter)
buffer)))))
-(defun igs-last-output (igs)
- (with-current-buffer (buffer igs)
- (comint-show-output)
- (org-babel-clean-text-properties
- (buffer-substring (+ 2 (point)) (- (point-max) 2)))))
-
-(defun igs-command-to-string (igs command)
- "Send command to an igs connection and return the results as a string"
- (interactive "sigs command: ")
- (with-current-buffer (buffer igs)
- (goto-char (process-mark (get-buffer-process (current-buffer))))
- (insert command)
- (comint-send-input))
- (igs-wait-for-output igs)
- (igs-last-output igs))
-
-(defun igs-parse-game-string (game-string)
+(defun igs-toggle (setting value)
+ (insert (format "toggle %s %s" setting (if value "true" "false")))
+ (comint-send-input))
+
+(defun igs-observe (game)
+ (insert (format "observe %s" game))
+ (comint-send-input))
+
+
+;;; Specific handlers
+(defvar igs-player-re
+ "\\([[:alpha:][:digit:]]+\\) +\\[ *\\([[:digit:]]+[kd]\\*\\)\\]"
+ "Regular expression used to parse igs player name and rating.")
+
+(defvar igs-game-re
+ (format "\\[\\([[:digit:]]+\\)\\] +%s +vs. +%s +\\((.+)\\) \\((.+)\\)$"
+ igs-player-re igs-player-re)
+ "Regular expression used to parse igs game listings.")
+
+(defun igs-handle-game (game-string)
;; [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###)
(when (string-match igs-game-re game-string)
(let* ((num (match-string 1 game-string))
@@ -181,24 +178,53 @@
(black-rank (match-string 5 game-string))
(other1 (read (match-string 6 game-string)))
(other2 (read (match-string 7 game-string))))
- `((:number . ,(read num))
- (:white-name . ,white-name)
- (:white-rank . ,white-rank)
- (:black-name . ,black-name)
- (:black-rank . ,black-rank)
- (:move . ,(nth 0 other1))
- (:size . ,(nth 1 other1))
- (:h . ,(nth 2 other1))
- (:komi . ,(nth 3 other1))
- (:by . ,(nth 4 other1))
- (:fr . ,(nth 5 other1))
- (:other . ,(car other2))))))
-
-(defun igs-games (igs)
- (let ((games-str (igs-command-to-string igs "games")))
- (delete nil
- (mapcar #'igs-parse-game-string
- (cdr (split-string games-str "[\n\r]"))))))
+ (push `((:number . ,(read num))
+ (:white-name . ,white-name)
+ (:white-rank . ,white-rank)
+ (:black-name . ,black-name)
+ (:black-rank . ,black-rank)
+ (:move . ,(nth 0 other1))
+ (:size . ,(nth 1 other1))
+ (:h . ,(nth 2 other1))
+ (:komi . ,(nth 3 other1))
+ (:by . ,(nth 4 other1))
+ (:fr . ,(nth 5 other1))
+ (:other . ,(car other2)))
+ *igs-games*))))
+
+(defvar igs-move-piece-re
+ "[[:digit:]]+(\\([WB]\\)): \\([[:alpha:][:digit:]]+\\)$"
+ "Regular expression used to match an IGS move.")
+
+(defvar igs-move-time-re "TIME")
+
+(defvar igs-move-props-re "GAMEPROPS")
+
+(defvar igs-move-game-re "Game")
+
+(defmacro igs-re-cond (string &rest body)
+ (declare (indent 1))
+ `(cond ,@(mapcar
+ (lambda (part)
+ (cons (if (or (keywordp (car part)))
+ (car part)
+ `(string-match ,(car part) ,string))
+ (cdr part)))
+ body)))
+(def-edebug-spec igs-re-cond (form body))
+
+(defun igs-to-pos (color igs)
+ (cons (make-keyword color)
+ (cons (char-to-num (aref igs 0))
+ (read (substring igs 1)))))
+
+(defun igs-handle-move (move-string)
+ (igs-re-cond move-string
+ (igs-move-piece-re (igs-to-pos (match-string 1 move-string)
+ (match-string 2 move-string)))
+ (igs-move-time-re nil)
+ (igs-move-props-re nil)
+ (igs-move-game-re nil)))
;;; Class and interface
- [elpa] 118/255: cleanup in go.el, (continued)
- [elpa] 118/255: cleanup in go.el, Eric Schulte, 2014/03/15
- [elpa] 130/255: adding a file for tracking development notes, Eric Schulte, 2014/03/15
- [elpa] 128/255: starting to flesh out igs support, Eric Schulte, 2014/03/15
- [elpa] 119/255: test cleanup, Eric Schulte, 2014/03/15
- [elpa] 132/255: moving char-to-num and num-to-char to util, Eric Schulte, 2014/03/15
- [elpa] 115/255: uniform gnugo prefix, Eric Schulte, 2014/03/15
- [elpa] 134/255: notes, Eric Schulte, 2014/03/15
- [elpa] 131/255: transitioning IGS interface to use client mode, Eric Schulte, 2014/03/15
- [elpa] 140/255: board propagates setf'd moves to trackers, Eric Schulte, 2014/03/15
- [elpa] 137/255: setf method for aget, Eric Schulte, 2014/03/15
- [elpa] 133/255: igs using a process filter for asynch processing,
Eric Schulte <=
- [elpa] 136/255: two small fixes, Eric Schulte, 2014/03/15
- [elpa] 135/255: stubbed out API interface for go-board, Eric Schulte, 2014/03/15
- [elpa] 139/255: fixed off-by-one in igs moves & tracking last move, Eric Schulte, 2014/03/15
- [elpa] 138/255: igs can track a current game and apply moves, Eric Schulte, 2014/03/15
- [elpa] 142/255: TODO igs probably needs to periodically ping the server, Eric Schulte, 2014/03/15
- [elpa] 143/255: pass move through board to *back-end*, Eric Schulte, 2014/03/15
- [elpa] 144/255: tests require igs, Eric Schulte, 2014/03/15
- [elpa] 146/255: print igs kibitz strings, Eric Schulte, 2014/03/15
- [elpa] 141/255: beginning of infrastructure for player names & info, Eric Schulte, 2014/03/15
- [elpa] 145/255: periodically ping IGS server to prevent disconnect, Eric Schulte, 2014/03/15