[elpa] 141/255: beginning of infrastructure for player names & info

[Eric Schulte]

eschulte pushed a commit to branch go
in repository elpa.

commit b23809656bdc5a203154a67790153758d31cca1d
Author: Eric Schulte <address@hidden>
Date:   Sat Jun 2 19:51:06 2012 -0600

    beginning of infrastructure for player names & info
---
 back-ends/igs.el |   43 +++++++++++++++++++++++++++++++++++++------
 go-board.el      |   20 ++++++++++++++++++++
 go.el            |    2 ++
 3 files changed, 59 insertions(+), 6 deletions(-)

diff --git a/back-ends/igs.el b/back-ends/igs.el
index 298117a..b992936 100644
--- a/back-ends/igs.el
+++ b/back-ends/igs.el
@@ -114,7 +114,9 @@
         (: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)))))))
+        (:move   (igs-w-proc proc (igs-handle-move content)))
+        (:beep   nil)
+        (t       (message "igs-unknown: [%s]%s" type content))))))
 
 (defun igs-insertion-filter (proc string)
   (with-current-buffer (process-buffer proc)
@@ -194,8 +196,19 @@
 
 
 ;;; Specific handlers
+(defvar igs-player-name-re
+  "[[:alpha:][:digit:]]+"
+  "Regular expression used to match igs player name.")
+
+(defvar igs-player-rating-re
+  "[[:digit:]]+[kd]\\*"
+  "Regular expression used to match igs player rating.")
+
+(defvar igs-player-game-info-re "([-[:digit:]]+ [-[:digit:]]+ [-[:digit:]]+)"
+  "Regular expression used to match igs player game info.")
+
 (defvar igs-player-re
-  "\\([[:alpha:][:digit:]]+\\) +\\[ *\\([[:digit:]]+[kd]\\*\\)\\]"
+  (format "\\(%s\\) +\\[ *\\(%s\\)\\]" igs-player-name-re igs-player-rating-re)
   "Regular expression used to parse igs player name and rating.")
 
 (defvar igs-game-re
@@ -204,14 +217,18 @@
   "Regular expression used to parse igs game listings.")
 
 (defvar igs-move-piece-re
-  "[[:digit:]]+(\\([WB]\\)): \\([[:alpha:][:digit:]]+\\)$"
+  "[[: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:]]+\\)")
+(defvar igs-move-game-re
+  (format "Game \\([[:digit:]]+\\) I: \\(%s\\) \\(%s\\) vs \\(%s\\) \\(%s\\)"
+          igs-player-name-re igs-player-game-info-re
+          igs-player-name-re igs-player-game-info-re)
+  "Regular expression used to match Game updates.")
 
 (defmacro igs-re-cond (string &rest body)
   (declare (indent 1))
@@ -279,6 +296,13 @@
       (insert (format "moves %s" number))
       (comint-send-input))))
 
+(defun igs-update-game-info (info)
+  (let ((color (car info))
+        (name (cadr info))
+        (other (cddr info)))
+    ;; (message "[%s] %s: %s" color name other)
+    ))
+
 (defun igs-handle-move (move-string)
   (igs-re-cond move-string
     (igs-move-piece-re (igs-apply-move
@@ -286,8 +310,15 @@
                                     (match-string 2 move-string))))
     (igs-move-time-re  nil)
     (igs-move-props-re nil)
-    (igs-move-game-re  (igs-register-game
-                        (read (match-string 1 move-string))))))
+    (igs-move-game-re
+     (let ((number (read (match-string 1 move-string)))
+           (white-info (cons (match-string 2 move-string)
+                             (read (match-string 3 move-string))))
+           (black-info (cons (match-string 4 move-string)
+                             (read (match-string 5 move-string)))))
+       (igs-register-game number)
+       (igs-update-game-info (cons :W white-info))
+       (igs-update-game-info (cons :B black-info))))))
 
 
 ;;; Class and interface
diff --git a/go-board.el b/go-board.el
index 4c8540b..a946a92 100644
--- a/go-board.el
+++ b/go-board.el
@@ -32,6 +32,8 @@
 (defvar *history*  nil "Holds the board history for a GO buffer.")
 (defvar *size*     nil "Holds the board size.")
 (defvar *turn*     nil "Holds the color of the current turn.")
+(defvar *black*    nil "Holds info on black player.")
+(defvar *white*    nil "Holds info on white player.")
 (defvar *back-end* nil "Holds the primary back-end connected to a board.")
 (defvar *trackers* nil "Holds a list of back-ends which should track the 
game.")
 (defvar *autoplay* nil "Should `*back-end*' automatically respond to moves.")
@@ -237,6 +239,8 @@
           (mapcar (lambda (tr) (setf (go-name tr) name)) trackers)))
       (set (make-local-variable '*back-end*) back-end)
       (set (make-local-variable '*turn*) :B)
+      (set (make-local-variable '*black*) nil)
+      (set (make-local-variable '*white*) nil)
       (set (make-local-variable '*size*) (go-size back-end))
       (mapcar (lambda (tr) (setf (go-size tr) *size*)) trackers)
       (set (make-local-variable '*history*)
@@ -406,6 +410,22 @@
 (defmethod set-go-color ((board board) color)
   (with-board board (setq *turn* color)))
 
+(defmethod go-player-name ((board board) color)
+  (with-board board (car (case color (:W *white*) (:B *black*)))))
+
+(defmethod set-go-player-name ((board board) color name)
+  (with-board board
+    (let ((player (case color (:W *white*) (:B *black*))))
+      (setf (car player) name))))
+
+(defmethod go-player-time ((board board) color)
+  (with-board board (cdr (case color (:W *white*) (:B *black*)))))
+
+(defmethod set-go-player-time ((board board) color time)
+  (with-board board
+    (let ((player (case color (:W *white*) (:B *black*))))
+      (setf (cdr player) time))))
+
 ;; non setf'able generic functions
 (defmethod go-undo ((board board))
   (with-board board (board-undo)))
diff --git a/go.el b/go.el
index 993f82c..42ac954 100644
--- a/go.el
+++ b/go.el
@@ -78,6 +78,8 @@ Optional argument LEVEL specifies gnugo's level of play."
 (defgeneric-w-setf go-comment "Access current BACK-END comment.")
 (defgeneric-w-setf go-alt     "Access current BACK-END alternative move.")
 (defgeneric-w-setf go-color   "Access current BACK-END turn color.")
+(defgeneric-w-setf go-player-name "Access current BACK-END player name.")
+(defgeneric-w-setf go-player-time "Access current BACK-END player time.")
 
 ;; sending messages to the back-end
 (defgeneric go-undo   (back-end) "Send undo to BACK-END.")