[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnugo-devel] gnugo.el patch
|
From: |
bump |
|
Subject: |
[gnugo-devel] gnugo.el patch |
|
Date: |
Sat, 4 Dec 2004 13:22:11 -0800 |
This is a rewrite of the patch at:
http://lists.gnu.org/archive/html/gnugo-devel/2004-11/msg00099.html
Compared with the previous patch, this version has been debugged
a lot. It seems pretty stable to me after a fair amount
of testing, and it contains all the features I feel are
urgently needed right now.
This is a patch against Thi's gnugo.el-2.2.8. It applies without
change to the gnugo.el which is distributed with GNU Go, which
differs from Thi's file only in the copyright notice.
Here are lists of changes relative to gnugo.el-2.2.8.
CHANGE OVERVIEW
* Undo stack implemented. After undoing using gnugo-undo or
gnugo-magic undo, you may redo the moves using gnugo-redo. You
may undo or redo moves with gnugo-undo and gnugo-redo (bound to
"b" and "f") or gnugo-undo-two-moves and gnugo-redo-two moves
(bound to "u" and "r"). If you backtrack to an earlier position
and then make a move, the undo stack is discarded, and the
earlier continuation is lost. With this caveat, you may freely
scroll back and forth in a game. You may also jump to the
beginning or end or to a particular move number using the
commands gnugo-jump-to-beginning, gnugo-jump-to-end and
gnugo-jump-to-move, bound to "<", ">" and "j".
* Grid line implemented. You may toggle the display of the grid line
with gnugo-toggle-grid (bound to "g").
* Primitive edit mode. This is very simple but still useful.
You can use it to write an sgf file from scratch but of
course there's no support for variations. All it does is to
suppress GNU Go's usual behavior of generating a reply to
every move you can make. It is toggled on or off by
gnugo-toggle-edit-mode, bound to "e". If you want to
cheat, you can stop GNU Go in the middle of a game by
toggling edit mode, play out a few moves to see what will
happen, then back up to where you started, turn off the
edit mode and play your move, and GNU Go will resume
playing.
* SGF file handling improved. See below.
* Mode line contains the move number, and the number of
undone moves that can be redone.
DETAILS
* For the grid display, gnugo-propertize-buffer was
modified. The location of the board is moved down and to the
right. The extra bytes at the left and top are given the
display properties lpad and tpad which are used to center the
board. In gnugo.el-2.2.8, lpad was given to bytes of the grid,
which doesn't work if they are to be displayed.
* gnugo-merge-showboard-results is not called. It was broken
by the last mentioned change. Other changes render it unneeded.
* Modifications to gnugo-write-sgf-file change the output
format a bit. Two adjacent newlines are never outputted
and the AB and AW properties are now handled per the SGF
specification (http://www.red-bean.com/sgf/). The function
gnugo-read-sgf-file was reorganized to make sure that SGF
properties such as SZ, HA and KM do not occur twice in the
root node. Some of the functions of creating an sgf file
were moved to a new function gnugo-initialize-sgf-file.
* There is a change to gnugo-magic-undo: the test "done"
was redefined in terms of a call to the GTP command "color"
to determine whether a vertex is empty instead of
examining of the buffer as gnugo.el-2.2.8 does. With
the gnugo-merge-showboard-results calls taken out, the
buffer may not be current until gnugo-refresh is called
much later.
* New functions gnugo-sgf-to-gtp and gnugo-gtp-to-sgf convert
between the board notations used by SGF and GTP. (The GTP
convention is the same one used by the whole world except in
SGF.)
* A new function called gnugo-warp-point moves point to the
position of the next-to-last move, which is its optimal
location.
* gnugo-goto-pos does not try to go to PASS.
* The graphical display with xpms is on at startup by default,
unless the xpms cannot be found.
There is one known bug: If you load an sgf file with
exactly one node such as regression/games/owl10.sgf,
you must type ^G before you will see the stones. I am
quite baffled by this problem.
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 4 Dec 2004 20:06:21 -0000
@@ -147,10 +147,20 @@
(require 'cl) ; use the source luke!
(ignore-errors (require 'time-date)) ; for `time-subtract'
+
+;;; ==========================================================================
+
+; Modifications to gnugo.el-2.2.8:
+;
+; * Grid display implemented
+; * SGF handling improved
+; * Undo and Redo related enhancements
+; * Primitive edit mode
+
;;;---------------------------------------------------------------------------
;;; Political arts
-(defconst gnugo-version "2.2.8"
+(defconst gnugo-version "2.2.8.dbump4"
"Version of gnugo.el currently loaded.
Note that more than two dots in the value indicates \"pre-release\",
or \"alpha\" or \"hackers-invited-all-else-beware\"; use at your own risk!
@@ -205,12 +215,14 @@
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 ~n :~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
+ ~n size of undo stack
~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 +307,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
@@ -312,6 +325,7 @@
:display-using-images -- XPMs, to be precise; see functions `gnugo-yy',
`gnugo-toggle-image-display' and `gnugo-refresh',
as well as gnugo-xpms.el (available elsewhere)
+ :show-grid -- display the grid
:all-yy -- list of 46 keywords used as the `category' text property
(so that their plists, typically w/ property `display' or
@@ -402,16 +416,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 (- (+ 2 (gnugo-get :board-size))
+ (string-to-number (substring pos 1))))
+ (forward-char 2)
+ (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)))
@@ -460,6 +475,8 @@
;; `(display (space :width 0))'
;; works as well, for newer emacs
'(invisible t)))
+ (setplist (gnugo-f 'jspc)
+ `(display (space :width ,(- (gnugo-get :w-imul) 1))))
(gnugo-put :highlight-last-move-spec
(if new
'((lambda (p)
@@ -477,22 +494,52 @@
(gnugo-put :hmul (if new (gnugo-get :h-imul) 1))
(gnugo-put :display-using-images new)))
+(defun gnugo-toggle-grid ()
+ "Turn the grid around the board on or off."
+ (interactive)
+ (gnugo-put :show-grid (not (gnugo-get :show-grid)))
+ (gnugo-refresh t))
+
+(defun gnugo-propertize-grid-line (size)
+ (put-text-property (point) (+ 1 (point))
+ 'category (gnugo-f 'lpad))
+ (do ((p (+ 4 (point)) (+ 2 p)) (ival 'even (if (eq 'even ival) 'odd 'even)))
+ ((< (+ (* 2 size) 3 (point)) p))
+ (add-text-properties p (1+ p)
+ `(gnugo-yin
+ ,5
+ gnugo-yang
+ ,'empty
+ front-sticky
+ (gnugo-position gnugo-yin)))
+ (add-text-properties (- p 1) p
+ `(category
+ ,(gnugo-f 'jspc)
+ rear-nonsticky
+ t))
+ (put-text-property (- p 2) p 'intangible ival)))
+
(defun gnugo-propertize-board-buffer ()
(erase-buffer)
(insert (substring (cdr (gnugo-synchronous-send/return "showboard")) 3))
(let* ((size (gnugo-get :board-size))
(size-string (number-to-string size)))
- (goto-char (point-min))
- (put-text-property (point) (1+ (point)) 'category (gnugo-f 'tpad))
+ (beginning-of-buffer)
+ (insert " \n")
+ (put-text-property (point-min) (+ 1 (point-min)) 'category (gnugo-f 'tpad))
+ (insert " ")
+ (beginning-of-line)
+ (gnugo-propertize-grid-line size)
(forward-line 1)
- (put-text-property (point-min) (point) 'invisible t)
+ (insert " ")
+ (beginning-of-line)
(while (looking-at "\\s-*\\([0-9]+\\)[ ]")
(let* ((row (match-string-no-properties 1))
(edge (match-end 0))
(other-edge (+ edge (* 2 size) -1))
(top-p (string= size-string row))
(bot-p (string= "1" row)))
- (put-text-property (point) (1- edge) 'category (gnugo-f 'lpad))
+ (put-text-property (point) (1+ (point)) 'category (gnugo-f 'lpad))
(do ((p edge (+ 2 p)) (ival 'even (if (eq 'even ival) 'odd 'even)))
((< other-edge p))
(let* ((position (format "%c%s" (aref [?A ?B ?C ?D ?E ?F ?G ?H
@@ -532,15 +579,27 @@
(put-text-property p (+ 2 p) 'intangible ival)))
(goto-char (+ other-edge (length row) 1))
(when (looking-at "\\s-+\\(WH\\|BL\\).*capt.* \\([0-9]+\\).*$")
- (let ((prop (if (string= "WH" (match-string 1))
- :white-captures
- :black-captures)))
- (put-text-property (match-beginning 2) (match-end 2) 'field prop)
- (gnugo-put prop (match-string-no-properties 2))))
+ (kill-line))
+ (unless (gnugo-get :show-grid)
+ (save-excursion
+ (put-text-property (line-beginning-position)
+ (+ 3 (line-beginning-position))
+ 'invisible t)
+ (put-text-property (+ 3 (* 2 size) (line-beginning-position))
+ (line-end-position)
+ 'invisible t)
+ (beginning-of-buffer)
+ (forward-line 1)
+ (put-text-property (point) (line-end-position) 'invisible t)
+ (end-of-buffer)
+ (put-text-property
+ (line-beginning-position) (point) 'invisible t)))
(end-of-line)
- (put-text-property other-edge (point) 'category (gnugo-f 'rpad))
- (forward-char 1)))
- (put-text-property (1- (point)) (point-max) 'invisible t)))
+ ;(put-text-property other-edge (point) 'category (gnugo-f 'rpad))
+ (forward-char 1)
+ (insert " ")
+ (beginning-of-line)))
+ (gnugo-propertize-grid-line size)))
(defun gnugo-merge-showboard-results ()
(let ((aft (substring (cdr (gnugo-synchronous-send/return "showboard")) 3))
@@ -598,6 +657,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.
@@ -683,11 +763,12 @@
(head (gnugo-move-history 'car))
(onep (and head (string= "PASS" head)))
(donep (or resignp (and onep passp))))
- (unless passp
- (gnugo-merge-showboard-results))
+; (unless passp
+; (gnugo-merge-showboard-results))
(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"))
@@ -730,8 +811,20 @@
`((live ,@live)
(dead ,@dead))))))
(gnugo-put :waiting-start (and (not donep) now))
+ (gnugo-put :black-captures (gnugo-query "captures black"))
+ (gnugo-put :white-captures (gnugo-query "captures white"))
+ (gnugo-refresh t)
donep))
+(defun gnugo-toggle-edit-mode ()
+ "Toggle :edit-mode. When true, GNU Go is not called to generate moves."
+ (interactive)
+ (gnugo-put :edit-mode (not (gnugo-get :edit-mode)))
+ (if (gnugo-get :edit-mode)
+ (setq mode-name "Editing SGF File")
+ (setq mode-name "Playing GNU Go"))
+ (gnugo-refresh))
+
(defun gnugo-venerate (yin yang)
(let* ((fg-yy (gnugo-yy yin yang))
(fg-disp (or (get fg-yy 'display)
@@ -865,7 +958,7 @@
(if (symbol-plist (gnugo-f 'ispc))
0
(1- size)))
- 2)
+ 8)
2.0)))
(dolist (pair `((tpad . ,(if (and h (< 0 h))
`(display ,(make-string h 10))
@@ -885,7 +978,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 "~[bwmnptu]" cur))
(aset cur cut ?%)
(setq cut (1+ cut) c (aref cur cut))
(aset cur cut ?s)
@@ -894,6 +987,8 @@
,(case c
(?b '(or (gnugo-get :black-captures) 0))
(?w '(or (gnugo-get :white-captures) 0))
+ (?m '(length (cdr (gnugo-get :sgf-tree))))
+ (?n '(length (gnugo-get :future-history)))
(?p '(gnugo-other (gnugo-get :last-mover)))
(?t '(let ((ws (gnugo-get :waiting-start)))
(if ws
@@ -954,7 +1049,8 @@
tpad
lpad
rpad
- ispc))))
+ ispc
+ jspc))))
(setq gnugo-state nil)))
(defun gnugo-position ()
@@ -980,8 +1076,12 @@
(unless inhibit-gnugo-refresh
(with-current-buffer buf
(gnugo-refresh))))
- (with-current-buffer buf
- (gnugo-get-move (gnugo-get :gnugo-color)))))
+ (if (not (gnugo-get :edit-mode))
+ (with-current-buffer buf
+ (gnugo-get-move (gnugo-get :gnugo-color)))
+ (progn
+ (gnugo-put :user-color (gnugo-other (gnugo-get :user-color)))
+ (gnugo-put :gnugo-color (gnugo-other (gnugo-get :gnugo-color)))))))
(defun gnugo-mouse-move (e)
"Do `gnugo-move' at mouse location."
@@ -1186,10 +1286,11 @@
(not (y-or-n-p "File exists. Continue? ")))
(error "Not writing %s" filename))
;; todo: write sgf.el; call to it here
- (let ((bef-newline-appreciated '(:C :B :W :PB :PW)) ;;; aesthetic
- (aft-newline-appreciated '(:C :B :W :SZ :PB :PW)) ;;; license
+ (let ((bef-newline-appreciated '(:C :PB :PW :AB :AW)) ;;; aesthetic
+ (aft-newline-appreciated '(:C :B :W :PB :PW :SZ)) ;;; license
(sz (gnugo-get :board-size))
- (tree (gnugo-get :sgf-tree)))
+ (tree (gnugo-get :sgf-tree))
+ newline-just-printed)
(with-temp-buffer
(insert "(")
(dolist (node (reverse tree))
@@ -1197,18 +1298,152 @@
(dolist (prop (reverse node))
(let ((name (car prop))
(v (cdr prop)))
- (insert
- (if (memq name bef-newline-appreciated) "\n" "")
- (substring (symbol-name name) 1)
- "[" (format "%s" v) "]"
- (if (memq name aft-newline-appreciated) "\n" "")))))
+ (insert
+ (if (and (memq name bef-newline-appreciated)
+ (not newline-just-printed)) "\n" "")
+ (substring (symbol-name name) 1)
+ (if (not (memq name '(:AB :AW))) "[" "")
+ (format "%s" v)
+ (if (not (memq name '(:AB :AW))) "]" "")
+ (if (or (memq name aft-newline-appreciated)
+ (> (current-column) 60)) "\n" ""))
+ (setq newline-just-printed
+ (memq name aft-newline-appreciated)))))
(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)))
+ (black-stones (split-string (gnugo-query "list_stones black") " "))
+ (white-stones (split-string (gnugo-query "list_stones white") " ")))
+ (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))
+ (:HA ,(gnugo-get :handicap))
+ (:SZ ,(gnugo-get :board-size))
+ (:KM ,(gnugo-get :komi))
+ (:AP ,(format "gnugo.el:%s" gnugo-version))
+ (,(if g-blackp :PW :PB) ,(user-full-name))
+ (,(if g-blackp :PB :PW) ,(concat "GNU Go "
+ (gnugo-query "version")))))
+ (if black-stones
+ (gnugo-note :AB
+ (apply 'concat
+ (mapcar
+ (lambda (x) (format "[%s]" (gnugo-gtp-to-sgf x)))
+ black-stones))))
+ (if white-stones
+ (gnugo-note :AW
+ (apply 'concat
+ (mapcar
+ (lambda (x) (format "[%s]" (gnugo-gtp-to-sgf x)))
+ white-stones))))))
+
(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-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")))
+ (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)))
+ (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))))
+ (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)
+
+ (unless (and (gnugo-get :game-over) ; engine should undo pass but not resign
+ (not
+ (string= "PASS"
+ (nth 1
+ (split-string (gnugo-query "last_move") " ")))))
+ (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-put :game-over nil)
+; (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))))))
+ (color (if (equal (car (car (car (gnugo-get :future-history)))) :B)
+ "black" "white"))
+ (move (format "play %s %s" color pos))
+ (accept (cdr (gnugo-synchronous-send/return move))))
+ (gnugo-note (if (string= "black" color) :B :W) pos t t)
+ (gnugo-put :future-history (cdr (gnugo-get :future-history)))
+ (gnugo-put :user-color (gnugo-other color))
+ (gnugo-put :gnugo-color color)
+ (gnugo-put :last-mover color)
+; (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.
@@ -1231,9 +1466,9 @@
(setq n spec done (lambda () (= 0 n))))
((string-match "^[a-z]" spec)
(let ((pos (upcase spec)))
- (setq done `(lambda ()
- (gnugo-goto-pos ,pos)
- (memq (char-after) '(?. ?+))))
+ (setq done `(lambda ()
+ (equal
+ (gnugo-query ,(concat "color " pos)) "empty")))
(when (funcall done)
(error "%s already clear" pos))
(let ((u (gnugo-get :user-color)))
@@ -1245,21 +1480,24 @@
?X))
(error "%s not occupied by %s" pos u)))))
(t (error "bad spec: %S" spec)))
- (when (gnugo-get :game-over)
- ;; fixme: clean up :sgf-tree here.
- (gnugo-put :game-over nil))
(while (not (funcall done))
- (setq ans (cdr (gnugo-synchronous-send/return "undo")))
- (unless (= ?= (aref ans 0))
- (error ans))
+ (if (gnugo-get :game-over)
+ (gnugo-put :game-over nil)
+ (progn
+ (setq ans (cdr (gnugo-synchronous-send/return "undo")))
+ (unless (= ?= (aref ans 0))
+ (gnugo-refresh t)
+ (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
- (gnugo-refresh) ; this
+; (gnugo-merge-showboard-results) ; all
+; (gnugo-refresh t) ; this
(decf n) ; is
(sit-for 0))) ; eye candy
(let* ((ulastp (string= (gnugo-get :last-mover) (gnugo-get :user-color)))
-
+
(ubpos (gnugo-move-history (if ulastp 'car 'cadr))))
(gnugo-put :last-user-bpos (if (and ubpos (not (string= "PASS" ubpos)))
ubpos
@@ -1287,6 +1525,33 @@
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 (cdr (gnugo-get :sgf-tree)))
+ (length (gnugo-get :future-history))))
+ (gnugo-warp-point))
+
(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 +1746,28 @@
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>
+
+ g toggle the grid on or off.
+
+ C-l Run `gnugo-refresh' to redraw the board.
+
_ or M-_ Bury the Board buffer (when the boss is near).
P Run `gnugo-pass'.
@@ -1525,7 +1805,7 @@
(set (make-local-variable 'font-lock-defaults)
'(gnugo-font-lock-keywords t))
(setq major-mode 'gnugo-board-mode)
- (setq mode-name "GNUGO Board")
+ (setq mode-name "Playing GNU Go")
(add-hook 'kill-buffer-hook 'gnugo-cleanup nil t)
(make-local-variable 'gnugo-state)
(setq gnugo-state (make-hash-table :size (1- 42) :test 'eq))
@@ -1538,7 +1818,9 @@
:white-captures
:mode-line
:mode-line-form
+ :edit-mode
:display-using-images
+ :show-grid
:xpms
:local-xpms
:all-yy))
@@ -1602,28 +1884,9 @@
(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)
(set-process-sentinel (gnugo-get :proc) 'gnugo-sentinel)
(set-process-buffer (gnugo-get :proc) (current-buffer))
(gnugo-put :waiting-start (current-time))
@@ -1679,6 +1942,10 @@
(gnugo-put :center-position
(get-text-property (point) 'gnugo-position))))
;; first move
+ (if (and (fboundp 'display-images-p) (display-images-p))
+ (progn
+ (gnugo-toggle-image-display)
+ (gnugo-refresh t)))
(gnugo-put :game-start-time (current-time))
(let ((g (gnugo-get :gnugo-color))
(n (gnugo-get :handicap))
@@ -1716,6 +1983,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)
@@ -1723,11 +1997,13 @@
("i" . (lambda () (interactive)
(gnugo-toggle-image-display)
(save-excursion (gnugo-refresh))))
+ ("e" . gnugo-toggle-edit-mode)
("w" . gnugo-worm-stones)
("W" . gnugo-worm-data)
("d" . gnugo-dragon-stones)
("D" . gnugo-dragon-data)
("t" . gnugo-toggle-dead-group)
+ ("g" . gnugo-toggle-grid)
("!" . gnugo-estimate-score)
(":" . gnugo-command)
(";" . gnugo-command)
@@ -1799,7 +2075,7 @@
(defgtp '(boardsize
clear_board
fixed_handicap
- loadsgf)
+ loadsgf)
:output :discard
:post-hook (lambda ()
(dolist (prop '(:game-over
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [gnugo-devel] gnugo.el patch,
bump <=