Re: [gnugo-devel] Patch to gnugo.el

[bump]

This is a revision of the patch at:

http://lists.gnu.org/archive/html/gnugo-devel/2004-11/msg00082.html

This is a patch to gnugo.el-2.2.8 avalailable at:

http://www.glug.org/people/ttn/software/ttn-pers-elisp/standalone/

But note that gnugo.el-2.2.8 is identical (except for
the copyright notice) to the gnugo.el that is distributed
in interface/ of gnugo-3.6 and gnugo-3.7.1.

The patch adds only a little new functionality beyond
the previous revision but if fixes some
bugs. Particularly it fixes gnugo-warp-point which
was broke, and it is much more likely to load and
save sgf files correctly.

If an sgf file has an initial configuration which is given
using the AB and AW properties (such as handicap stones)
then the file can usually be loaded correctly. There is
still a bug that I haven't been able to track down when
you load a file such as regression/games/owl10.sgf that
consists of a single node. The file will load correctly
but you have to type ^G before you will see the stones.
If there are more than one node this does not occur.

It would be good if you could get the initial configuration
by some gtp command that accessed initial_board[] and
dumped it contents. It could look like this:

static int
gtp_initial_board(char *s)
{
  int pos;

  gtp_start_response(GTP_SUCCESS);
  for (pos = BOARDMIN; pos < BOARDMAX; pos++)
    if (ON_BOARD(pos) && initial_board[pos] != EMPTY)
      gtp_mprintf("%C %m\n", initial_board[pos], I(pos), J(pos));
  gtp_printf("\n");
  return GTP_OK;
}

Since we don't have that and we'd like the patch to work
with GNU Go 3.6 I found another way which is to load
the file twice, first at the beginning then at the end.







Index: gnugo.el
===================================================================
RCS file: /home/bump/cvsroot/gnugoels/gnugo.el,v
retrieving revision 1.3.2.10
diff -u -r1.3.2.10 gnugo.el
--- gnugo.el    25 Nov 2004 12:42:45 -0000      1.3.2.10
+++ gnugo.el    27 Nov 2004 01:34:44 -0000
@@ -205,12 +205,13 @@
 character in the string, then the next, and so on until the string (and/or
 the viewer) is exhausted.")
 
