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

[bump]

This is a patch to Thi's gnugo.el-2.2.8. It implements the
functionality of a previous patch of mine to gnugo.el-2.2.7.
It was necessary to rewrite the patch since
gnugo.el-2.2.8 removed :move-history as redundant
with :sgf-tree. The rewritten patch uses :sgf-tree where
the old one used :move-history.

The old patch is described here:

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

The patch calls the gtp function move_history so it
will work with gnugo-3.6 or the current cvs (or
3.7.1 which should be out soon).

- :sgf-tree is correct after loading an sgf file
- undo stack and redo implemented
- gnugo-goto-pos does not try to go to PASS
- new functions gnugo-sgf-to-gtp, gnugo-gtp-to-sgf,
  gnugo-warp-point, gnugo-undo, gnugo-redo and gnugo-redo-two-moves
- key bindings for f, b, r, j, <, > to navigate sgf files
- move number is added to the mode line.

After this patch, you can use < or > to go to the
beginning or end of the game, and you can also use
j <n> to jump to move n. You can use f and be to
scroll around in a game.

Thi added a function gnugo-undo-one-move in gnugo.el-2.2.8
which differs slightly from the new function gnugo-undo
here. With gnugo-undo when you go back a move, the
colors of the two opponents are switched. With
gnugo-undo-one-move, this does not happen.

Dan

--- gnugo.el-2.2.8      Mon Nov 15 15:21:31 2004
+++ gnugo.el    Tue Nov 23 12:12:16 2004
@@ -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,97 @@
       (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 moves (gnugo-goto-pos (gnugo-sgf-to-gtp (cdr (car (car moves))))))))
+
 (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" (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 +1365,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 +1402,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
@@ -1470,7 +1611,6 @@
   "Major mode for playing GNU Go.
 Entering this mode runs the normal hook `gnugo-board-mode-hook'.
 In this mode, keys do not self insert.  Default keybindings:
-
   ?             View this help.
 
   RET or SPC    Run `gnugo-move'.
@@ -1481,13 +1621,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'.
@@ -1716,6 +1869,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)