;; `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)
+(defvar gnugo-btw nil)
+
;;;---------------------------------------------------------------------------
;;; Support functions
using (hash-values val)
do (push (cons key
(case key
- ((:xpms :local-xpms)
+ ((:xpms)
(format "hash: %X (%d images)"
(sxhash val)
(length val)))
(defsubst gnugo--prop<-color (color)
(if (gnugo--blackp color) :B :W))
-(defsubst gnugo--gate-game-over (enable)
- (when (and enable (gnugo-get :game-over))
- (user-error "Sorry, game over")))
-
-(defun gnugo--ERR-wait (color why)
- (user-error "%s -- please wait for \"(%s to play)\""
- why color))
-
(defun gnugo-gate (&optional in-progress-p)
(unless (gnugo-board-buffer-p)
(user-error "Wrong buffer -- try M-x gnugo"))
(unless (gnugo-get :proc)
(user-error "No \"gnugo\" process!"))
- (let ((slow (gnugo-get :waiting)))
- (when slow
- (gnugo--ERR-wait (gnugo-get :user-color)
- (if (cdr slow)
- "Still thinking"
- "Not your turn yet"))))
- (gnugo--gate-game-over in-progress-p))
+ (destructuring-bind (&optional color . suggestion)
+ (gnugo-get :waiting)
+ (when color
+ (apply 'user-error
+ "%s -- please wait for \"(%s to play)\""
+ (if suggestion
+ (list "Still thinking"
+ color)
+ (list "Not your turn yet"
+ (gnugo-other color))))))
+ (when (and in-progress-p (gnugo-get :game-over))
+ (user-error "Sorry, game over")))
(defun gnugo-sentinel (proc string)
(let ((status (process-status proc)))
(prog1 (substring (process-get proc :srs) 0 -2)
(process-put proc :srs ""))))
+(defsubst gnugo--no-worries (string)
+ (= ?= (aref string 0)))
+
(defun gnugo--q/ue (fmt &rest args)
(let ((ans (apply 'gnugo--q fmt args)))
- (unless (= ?= (aref ans 0))
+ (unless (gnugo--no-worries ans)
(user-error "%s" ans))
(substring ans 2)))
(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)))
(+ ?A (- (if (> ?i col) col (1+ col)) ?a))
(- size (- (aref cc 1) ?a))))))))
+(defsubst gnugo--resignp (string)
+ (string= "resign" string))
+
+(defsubst gnugo--passp (string)
+ (string= "PASS" string))
+
(defun gnugo-move-history (&optional rsel color)
"Determine and return the game's move history.
Optional arg RSEL controls side effects and return value.
(as-pos (gnugo--as-pos-func))
acc node mprop move)
(cl-flet*
- ((as-pos-maybe (x) (if (string= "resign" x)
+ ((as-pos-maybe (x) (if (gnugo--resignp x)
x
(funcall as-pos x)))
(remem () (setq node (pop mem)
mprop (gnugo--move-prop node)))
- (pretty () (setq move (as-pos-maybe (cdr mprop))))
(next (byp) (when (remem)
- (pretty)
+ (setq move (as-pos-maybe (cdr mprop)))
(push (if byp
(format "%s%s" move (car mprop))
move)
(`cadr (nn) (car (nn)))
(`two (nn) (nn) acc)
(`bpos (loop with prop = (gnugo--prop<-color color)
+ while mem
when (and (remem)
(eq prop (car mprop))
- (pretty)
- (not (string= "resign" move))
- (not (gnugo--passp move)))
- return move))
+ (setq move (cdr mprop))
+ ;; i.e., "normal CC" position
+ (= 2 (length move)))
+ return (funcall as-pos move)))
(_ nil)))))
(define-derived-mode gnugo-frolic-mode special-mode "GNUGO Frolic"
;; require-valid-branch
;; (line . numeric)
;; (line . move-string)
+ ;; (omit . [VAR...])
;; Invalid elements blissfully ignored. :-D
(let* ((tree (gnugo-get :sgf-gametree))
(ends (gnugo--tree-ends tree))
(while (gnugo-board-buffer-p)
(bury-buffer)))
-(defsubst gnugo--passp (string)
- (string= "PASS" string))
-
(defsubst gnugo--no-regrets (monkey ends)
(eq (aref ends (aref monkey 1))
(aref monkey 0)))
(substring pos 1))))))
(format "%c%c" one two)))))
-(defsubst gnugo--decorate (node alist)
- ;; NB: ALIST should not have :B or :W keys.
- (setcdr (last node) alist))
+(defun gnugo--decorate (node &rest plist)
+ (loop with tp = (last node)
+ with fruit
+ while plist
+ do (setf
+ fruit (list (cons ; DWR: LtR OoE assumed.
+ (pop plist)
+ (pop plist)))
+ (cdr tp) fruit
+ tp fruit)))
(defun gnugo-close-game (end-time resign)
(gnugo-put :game-end-time end-time)
who))
(start (gnugo-get :waiting-start))
(now (current-time))
- (resignp (string= "resign" move))
+ (resignp (gnugo--resignp move))
(passp (gnugo--passp move))
(head (gnugo-move-history 'car))
(onep (and head (gnugo--passp head)))
seems corrupted.) NOCACHE is silently ignored when GNU Go is thinking about
its move."
(interactive "P")
- (let* ((last-mover (gnugo-get :last-mover))
- (other (gnugo-other last-mover))
- (move (gnugo-move-history 'car))
+ (let* ((move (gnugo-move-history 'car))
(game-over (gnugo-get :game-over))
(inhibit-read-only t)
window last)
(rename-buffer (concat (gnugo-get :diamond)
(if game-over
(format "%s(game over)"
- (if (string= move "resign")
+ (if (gnugo--resignp move)
(concat move "ation ")
""))
(format "%s(%s to play)"
(if move (concat move " ") "")
- other))))
+ (gnugo-current-player)))))
;; pall of death
(when game-over
(let ((live (cdr (assq 'live game-over)))
;; this dynamicism is nice but excessive in its wantonness
;;- `(" [" (:eval ,form) "]")
;; this dynamicism is ok because the user triggers it
- (list (format " [%s]" (eval form))
- '(:eval (if (gnugo-get :abd)
- " Abd"
- ""))))))
+ (format " [%s]" (eval form)))))
(force-mode-line-update))
;; last user move
(when (setq last (gnugo-get :last-user-bpos))
(gnugo-goto-pos last))))
-(defun gnugo--finish-move (buf)
- (run-hooks 'gnugo-post-move-hook)
- (with-current-buffer buf
- (gnugo-refresh)))
+(defun gnugo--turn-the-wheel (&optional now)
+ (unless (gnugo-get :waiting)
+ (let ((color (gnugo-current-player))
+ (wheel (gnugo-get :wheel)))
+ (setcar wheel
+ (when (and (not (gnugo-get :game-over))
+ (member color (cdr wheel)))
+ (run-at-time
+ (if now
+ nil
+ 2) ;;; sec (frettoloso? dubioso!)
+ nil
+ (lambda (buf color wheel)
+ (setcar wheel nil)
+ (with-current-buffer buf
+ (gnugo-get-move color)))
+ (current-buffer)
+ color wheel))))))
+
+(defun gnugo--finish-move (&optional now)
+ (let ((buf (current-buffer)))
+ (run-hooks 'gnugo-post-move-hook)
+ (set-buffer buf))
+ (gnugo-refresh)
+ (gnugo--turn-the-wheel now))
;;;---------------------------------------------------------------------------
;;; Game play actions
(when (string-match old name)
(rename-buffer (replace-match new t t name))))))
+(defun gnugo--display-suggestion (color suggestion)
+ (message "%sSuggestion for %s: %s"
+ (gnugo-get :diamond)
+ color suggestion))
+
(defun gnugo-get-move-insertion-filter (proc string)
(with-current-buffer (process-buffer proc)
(let* ((so-far (gnugo-get :get-move-string))
(full (gnugo-put :get-move-string (concat so-far string))))
(when (string-match "^= \\(.+\\)\n\n" full)
- (destructuring-bind (pos-or-pass color . suggestion)
- (cons (match-string 1 full)
- (gnugo-get :waiting))
+ (setq full (match-string 1 full)) ; POS or "PASS"
+ (destructuring-bind (color . suggestion)
+ (gnugo-get :waiting)
(gnugo--forget :get-move-string
:waiting)
(if suggestion
(gnugo--rename-buffer-portion t)
(unless (or (gnugo--passp full)
(eq 'nowarp suggestion))
- (gnugo-goto-pos pos-or-pass))
- (message "%sSuggestion: %s"
- (gnugo-get :diamond)
- pos-or-pass))
- (let* ((donep (gnugo-push-move color pos-or-pass))
- (buf (current-buffer)))
- (gnugo--finish-move buf)
- (when (gnugo-get :abd)
- (gnugo-put :abd
- (unless donep
- (run-at-time
- 2 ;;; sec (frettoloso? dubioso!)
- nil (lambda (buf color)
- (with-current-buffer buf
- (gnugo-get-move color)))
- buf
- (gnugo-other color))))))))))))
+ (gnugo-goto-pos full))
+ (gnugo--display-suggestion color full))
+ (gnugo-push-move color full)
+ (gnugo--finish-move)))))))
(defun gnugo-get-move (color &optional suggestion)
(gnugo-put :waiting (cons color suggestion))
(interactive "P")
(gnugo-gate t)
(gnugo--rename-buffer-portion)
- (gnugo-get-move (gnugo-get :user-color)
+ (gnugo-get-move (gnugo-current-player)
(if nowarp
'nowarp
t)))
+(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)
- (let ((donep (gnugo-push-move t pos-or-pass))
- (buf (current-buffer)))
- (gnugo--finish-move buf)
- (unless donep
- (with-current-buffer buf
- (gnugo-get-move (gnugo-get :gnugo-color))))))
+ ;; The "user" in this func's name used to signify both
+ ;; who does the action and for whom the action is done.
+ ;; Now, it signifies only the former.
+ (let ((color (gnugo-current-player)))
+ ;; Don't get confused by mixed signals.
+ (when (gnugo--karma 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-move ()
"Make a move on the GNUGO Board buffer.
(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)
+ (aref [(moshpit " Zombie")
+ (classic nil)
+ (reverse " Zombie Assist") ; "Assist Zombie"? no thanks! :-D
+ (stilted " Assist")]
+ (cl-flet
+ ((try (n prop)
+ (if (member (gnugo-get prop)
+ karma)
+ n
+ 0)))
+ (+ (try 2 :user-color)
+ (try 1 :gnugo-color))))
+ (gnugo-put :dance dance) ; pure cruft (for now)
+ (setq gnugo-btw btw)))
(defun gnugo--who-is-who (wait play samep)
+ (unless samep
+ (let ((wheel (gnugo-get :wheel)))
+ (when wheel
+ (gnugo--dance-dance
+ (setcdr wheel (mapcar 'gnugo-other
+ (cdr wheel)))))))
(message "GNU Go %splays as %s, you as %s (%s)"
(if samep "" "now ")
wait play (if samep
(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)
+(defun gnugo--mem-with-played-stone (pos &optional noerror)
(let ((color (case (following-char)
(?X :B)
(?O :W))))
- (when color
+ (if (not color)
+ (unless noerror
+ (user-error "No stone at %s" pos))
(loop with fruit = (cons color (funcall (gnugo--as-cc-func) pos))
for mem on (aref (gnugo-get :monkey) 0)
when (equal fruit (caar mem))
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 spec)
- (hmm (or (gnugo--mem-with-played-stone pos)
- (user-error "%s already clear" 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 (not (eq stop (aref monkey 0)))
- (gnugo--q/ue "undo")
+ (while (and (not (eq stop (aref monkey 0)))
+ (gnugo--no-worries (gnugo--q "undo")))
(pop (aref monkey 0))
(gnugo-put :last-mover (gnugo-current-player))
(gnugo-merge-showboard-results) ; all
(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))
- (gnugo-get-move (gnugo-get :gnugo-color))))))
+ (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).
However, if you are the last mover, undo only one move.
Regardless, after undoing, it is your turn to play again."
(interactive)
- (gnugo-gate)
(gnugo--climb-towards-root 0))
(defun gnugo-oops (&optional position)
Prefix arg means, instead, undo repeatedly up to and including
the move which placed the stone at point, like `\\[gnugo-fancy-undo]'."
(interactive "P")
- (gnugo-gate)
- (gnugo--climb-towards-root (if position
- (gnugo-position)
+ (gnugo--climb-towards-root (unless position
0)
nil t))
(sit-for 3)))
(let ((b= " Black = ")
(w= " White = ")
- (res (when (string= "resign" (gnugo-move-history 'car))
+ (res (when (gnugo--resignp (gnugo-move-history 'car))
(gnugo-get :last-mover)))
blurb result)
(if res
(let ((node (car (aref (gnugo-get :monkey) 0))))
(gnugo--decorate
(delq (assq :C node) node)
+ :C
(with-temp-buffer ; lame
(insert blurb)
(when (search-backward "\n\nGame start:" nil t)
(rep "territory" "T")
(rep "captures" "C")
(rep "komi" "K"))
- `((:C . ,(buffer-string)))))))
+ (buffer-string)))))
(switch-to-buffer (format "%s*GNUGO Final Score*" (gnugo-get :diamond)))
(erase-buffer)
(insert blurb)))
(interactive "P")
(gnugo--climb-towards-root
(cond ((numberp count) count)
- ((consp count) (car count))
- (t (gnugo-position)))))
+ ((consp count) (car count)))))
(defun gnugo-toggle-image-display-command () ; ugh
"Toggle use of images to display the board, then refresh."
(gnugo-toggle-image-display)
(save-excursion (gnugo-refresh)))
-(defsubst gnugo--node-with-played-stone (pos)
- (car (gnugo--mem-with-played-stone pos)))
+(defsubst gnugo--node-with-played-stone (pos &optional noerror)
+ (car (gnugo--mem-with-played-stone pos noerror)))
(defun gnugo-describe-position ()
"Display the board position under cursor in the echo area.
If there a stone at that position, also display its move number."
(interactive)
(let* ((pos (gnugo-position)) ; do first (can throw)
- (node (gnugo--node-with-played-stone pos)))
+ (node (gnugo--node-with-played-stone pos t)))
(message
"%s%s" pos
(or (when node
If COMMENT is nil or the empty string, remove the property entirely."
(interactive
(let* ((pos (gnugo-position))
- (node (or (gnugo--node-with-played-stone pos)
- (user-error "No stone at %s" pos))))
+ (node (gnugo--node-with-played-stone pos)))
(list node
(read-string (format "Comment for %s: "
(gnugo-describe-position))
(cdr (assq :C node))))))
(setq node (delq (assq :C node) node))
(unless (zerop (length comment))
- (gnugo--decorate node `((:C . ,comment)))))
-
-(defun gnugo-toggle-abdication ()
- "Toggle abdication, i.e., letting GNU Go play for you.
-When enabled, the mode line includes \"Abd\".
-Enabling signals error if the game is over.
-Disabling signals error if the color \"to play\" is the user color.
-This is to ensure that the user is the next to play after disabling."
- (interactive)
- (let ((last-mover (gnugo-get :last-mover))
- (abd (gnugo-get :abd))
- (warning ""))
- (if abd
+ (gnugo--decorate node :C comment)))
+
+(defun gnugo--struggle (prop updn)
+ (unless (eq updn (gnugo--:karma prop)) ; drudgery avoidance
+ (let ((color (gnugo-get prop)))
+ (if updn
+ ;; enable
+ (gnugo-gate)
;; disable
- (let ((gcolor (gnugo-get :gnugo-color)))
- (when (string= last-mover gcolor)
- (gnugo--ERR-wait gcolor "Sorry, too soon"))
- (when (timerp abd)
- (cancel-timer abd))
- (gnugo--forget :abd)
- (unless (gnugo-get :waiting)
- (gnugo-get-move gcolor)))
- ;; enable
- (gnugo--gate-game-over t)
- (gnugo-put :abd t)
- (gnugo-get-move (gnugo-other last-mover)))
- (message "Abdication %sabled%s"
- (if (gnugo-get :abd)
- "en"
- "dis")
- warning)))
+ (let ((waiting (gnugo-get :waiting)))
+ (when (and waiting (string= color (car waiting)))
+ (gnugo--rename-buffer-portion)
+ (setcdr waiting
+ ;; heuristic: Warp only if it appears
+ ;; that the user is "following along".
+ (or (ignore-errors
+ (string= (gnugo-position)
+ (gnugo-move-history 'bpos color)))
+ 'nowarp))
+ (gnugo--display-suggestion color "forthcoming")
+ (sit-for 2))))
+ (let* ((wheel (gnugo-get :wheel))
+ (timer (car wheel))
+ (karma (cdr wheel)))
+ (when (timerp timer)
+ (cancel-timer timer))
+ (setcar wheel nil)
+ (setcdr wheel (setq karma
+ ;; walk to the west, fly to the east,
+ ;; talk and then rest, cry and then feast.
+ ;; 99 beers down thirsty throats sloshed?
+ ;; 500 years under pink mountains squashed?
+ ;; balk with the best, child now re-creased!
+ (if updn
+ (push color karma)
+ (delete color karma))))
+ (gnugo--dance-dance karma))
+ (gnugo--turn-the-wheel t))))
+
+(define-minor-mode gnugo-assist-mode
+ "If enabled (\"Assist\" in mode line), GNU Go plays for you.
+When disabling, if GNU Go has already started thinking of
+a move to play for you, the thinking is not cancelled but instead
+transformed into a move suggestion (see `gnugo-request-suggestion')."
+ :variable
+ ((gnugo--assist-state)
+ .
+ (lambda (bool)
+ (gnugo--struggle :user-color bool))))
+
+(define-minor-mode gnugo-zombie-mode
+ "If enabled (\"Zombie\" in mode line), GNU Go lets you play for it.
+When disabling, if GNU Go has already started thinking of
+a move to play, the thinking is not cancelled but instead
+transformed into a move suggestion (see `gnugo-request-suggestion')."
+ :variable
+ ((not (gnugo--:karma :gnugo-color))
+ .
+ (lambda (bool)
+ (gnugo--struggle :gnugo-color (not bool)))))
;;;---------------------------------------------------------------------------
;;; Command properties and gnugo-command
(add-hook 'kill-buffer-hook 'gnugo-cleanup nil t)
(set (make-local-variable 'gnugo-state)
(gnugo--mkht :size (1- 42)))
+ (set (make-local-variable 'gnugo-btw) nil)
+ (add-to-list 'minor-mode-alist '(gnugo-btw gnugo-btw))
(gnugo-put :highlight-last-move-spec
(gnugo-put :default-highlight-last-move-spec '("(" -1 nil)))
(gnugo-put :paren-ov (cons (make-overlay 1 1)
(if filename
(gnugo-read-sgf-file (expand-file-name filename))
(cl-flet
- ((r! (&rest plist)
- (gnugo--decorate
- root (loop ; hmm, available elsewhere?
- while plist
- collect (let* ((k (pop plist))
- (v (pop plist)))
- (cons k v))))))
+ ((r! (&rest plist) (apply 'gnugo--decorate root plist)))
(gnugo--SZ!
(setq root (gnugo--root-node
(gnugo--plant-and-climb
komi (gnugo--nquery "get_komi")
handicap (gnugo--nquery "get_handicap")
board-size (gnugo--nquery "query_boardsize")))
+ ;; Work around a GNU Go 3.8 (and possibly earlier/later)
+ ;; bug whereby GTP command ‘get_handicap’ fails to return
+ ;; the N set by ‘--handicap N’ on the command line.
+ (let ((actually (member "--handicap" args)))
+ ;; Checking ‘(zerop handicap)’ first is not strictly
+ ;; necessary; it represents a hope that some day GNU Go
+ ;; will DTRT (or provide rationale for this weird behavior)
+ ;; and become worthy of our trust.
+ (when (and (zerop handicap) actually)
+ (setq handicap (string-to-number (cadr actually)))))
(r! :SZ board-size
:DT (format-time-string "%Y-%m-%d")
:RU (if (member "--chinese-rules" args)
(and (gnugo--blackp g) (< n 2)))
u
g)))
+ (let ((karma (list g)))
+ (gnugo-put :wheel (cons nil karma))
+ (gnugo--dance-dance karma))
(run-hooks 'gnugo-start-game-hook)
- (when (and (not (gnugo-get :game-over))
- (string= g (gnugo-current-player)))
- (gnugo-refresh t)
- (gnugo-get-move g))))))
+ (gnugo--turn-the-wheel)))))
;;;---------------------------------------------------------------------------
;;; Load-time actions
("F" . gnugo-display-final-score)
("A" . gnugo-switch-to-another)
("C" . gnugo-comment)
- ("\C-c\C-a" . gnugo-toggle-abdication)
+ ("\C-c\C-a" . gnugo-assist-mode)
+ ("\C-c\C-z" . gnugo-zombie-mode)
;; mouse
([(down-mouse-1)] . gnugo-mouse-move)
([(down-mouse-2)] . gnugo-mouse-move) ; mitigate accidents