[gnugo-devel] grid for gnugo.el

[bump]

This is a patch against gnugo.el-2.2.8. It allows the display
of a grid around the board.

The grid is hidden by default. To toggle it on or off, type `g'.

This patch does not include my previous patch. I can
post a merged patch later but right now I'm hoping for
feedback from Thi on whether this is a good patch or not.
(And if it is OK can some form of this into
gnugo.el-2.2.9?)

To point out one problem with the patch, I found the
function gnugo-merge-showboard-results difficult to
understand and I didn't try to fix it. Instead I took out
calls to this function and added a call to (gnugo-refresh
t) at the end of gnugo-push-move. This works but it may
be the cause of some slowness. After making a move there
is a tiny delay (maybe 1/4 second on my machine, just
enough to notice) before the move appears on the screen.
So probably gnugo-merge-showboard-results is faster
than calling gnugo-refresh and this needs to be fixed.

Another problem is that the patch assumes the xpms will be
36 pixels. (See jspc.) It will have to be modified to work
with other sizes.

To understand how this patch works it is necessary to 
understand Thi's function gnugo-propertize-board-buffer.
This function calls showboard with the gtp engine, then
modifies the board by adding properties to each location.
The grid is left intact, but the 'invisible property is
added to the points of the grid, so you don't show
them. This patch takes down this step if :show-grid is true.

It's not quite that easy, however. A complication is that
padding in the form of the lpad property is added to the
bytes beginning of the lines to approximately center the
board. This property makes a byte wide. I wasn't able to
get the lpad property to work and still display the first
byte of the line.  So the patch inserts one byte to the
beginning of the line to get the lpad property.

Padding is also added in the form of the tpad property 
to a one byte in the first line, so I also inserted
" \n" at the beginning of the buffer. (The rpad
property is no longer used after the patch.)

These insertions has the effect of moving the entire board
down and to the right by one byte. A corresponding
modification of gnugo-goto-pos is therefore needed.

In gnugo.el-2.2.8 the function gnugo-propertize-board-buffer
gets B and W captures from the showboard buffer. We can
get the same information from the gtp, so I just added
calls to (kill-line) to clip off the ends of the
two lines that display the captures.

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    27 Nov 2004 23:02:49 -0000
@@ -312,6 +312,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
@@ -403,9 +404,9 @@
 (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))
+  (forward-line (- (+ 2 (gnugo-get :board-size))
                    (string-to-number (substring pos 1))))
-  (forward-char 1)
+  (forward-char 2)
   (forward-char (+ (if (= 32 (following-char)) 1 2)
                    (* 2 (- (let ((letter (aref pos 0)))
                              (if (> ?I letter)
@@ -460,6 +461,7 @@
                                    ;; `(display (space :width 0))'
                                    ;; works as well, for newer emacs
                                    '(invisible t)))
+    (setplist (gnugo-f 'jspc) (and new '(display (space :width 3.6))))
     (gnugo-put :highlight-last-move-spec
       (if new
           '((lambda (p)
@@ -477,22 +479,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 +564,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))
@@ -683,8 +726,8 @@
          (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)))
@@ -730,6 +773,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)
@@ -954,7 +1000,8 @@
                             tpad
                             lpad
                             rpad
-                            ispc))))
+                            ispc
+                            jspc))))
     (setq gnugo-state nil)))
 
 (defun gnugo-position ()
@@ -1254,7 +1301,7 @@
         (error ans))
       (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
@@ -1539,6 +1586,7 @@
           :mode-line
           :mode-line-form
           :display-using-images
+          :show-grid
           :xpms
           :local-xpms
           :all-yy))
@@ -1728,6 +1776,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)