(when (gnugo-get :waitingp)
(user-error "Not your turn yet -- please wait for \"\(%s to play\)\""
(gnugo-get :user-color)))
- (when (and (gnugo-get :game-over) in-progress-p)
+ (when (and in-progress-p (gnugo-get :game-over))
(user-error "Sorry, game over")))
(defun gnugo-sentinel (proc string)
(or (assq :B node)
(assq :W node)))
-(defun gnugo--as-pos-func (size)
- (lexical-let ((size size))
+(defun gnugo--as-pos-func ()
+ (lexical-let ((size (gnugo-get :SZ)))
;; rv
(lambda (cc)
(if (string= "" cc)
(interactive "P")
(let* ((monkey (gnugo-get :monkey))
(mem (aref monkey 0))
- (as-pos (gnugo--as-pos-func (gnugo-get :SZ)))
+ (as-pos (gnugo--as-pos-func))
acc node mprop move)
(cl-flet*
((as-pos-maybe (x) (if (string= "resign" x)
(width (length ends))
(lanes (number-sequence 0 (1- width)))
(monkey (gnugo-get :monkey))
- (as-pos (gnugo--as-pos-func (gnugo-get :SZ)))
+ (as-pos (gnugo--as-pos-func))
(at (car (aref monkey 0)))
(bidx (aref monkey 1))
(valid (map 'vector (lambda (end)
(gethash node seen))
(emph (s face)
(propertize s 'face face))
- (fsi (fmt &rest args)
- (insert (apply 'format fmt args))))
+ (fsi (properties fmt &rest args)
+ (insert (apply 'propertize
+ (apply 'format fmt args)
+ properties))))
;; breathe in
(loop
for bx below width
(set (make-local-variable 'gnugo-state)
(buffer-local-value 'gnugo-state from))
(loop
+ with props
for n ; move number
from max-move-num downto 1
+ do (setq props (list 'n n))
do
(loop
with (move forks br)
initially (progn
(goto-char (point-min))
- (fsi "%3d %s -- "
+ (fsi props
+ "%3d %s -- "
n (aref ["W" "B"] (logand 1 n))))
for bx below width
do (let* ((node (unless (< (aref valid bx) n)
(when (and ok (setq br (gethash node soil)))
(push (cons bx (sort br '<))
forks))
- (fsi " %-5s"
+ (fsi (list* 'bx bx props)
+ " %-5s"
(cond ((and (eq at node)
(or ok (= bx bidx)))
(when (= bx bidx)
(emph s dimmed-node-face))
(t s))))
finally do
- (when (progn (newline)
+ (when (progn (fsi props "\n")
(setq forks (nreverse forks)))
(let* ((margin (make-string 11 ?\s))
(heads (mapcar #'car forks))
(interactive "p")
(gnugo--sideways nil n))
+(defun gnugo--vertical (n direction)
+ (when (> 0 n)
+ (setq n (- n)
+ direction (- direction)))
+ (gnugo--awakened ((line . numeric)
+ (omit tree ends width monkey bidx))
+ (let ((stop (if (> 0 direction)
+ 0
+ (max 0 (1- (count-lines (point-min)
+ (point-max))))))
+ (col (unless a
+ (current-column))))
+ (loop while (not (= line stop))
+ do (loop do (progn
+ (forward-line direction)
+ (incf line direction))
+ until (get-text-property (point) 'n))
+ until (zerop (decf n)))
+ (if a
+ (gnugo--move-to-bcol a)
+ (move-to-column col)))))
+
+(defun gnugo-frolic-previous-move (&optional n)
+ "Move to the Nth (default 1) previous move."
+ (interactive "p")
+ (gnugo--vertical n -1))
+
+(defun gnugo-frolic-next-move (&optional n)
+ "Move to the Nth (default 1) next move."
+ (interactive "p")
+ (gnugo--vertical n 1))
+
(defun gnugo-boss-is-near ()
"Do `bury-buffer' until the current one is not a GNU Board."
(interactive)
0)
nil t))
+(defun gnugo-okay (&optional full)
+ "Redo a pair of undone moves.
+Prefix arg means to redo all the undone moves."
+ (interactive "P")
+ (gnugo-gate)
+ (let* ((tree (gnugo-get :sgf-gametree))
+ (ends (gnugo--tree-ends tree))
+ (monkey (gnugo-get :monkey)))
+ (if (gnugo--no-regrets monkey ends)
+ (message "Oop ack!")
+ (let* ((as-pos (gnugo--as-pos-func))
+ (mnum (gnugo--tree-mnum tree))
+ (mem (aref monkey 0))
+ (bidx (aref monkey 1))
+ (end (aref ends bidx))
+ (ucolor (gnugo-get :user-color))
+ (gcolor (gnugo-other ucolor))
+ (uprop (if (gnugo--blackp ucolor)
+ :B :W)))
+ (cl-flet ((mvno (node) (gethash node mnum)))
+ (loop
+ with ok = (if full
+ (mvno (car end))
+ (+ 2 (mvno (car mem))))
+ with (node move todo)
+ for ls on end
+ do (progn
+ (setq node (car ls)
+ move (gnugo--move-prop node))
+ (when (and move (>= ok (mvno node)))
+ (let ((userp (eq uprop (car move))))
+ (push (list (if userp ucolor gcolor)
+ userp
+ (funcall as-pos (cdr move)))
+ todo))))
+ until (eq mem (cdr ls))
+ finally do
+ (loop
+ for (color userp pos) in todo
+ do (let* ((move (format "play %s %s" color pos))
+ (accept (gnugo--q move)))
+ (unless (= ?= (aref accept 0))
+ (user-error "%s" accept))
+ (gnugo-push-move userp pos)
+ (gnugo-refresh)
+ (redisplay)))))))))
+
(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
("C" . gnugo-frolic-quit) ; like ‘View-kill-and-leave’
("\C-b" . gnugo-frolic-backward-branch)
("\C-f" . gnugo-frolic-forward-branch)
+ ("\C-p" . gnugo-frolic-previous-move)
+ ("\C-n" . gnugo-frolic-next-move)
("j" . gnugo-frolic-exchange-left)
("J" . gnugo-frolic-rotate-left)
("k" . gnugo-frolic-exchange-right)
("u" . gnugo-undo-two-moves)
("\C-?" . gnugo-undo-two-moves)
("o" . gnugo-oops)
+ ("O" . gnugo-okay)
("\C-l" . gnugo-refresh)
("\M-_" . gnugo-boss-is-near)
("_" . gnugo-boss-is-near)