eschulte pushed a commit to branch go
in repository elpa.
commit d4acebe6ed4ccb96bb165942b42051ce96715e4f
Author: Eric Schulte <[email protected]>
Date: Sat Jun 2 18:42:41 2012 -0600
igs can track a current game and apply moves
---
NOTES | 2 +-
back-ends/igs.el | 121 +++++++++++++++++++++++++++++++++++++++++-------------
2 files changed, 93 insertions(+), 30 deletions(-)
diff --git a/NOTES b/NOTES
index 7e049dc..5e90451 100644
--- a/NOTES
+++ b/NOTES
@@ -1,7 +1,7 @@
# -*- mode:org -*-
* DONE make a board back-end so it can receive commands
-* TODO allow an IGS process to send commands to a board
+* DONE allow an IGS process to send commands to a board
* IGS Support
- use information in [[file:data/igs.c][igs.c]] and in the cgoban source.
- [[file:data/igs-session][tcpick output]] collected with while talking with
IGS servers
diff --git a/back-ends/igs.el b/back-ends/igs.el
index 82fc349..effd428 100644
--- a/back-ends/igs.el
+++ b/back-ends/igs.el
@@ -97,6 +97,9 @@
(defvar *igs-games* nil
"List holding the current games on the IGS server.")
+(defvar *igs-current-game* nil
+ "Number of the current IGS game (may change frequently).")
+
(defmacro igs-w-proc (proc &rest body)
(declare (indent 1))
`(with-current-buffer (process-buffer proc) ,@body))
@@ -139,6 +142,7 @@
(comint-mode)
(set (make-local-variable '*igs-ready*) nil)
(set (make-local-variable '*igs-games*) nil)
+ (set (make-local-variable '*igs-current-game*) nil)
(let ((proc (get-buffer-process (current-buffer))))
(wait "^Login:")
(goto-char (process-mark proc))
@@ -153,10 +157,41 @@
(insert (format "toggle %s %s" setting (if value "true" "false")))
(comint-send-input))
-(defun igs-observe (game)
- (insert (format "observe %s" game))
+(defun igs-observe (&optional game)
+ (interactive)
+ (let ((game (or game (read (org-icompleting-read
+ "game: "
+ (mapcar #'number-to-string
+ (mapcar #'car *igs-games*)))))))
+ (insert (format "observe %s" game))
+ (comint-send-input)))
+
+(defun igs-games ()
+ (interactive)
+ (setf *igs-games* nil)
+ (insert "games")
(comint-send-input))
+(defun igs-game-list (igs)
+ (let (games)
+ (with-current-buffer (buffer igs)
+ (setq games *igs-games*))
+ (let* ((my-games (copy-seq games))
+ (list-buf (get-buffer-create "*igs-game-list*")))
+ (with-current-buffer (pop-to-buffer list-buf)
+ (delete-region (point-min) (point-max))
+ (org-mode)
+ (insert (concat (orgtbl-to-orgtbl
+ (mapcar (lambda (game)
+ (cons (car game)
+ (mapcar #'cdr
+ (assq-delete-all
+ :board (cdr game)))))
+ my-games)
+ '(:fmt (lambda (cell) (format "%s" cell)))) "\n"))
+ (goto-char (point-min))
+ (org-table-align)))))
+
;;; Specific handlers
(defvar igs-player-re
@@ -168,6 +203,27 @@
igs-player-re igs-player-re)
"Regular expression used to parse igs game listings.")
+(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 \\([[:digit:]]+\\)")
+
+(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-handle-game (game-string)
;; [##] white name [ rk ] black name [ rk ] (Move size H Komi BY FR) (###)
(when (string-match igs-game-re game-string)
@@ -178,7 +234,7 @@
(black-rank (match-string 5 game-string))
(other1 (read (match-string 6 game-string)))
(other2 (read (match-string 7 game-string))))
- (push `((:number . ,(read num))
+ (push `(,(read num)
(:white-name . ,white-name)
(:white-rank . ,white-rank)
(:black-name . ,black-name)
@@ -192,39 +248,46 @@
(: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)))))
+ (cons :pos
+ (cons (char-to-num (aref igs 0))
+ (read (substring igs 1))))))
+
+(defun igs-current-game ()
+ (aget *igs-games* *igs-current-game*))
+
+(defun set-igs-current-game (new)
+ (setf (aget *igs-games* *igs-current-game*) new))
+
+(defsetf igs-current-game set-igs-current-game)
+
+(defun igs-apply-move (move)
+ (if (aget (igs-current-game) :board)
+ (setf (go-move (aget (igs-current-game) :board)) move)
+ (message "igs-apply-move: no board!")))
+
+(defun igs-register-game (number)
+ (setq *igs-current-game* number)
+ (unless (aget (igs-current-game) :board)
+ (let ((sgf (make-instance 'sgf)))
+ (setf (go-size sgf) (aget (igs-current-game) :size))
+ (setf (go-name sgf) (format "igs-%d" number))
+ (setf (aget (igs-current-game) :board)
+ (save-excursion (make-instance 'board
+ :buffer (go-board sgf))))
+ (insert (format "moves %s" number))
+ (comint-send-input))))
(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-piece-re (igs-apply-move
+ (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)))
+ (igs-move-game-re (igs-register-game
+ (read (match-string 1 move-string))))))
;;; Class and interface
