[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[gnugo-devel] Merge of gnugo.el patches
|
From: |
bump |
|
Subject: |
[gnugo-devel] Merge of gnugo.el patches |
|
Date: |
Sat, 27 Nov 2004 20:30:28 -0800 |
This is a merge of the two patches I posted earlier at:
http://lists.gnu.org/archive/html/gnugo-devel/2004-11/msg00093.html
http://lists.gnu.org/archive/html/gnugo-devel/2004-11/msg00097.html
In my opinion this gives a gnugo.el that is very useful
not just for playing with GNU Go but also for browsing sgf
files within emacs, being able to pass GTP commands to the
engine.
In this patch I made the graphical display with xpms the
startup default. Is there any reason not to do this?
The grid is off by default.
Known bugs:
(1) If you browse an sgf file consisting of a single node you
will have to type ^G before you can see any stones.
(2) The patch assumes 36 pixel xpms (such as are distributed
with GNU Go). If you want another size, you will have to
change the commented line about jspc.
Dan
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 28 Nov 2004 04:25:20 -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
@@ -312,6 +314,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 -- don't 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 +405,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 +464,9 @@
;; `(display (space :width 0))'
;; works as well, for newer emacs
'(invisible t)))
+; for 24 pixel xpms try
+; (setplist (gnugo-f 'jspc) (and new '(display (space :width 2.0))))
+ (setplist (gnugo-f 'jspc) (and new '(display (space :width 3.6))))
(gnugo-put :highlight-last-move-spec
(if new
'((lambda (p)
@@ -477,22 +484,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 +569,26 @@
(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 +646,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 +752,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,6 +800,9 @@
`((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-venerate (yin yang)
@@ -885,7 +958,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 +967,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
@@ -954,7 +1028,8 @@
tpad
lpad
rpad
- ispc))))
+ ispc
+ jspc))))
(setq gnugo-state nil)))
(defun gnugo-position ()
@@ -1205,10 +1280,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,9 +1438,11 @@
(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
+; (gnugo-merge-showboard-results) ; all
(gnugo-refresh) ; this
(decf n) ; is
(sit-for 0))) ; eye candy
@@ -1287,6 +1475,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 +1695,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'.
@@ -1539,6 +1768,7 @@
:mode-line
:mode-line-form
:display-using-images
+ :show-grid
:xpms
:local-xpms
:all-yy))
@@ -1602,28 +1832,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))
@@ -1679,6 +1893,8 @@
(gnugo-put :center-position
(get-text-property (point) 'gnugo-position))))
;; first move
+ (if (and (fboundp 'display-images-p) (display-images-p))
+ (gnugo-toggle-image-display))
(gnugo-put :game-start-time (current-time))
(let ((g (gnugo-get :gnugo-color))
(n (gnugo-get :handicap))
@@ -1716,6 +1932,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)
@@ -1728,6 +1951,7 @@
("d" . gnugo-dragon-stones)
("D" . gnugo-dragon-data)
("t" . gnugo-toggle-dead-group)
+ ("g" . gnugo-toggle-grid)
("!" . gnugo-estimate-score)
(":" . gnugo-command)
(";" . gnugo-command)
- [gnugo-devel] Merge of gnugo.el patches,
bump <=