-(defvar gnugo-mode-line "~b ~w :~u"
+(defvar gnugo-mode-line "~b ~w :~m :~u"
   "*A `mode-line-format'-compliant value for GNUGO Board mode.
 If a single string, the following special escape sequences are
 replaced with their associated information:
   ~b,~w  black,white captures (a number)
   ~p     current player (black or white)
+  ~m     move number
   ~t     time waiting for the current move
   ~u     time taken for the Ultimate (most recent) move
 The times are in seconds, or \"-\" if that information is not available.
@@ -295,6 +296,7 @@
  :sgf-tree -- the (very simple) list of nodes, each node a list of
               properties of the form `(:XY . VALUE)'; see functions
               `gnugo-push-move', `gnugo-note' and `gnugo-write-sgf-file'
+ :future-history -- an undo stack (so moves undone may be redone)
 
  :gnugo-color -- either \"black\" or \"white\"
  :user-color
@@ -402,16 +404,17 @@
 
 (defun gnugo-goto-pos (pos)
   "Move point to board position POS, a letter-number string."
-  (goto-char (point-min))
-  (forward-line (- (1+ (gnugo-get :board-size))
-                   (string-to-number (substring pos 1))))
-  (forward-char 1)
-  (forward-char (+ (if (= 32 (following-char)) 1 2)
-                   (* 2 (- (let ((letter (aref pos 0)))
-                             (if (> ?I letter)
-                                 letter
-                               (1- letter)))
-                           ?A)))))
+  (unless (string= pos "PASS")
+    (goto-char (point-min))
+    (forward-line (- (1+ (gnugo-get :board-size))
+                    (string-to-number (substring pos 1))))
+    (forward-char 1)
+    (forward-char (+ (if (= 32 (following-char)) 1 2)
+                    (* 2 (- (let ((letter (aref pos 0)))
+                              (if (> ?I letter)
+                                  letter
+                                (1- letter)))
+                            ?A))))))
 
 (defun gnugo-f (frag)
   (intern (format ":gnugo-%s%s-props" (gnugo-get :diamond) frag)))
@@ -598,6 +601,27 @@
         (when (setq very-strange (get-text-property (1+ cut) 'intangible))
           (put-text-property cut (1+ cut) 'intangible very-strange))))))
 
+(defun gnugo-sgf-to-gtp (cc) 
+  "Convert board locations from the format used by sgf to the format used by 
gtp."
+  (interactive)
+  (if (string= "tt" cc)
+      "PASS"
+    (setq col (aref cc 0))
+    (format "%c%d"
+           (+ ?A (- (if (> ?i col) col (1+ col)) ?a))
+           (- (gnugo-get :board-size) (- (aref cc 1) ?a)))))
+
+(defun gnugo-gtp-to-sgf (value)
+  "Convert board locations from the format used by gtp to the format used by 
sgf."
+  (interactive)
+  (if (string= "PASS" value)
+      "tt"
+    (let* ((col (aref value 0))
+          (one (+ ?a (- (if (< ?H col) (1- col) col) ?A)))
+          (two (+ ?a (- (gnugo-get :board-size) 
+                        (string-to-number (substring value 1))))))
+      (format "%c%c" one two))))
+
 (defun gnugo-move-history (&optional rsel)
   "Determine and return the game's move history.
 Optional arg RSEL controls side effects and return value.
@@ -688,6 +712,7 @@
     (gnugo-put :last-mover color)
     (when userp
       (gnugo-put :last-user-bpos (and (not passp) (not resignp) move)))
+    (gnugo-put :future-history nil)
     (gnugo-note (if (string= "black" color) :B :W) move t (not resignp))
     (when resignp
       (gnugo-note :EV "resignation"))
@@ -885,7 +910,7 @@
           (cond ((stringp cur)
                  (setq cur (copy-sequence cur))
                  (let (acc cut c)
-                   (while (setq cut (string-match "~[bwptu]" cur))
+                   (while (setq cut (string-match "~[bwmptu]" cur))
                      (aset cur cut ?%)
                      (setq cut (1+ cut) c (aref cur cut))
                      (aset cur cut ?s)
@@ -894,6 +919,7 @@
                         ,(case c
                            (?b '(or (gnugo-get :black-captures) 0))
                            (?w '(or (gnugo-get :white-captures) 0))
+                           (?m '(length (cdr (gnugo-get :sgf-tree))))
                            (?p '(gnugo-other (gnugo-get :last-mover)))
                            (?t '(let ((ws (gnugo-get :waiting-start)))
                                   (if ws
@@ -1205,10 +1231,121 @@
       (insert ")\n")
       (write-file filename))))
 
+(defun gnugo-warp-point ()
+  "Move the cursor to the next-to-last move."
+  (interactive)
+  (let ((moves (cdr (gnugo-get :sgf-tree))))
+    (if (memq (car (car (car moves))) '(:B :W))
+       (gnugo-goto-pos (gnugo-sgf-to-gtp (cdr (car (car moves))))))))
+
+(defun gnugo-initialize-sgf-tree ()
+  "Start a new sgf tree"
+  (gnugo-put :sgf-tree (list (list)))
+  (let ((g-blackp (string= "black" (gnugo-get :gnugo-color))))
+    (mapc (lambda (x) (apply 'gnugo-note x))
+          `((:GM 1)
+            (:FF 4)                     ; hmm maybe better: 3
+            (:DT ,(format-time-string "%Y-%m-%d"))
+            (:RU ,(gnugo-get :rules))
+            (:SZ ,(gnugo-get :board-size))
+            (:KM ,(gnugo-get :komi))
+            (,(if g-blackp :PW :PB) ,(user-full-name))
+            (,(if g-blackp :PB :PW) ,(concat "GNU Go "
+                                             (gnugo-query "version")))))
+    (mapc (lambda (x) (gnugo-note :AB x))
+           (mapcar 'gnugo-gtp-to-sgf 
+                   (split-string (gnugo-query "list_stones black"))))
+    (mapc (lambda (x) (gnugo-note :AW x))
+           (mapcar 'gnugo-gtp-to-sgf 
+                   (split-string (gnugo-query "list_stones white"))))))
+
 (defun gnugo-read-sgf-file (filename)
   "Load a game tree from FILENAME, a file in SGF format."
   (interactive "fSGF file to load: ")
-  (gnugo-command (format "loadsgf %s" (expand-file-name filename))))
+  (gnugo-command (format "loadsgf %s 1" (expand-file-name filename)))
+  (gnugo-initialize-sgf-tree)
+  (gnugo-command (format "loadsgf %s" (expand-file-name filename)))
+  (let* ((colorhistory 
+        (mapcar 
+         (lambda (x) (split-string x " ")) 
+         (split-string 
+          (cdr (gnugo-synchronous-send/return "move_history")) "[=\n]")))
+       (k (length colorhistory)))
+    (gnugo-put :last-mover
+              (car (car colorhistory)))
+    (gnugo-put :board-size 
+              (string-to-number (gnugo-query "query_boardsize")))
+    (gnugo-put :handicap 
+              (string-to-number (gnugo-query "get_handicap")))
+    (gnugo-put :komi 
+              (string-to-number (gnugo-query "get_komi")))
+    (let ((half (ash (1+ (gnugo-get :board-size)) -1)))
+      (gnugo-goto-pos (format "A%d" half))
+      (forward-char (* 2 (1- half)))
+      (gnugo-put :last-user-bpos
+       (gnugo-put :center-position
+         (get-text-property (point) 'gnugo-position))))
+    (gnugo-note :SZ (gnugo-get :board-size))
+    (gnugo-note :HA (gnugo-get :handicap))
+    (gnugo-note :KM (gnugo-get :komi))
+    (while (> k 0)
+      (decf k)
+      (gnugo-note (if (string= (car (nth k colorhistory)) "black") :B :W)
+                 (nth 1 (nth k colorhistory)) t t)))
+  (gnugo-refresh t)
+  (gnugo-warp-point))
+
+(defun gnugo-undo (&optional norefresh)
+  "Undo one move. Interchange the colors of the two players."
+  (interactive)
+  (gnugo-gate)
+  (if (equal 
+       (car 
+       (split-string (cdr (gnugo-synchronous-send/return "undo")) " ")) "?")
+      (error "cannot undo"))
+  (gnugo-put :future-history
+    (cons (car (gnugo-get :sgf-tree)) (gnugo-get :future-history)))
+  (gnugo-put :sgf-tree (cdr (gnugo-get :sgf-tree)))
+  (gnugo-put :user-color (gnugo-get :last-mover))
+  (gnugo-put :gnugo-color (gnugo-other (gnugo-get :last-mover)))
+  (gnugo-put :last-mover (gnugo-get :gnugo-color))
+  (gnugo-merge-showboard-results)
+  (unless norefresh
+    (gnugo-refresh t)
+    (gnugo-warp-point)))
+
+(defun gnugo-redo (&optional norefresh)
+  "Redo one move from the undo-stack (future-history).
+   Interchange the colors of the two players."
+  (interactive)
+  (gnugo-gate)
+  (if (equal (gnugo-get :future-history) nil)
+      (error "no more undone moves left to redo!"))
+  (let* ((buf (current-buffer))
+        (pos (gnugo-sgf-to-gtp (cdr (car (car (gnugo-get :future-history))))))
+         (move (format "play %s %s" (gnugo-get :user-color) pos))
+        (accept (cdr (gnugo-synchronous-send/return move))))
+    (gnugo-note (if (string= "black" (gnugo-get :user-color)) :B :W) pos t t)
+    (gnugo-put :future-history (cdr (gnugo-get :future-history)))
+    (gnugo-put :user-color (gnugo-get :last-mover))
+    (gnugo-put :gnugo-color (gnugo-other (gnugo-get :last-mover)))
+    (gnugo-put :last-mover (gnugo-other (gnugo-get :last-mover)))
+    (gnugo-merge-showboard-results)
+    (unless norefresh
+      (gnugo-refresh t)
+      (gnugo-warp-point))))
+
+(defun gnugo-redo-two-moves ()
+  "Redo a pair of moves (yours and GNU Go's).
+If two moves cannot be found, do nothing. (If there is
+exactly one move in the undo stack, you can still redo
+it using gnugo-redo.)"
+  (interactive)
+  (gnugo-gate)
+  (if (cdr (gnugo-get :future-history))
+      (gnugo-redo)
+    (error "can't redo two moves\n"))
+  (gnugo-redo))
 
 (defun gnugo-magic-undo (spec &optional noalt)
   "Undo moves on the GNUGO Board, based on SPEC, a string or number.
@@ -1252,6 +1389,8 @@
       (setq ans (cdr (gnugo-synchronous-send/return "undo")))
       (unless (= ?= (aref ans 0))
         (error ans))
+      (gnugo-put :future-history
+       (cons (car (gnugo-get :sgf-tree)) (gnugo-get :future-history)))
       (gnugo-put :sgf-tree (cdr (gnugo-get :sgf-tree)))
       (gnugo-put :last-mover (gnugo-other (gnugo-get :last-mover)))
       (gnugo-merge-showboard-results)   ; all
@@ -1287,6 +1426,32 @@
                         1
                       2)))
 
+(defun gnugo-jump-to-move (movenum)
+  "scroll forward or backward in the game to the given move."
+  (interactive)
+  (unless 
+      (and
+       (>= movenum 0)
+       (<= movenum (+ (length (cdr (gnugo-get :sgf-tree)))
+                     (length (gnugo-get :future-history)))))
+    (error "invalid move number"))
+  (while (not (= movenum (length (cdr (gnugo-get :sgf-tree)))))
+    (if (< movenum (length (cdr (gnugo-get :sgf-tree))))
+       (gnugo-undo t)
+      (gnugo-redo t)))
+  (gnugo-refresh t))
+
+(defun gnugo-jump-to-beginning ()
+  "jump to the beginning of the game."
+  (interactive)
+  (gnugo-jump-to-move 0))
+
+(defun gnugo-jump-to-end ()
+  "jump to the end of the game"
+  (interactive)
+  (gnugo-jump-to-move (+ (length (gnugo-get :move-history))
+        (length (gnugo-get :future-history)))))
+
 (defun gnugo-display-final-score ()
   "Display final score and other info in another buffer (when game over).
 If the game is still ongoing, Emacs asks if you wish to stop play (by
@@ -1481,13 +1646,26 @@
 
   u             Run `gnugo-undo-two-moves'.
 
+  r             Redo two moves.
+
   U             Pass to `gnugo-magic-undo' either the board position
                 at point (if no prefix arg), or the prefix arg converted
                 to a number.  E.g., to undo 16 moves: `C-u C-u U' (see
                 `universal-argument'); to undo 42 moves: `M-4 M-2 U'.
 
-  C-l           Run `gnugo-refresh'.
+  f             Scroll forward (redo one undone move); 
+                potentially switch colors.
+
+  b             Scroll backward (undo one move); potentially switch colors.
+
+  <             Go to the beginning of the game
 
+  >             Go to the end of the game
+
+  j <n> RET     Jump to move number <n>
+
+  C-l           Run `gnugo-refresh' to redraw the board.
+ 
   _ or M-_      Bury the Board buffer (when the boss is near).
 
   P             Run `gnugo-pass'.
@@ -1602,28 +1780,12 @@
   (gnugo-put :rparen-ov (let ((ov (make-overlay 1 1)))
                           (overlay-put ov 'display ")")
                           ov))
-  (gnugo-put :sgf-tree (list (list)))
-  (let ((g-blackp (string= "black" (gnugo-get :gnugo-color))))
-    (mapc (lambda (x) (apply 'gnugo-note x))
-          `((:GM 1)
-            (:FF 4)                     ; hmm maybe better: 3
-            (:DT ,(format-time-string "%Y-%m-%d"))
-            (:RU ,(gnugo-get :rules))
-            (:SZ ,(gnugo-get :board-size))
-            (:KM ,(gnugo-get :komi))
-            (,(if g-blackp :PW :PB) ,(user-full-name))
-            (,(if g-blackp :PB :PW) ,(concat "GNU Go "
-                                             (gnugo-query "version")))
-            ,@(let ((h (gnugo-get :handicap)))
-                (when (not (= 0 h))
-                  `((:HA ,h)
-                    ,@(mapcar
-                       ;; AB can be a list, but we stay simple so that
-                       ;; `gnugo-write-sgf-file' can also remain simple
-                       (lambda (stone)
-                         `(:AB ,stone nil t))
-                       (split-string
-                        (gnugo-query "fixed_handicap %d" h)))))))))
+  (if (< 0 (gnugo-get :handicap))
+        (gnugo-query (format "fixed_handicap %d" (gnugo-get :handicap))))
+  (gnugo-initialize-sgf-tree)
+  (gnugo-note :SZ (gnugo-get :board-size))
+  (gnugo-note :HA (gnugo-get :handicap))
+  (gnugo-note :KM (gnugo-get :komi))
   (set-process-sentinel (gnugo-get :proc) 'gnugo-sentinel)
   (set-process-buffer (gnugo-get :proc) (current-buffer))
   (gnugo-put :waiting-start (current-time))
@@ -1716,6 +1878,13 @@
                                    ((consp x) (car x))
                                    (t (gnugo-position))))))
             ("u"        . gnugo-undo-two-moves)
+            ("r"        . gnugo-redo-two-moves)
+            ("f"        . gnugo-redo)
+            ("b"        . gnugo-undo)
+            ("j"        . (lambda (x) (interactive "nJump to move number: ")
+                           (gnugo-jump-to-move x)))
+            ("<"        . gnugo-jump-to-beginning)
+           (">"        . gnugo-jump-to-end)
             ("\C-l"     . gnugo-refresh)
             ("\M-_"     . bury-buffer)
             ("_"        . bury-buffer)