;; `gnugo-animation-string'
;; `gnugo-mode-line'
;; `gnugo-X-face' `gnugo-O-face' `gnugo-grid-face'
+;; `gnugo-undo-reaction'
;; `gnugo-xpms'
;; normal hooks: `gnugo-board-mode-hook'
;; `gnugo-frolic-mode-hook'
;; `gnugo-start-game-hook'
;; `gnugo-post-move-hook'
-;; and the keymap: `gnugo-board-mode-map'
+;; and the keymaps: `gnugo-board-mode-map'
+;; `gnugo-frolic-mode-map'
;;
-;; The variable `gnugo-xpms' is a special case. To set it you need to load
-;; gnugo-xpms.el (http://www.emacswiki.org) or some other library w/ congruent
-;; interface.
+;;
+;; Meta-Meta-Playing (aka Hacking)
+;; -------------------------------
+;;
+;; <http://git.sv.gnu.org/cgit/emacs/elpa.git/tree/packages/gnugo/HACKING>
;;; Code:
(defvar gnugo-grid-face 'default
"Name of face to use for the grid (A B C ... 1 2 3 ...).")
+(defvar gnugo-undo-reaction 'play!
+ "What to do if undo (or oops) leaves GNU Go to play.
+After `gnugo-undo-one-move', `gnugo-undo-two-moves' or `gnugo-oops',
+when GNU Go is to play, this can be a symbol:
+ play -- make GNU Go play (unless in Zombie mode)
+ play! -- make GNU Go play unconditionally (traditional behavior)
+ zombie -- enable Zombie mode (`gnugo-zombie-mode')
+ one-shot -- like `zombie' but valid only for the next move
+Any other value, or (as a special case) for `gnugo-undo-one-move',
+any value other than `zombie', is taken as `one-shot'. Note that
+making GNU Go play will probably result in the recently-liberated
+board position becoming re-occupied.")
+
+(defvar gnugo-xpms nil
+ "List of 46 ((TYPE . LOCATION) . XPM-IMAGE) forms.
+XPM-IMAGE is an image as returned by `create-image' with
+inline data (i.e., property :data with string value).
+
+TYPE is a symbol, one of:
+ hoshi -- unoccupied position with dot
+ empty -- unoccupied position sans dot
+ bpmoku, bmoku -- black stone with and sans highlight point
+ wpmoku, wmoku -- white stone with and sans highlight point
+
+LOCATION is an integer encoding edge, corner, or center:
+ 1 2 3
+ 4 5 6
+ 7 8 9
+For instance, 4 means \"left edge\", 9 means \"bottom right\".
+
+There is only one location for hoshi: center. The other five
+types each have all possible locations. So (+ 1 (* 9 5)) => 46.
+
+The value can also be a function (satisfying `functionp') that
+takes one arg, the size of the board, and returns the appropriate
+list of forms.")
+
;;;---------------------------------------------------------------------------
;;; Variables for the inquisitive programmer
(defvar gnugo-state nil) ; hint: C-c C-p
-(eval-when-compile
- (defvar gnugo-xpms nil))
-
(defvar gnugo-frolic-parent-buffer nil)
(defvar gnugo-frolic-origin nil)
using (hash-values val)
do (push (cons key
(case key
- ((:xpms :local-xpms)
+ ((:xpms)
(format "hash: %X (%d images)"
(sxhash val)
(length val)))
(t yang)))))
(defun gnugo-toggle-image-display ()
- (unless (and (fboundp 'display-images-p) (display-images-p))
+ (unless (display-images-p)
(user-error "Display does not support images, sorry"))
- (require 'gnugo-xpms)
- (unless (and (boundp 'gnugo-xpms) gnugo-xpms)
- (user-error "Could not load `gnugo-xpms', sorry"))
- (let ((fresh (or (gnugo-get :local-xpms) gnugo-xpms)))
+ (let ((fresh (if (functionp gnugo-xpms)
+ (funcall gnugo-xpms (gnugo-get :SZ))
+ gnugo-xpms)))
+ (unless fresh
+ (user-error "Sorry, `gnugo-xpms' unset"))
(unless (eq fresh (gnugo-get :xpms))
(gnugo-put :xpms fresh)
(gnugo--forget :all-yy)))
'nowarp
t)))
-(defun gnugo--karma (color)
- (member color (cdr (gnugo-get :wheel))))
+(defun gnugo--karma (color) ; => BOOL
+ (when (member color (cdr (gnugo-get :wheel)))
+ t))
(defsubst gnugo--:karma (role)
(gnugo--karma (gnugo-get role)))
+(defun gnugo--assist-state (&optional gate)
+ (let ((bool (gnugo--:karma :user-color)))
+ (if (and bool gate)
+ (user-error "Sorry, Assist mode enabled")
+ bool)))
+
(defun gnugo--user-play (pos-or-pass)
(gnugo-gate t)
;; The "user" in this func's name used to signify both
(let ((color (gnugo-current-player)))
;; Don't get confused by mixed signals.
(when (gnugo--karma color)
- (user-error "Sorry, you cannot play for %s at this time"
- color))
+ (if (equal color (gnugo-get :one-shot))
+ (gnugo--forget :one-shot)
+ (user-error "Sorry, you cannot play for %s at this time"
+ color)))
(gnugo-push-move color pos-or-pass))
(gnugo--finish-move t))
(defun gnugo-animate-group (w/d)
;; W/D is a symbol, either ‘worm’ or ‘dragon’.
+ (gnugo-gate)
(let* ((pos (gnugo-position))
(orig-b-m-p (buffer-modified-p))
blurb stones)
t)))
(defun gnugo-display-group-data (command buffer-name)
+ (gnugo-gate)
(message "Computing %s ..." command)
(let ((data (gnugo--q "%s %s" command (gnugo-position))))
(switch-to-buffer buffer-name)
Signal error if done out-of-turn or if game-over.
See variable `gnugo-animation-string' for customization."
(interactive)
- (gnugo-gate)
(gnugo-animate-group 'worm))
(defun gnugo-worm-data ()
"Display in another buffer data from \"worm\" at current position.
Signal error if done out-of-turn or if game-over."
(interactive)
- (gnugo-gate)
(gnugo-display-group-data "worm_data" "*gnugo worm data*"))
(defun gnugo-dragon-stones ()
Signal error if done out-of-turn or if game-over.
See variable `gnugo-animation-string' for customization."
(interactive)
- (gnugo-gate)
(gnugo-animate-group 'dragon))
(defun gnugo-dragon-data ()
"Display in another buffer data from \"dragon\" at current position.
Signal error if done out-of-turn or if game-over."
(interactive)
- (gnugo-gate)
(gnugo-display-group-data "dragon_data" "*gnugo dragon data*"))
(defun gnugo-estimate-score ()
(message "Est.score ... B %s %s | W %s %s | %s"
black black-captures white white-captures est)))
+(defun gnugo--ok-file (filename)
+ (setq default-directory
+ (file-name-directory
+ (expand-file-name filename)))
+ (set-buffer-modified-p nil))
+
(defun gnugo-write-sgf-file (filename)
"Save the game history to FILENAME (even if unfinished).
If FILENAME already exists, Emacs confirms that you wish to overwrite it."
(not (y-or-n-p "File exists. Continue? ")))
(user-error "Not writing %s" filename))
(gnugo/sgf-write-file (gnugo-get :sgf-collection) filename)
- (set-buffer-modified-p nil))
+ (gnugo--ok-file filename))
(defun gnugo--dance-dance (karma)
(destructuring-bind (dance btw)
(gnugo-put :last-user-bpos
(gnugo-move-history 'bpos (gnugo-get :user-color)))
(gnugo-refresh t)
- (set-buffer-modified-p nil)
+ (gnugo--ok-file filename)
(gnugo--who-is-who wait play samep)))
(defun gnugo--mem-with-played-stone (pos &optional noerror)
return mem
finally return nil))))
-(defun gnugo--climb-towards-root (spec &optional noalt keep)
+(defun gnugo--climb-towards-root (spec &optional reaction keep)
(gnugo-gate)
+ (gnugo--assist-state t)
(let* ((user-color (gnugo-get :user-color))
(monkey (gnugo-get :monkey))
(tree (gnugo-get :sgf-gametree))
2)
spec)
(aref monkey 0))
- (let* ((pos (if (stringp spec)
- spec
- (gnugo-position)))
- (hmm (gnugo--mem-with-played-stone pos)))
- ;; todo: relax ‘gnugo--user-play’ then lift restriction
- (unless (eq (gnugo--prop<-color user-color)
- (car (gnugo--move-prop (car hmm))))
- (user-error "%s not occupied by %s"
- pos user-color))
- (cdr hmm)))))
+ (cdr (gnugo--mem-with-played-stone
+ (if (stringp spec)
+ spec
+ (gnugo-position)))))))
(when (gnugo-get :game-over)
(gnugo--unclose-game))
(while (and (not (eq stop (aref monkey 0)))
(gnugo-refresh) ; this
(redisplay)) ; eye candy
(let* ((ulastp (string= (gnugo-get :last-mover) user-color))
-
(ubpos (gnugo-move-history (if ulastp 'car 'cadr))))
(gnugo-put :last-user-bpos (if (and ubpos (not (gnugo--passp ubpos)))
ubpos
(gnugo-refresh t)
(unless (or keep remorseful)
(aset ends (aref monkey 1) (aref monkey 0)))
- (when (and ulastp (not noalt))
- (let ((wheel (gnugo-get :wheel)))
- ;; ugh, backward compat
- ;; todo: add auto-Zombie (see also "relax" above)
- (letf (((cdr wheel) (remove (gnugo-get :gnugo-color)
- (cdr wheel))))
- (gnugo--turn-the-wheel t)))))))
+ (when ulastp
+ (let ((g (gnugo-get :gnugo-color)))
+ (cl-flet ((turn () (gnugo--turn-the-wheel t)))
+ (case (or reaction gnugo-undo-reaction)
+ (play (turn))
+ (play! (let ((wheel (gnugo-get :wheel)))
+ (letf (((cdr wheel) (cons g (cdr wheel))))
+ (turn))))
+ (zombie (gnugo-zombie-mode 1))
+ (t (gnugo-put :one-shot g)))))))))
(defun gnugo-undo-one-move (&optional me-next)
"Undo exactly one move (perhaps GNU Go's, perhaps yours).
(gnugo-gate)
(when me-next
(let* ((play (gnugo-get :last-mover))
- (wait (gnugo-other play)))
- (gnugo--who-is-who wait play (string= play (gnugo-get :user-color)))
+ (wait (gnugo-other play))
+ (samep (string= play (gnugo-get :user-color))))
(gnugo-put :user-color play)
- (gnugo-put :gnugo-color wait)))
- (gnugo--climb-towards-root 1 t))
+ (gnugo-put :gnugo-color wait)
+ (gnugo--who-is-who wait play samep)))
+ (gnugo--climb-towards-root 1 (case gnugo-undo-reaction
+ (zombie gnugo-undo-reaction)
+ (t 'one-shot))))
(defun gnugo-undo-two-moves ()
"Undo a pair of moves (GNU Go's and yours).
(gnugo--decorate node :C comment)))
(defun gnugo--struggle (prop updn)
- (unless (eq ; drudgery avoidance
- (when (gnugo--:karma prop) ; normalize
- t)
- updn)
+ (unless (eq updn (gnugo--:karma prop)) ; drudgery avoidance
(let ((color (gnugo-get prop)))
(if updn
;; enable
a move to play for you, the thinking is not cancelled but instead
transformed into a move suggestion (see `gnugo-request-suggestion')."
:variable
- ((gnugo--:karma :user-color)
+ ((gnugo--assist-state)
.
(lambda (bool)
(gnugo--struggle :user-color bool))))