-;;; gnugo.el --- play GNU Go in a buffer
+;;; gnugo.el --- play GNU Go in a buffer -*- lexical-binding: t -*-
;; Copyright (C) 2014 Free Software Foundation, Inc.
;; `RET'; to pass, `P' (note: uppercase); to quit, `q'; to undo one of your
;; moves (as well as a possibly intervening move by GNU Go), `u'. To undo
;; back through an arbitrary stone that you played, place the cursor on a
-;; stone and type `U' (note: uppercase). Other keybindings are described in
+;; stone and type `U' (note: uppercase).
+;;
+;; There are a great many other commands. Other keybindings are described in
;; the `gnugo-board-mode' documentation, which you may view with the command
;; `describe-mode' (normally `C-h m') in that buffer. The buffer name shows
;; the last move and who is currently to play. Capture counts and other info
;; `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'
;;
;;; Variables for the uninquisitive programmer
(defvar gnugo-program "gnugo"
- "Command to start an external program that speaks GTP, such as \"gnugo\".
-The value may also be in the form \"PROGRAM OPTIONS...\" in which case the
-the command `gnugo' will prefix OPTIONS in its default offering when it
-queries you for additional options. It is an error for \"--mode\" to appear
-in OPTIONS.
-
-For more information on GTP and GNU Go, feel free to visit:
-http://www.gnu.org/software/gnugo")
+ "Name of the GNU Go program (executable file).
+\\[gnugo] validates this using `executable-find'.
+This program must accept command line args:
+ --mode gtp --quiet
+For more information on GTP and GNU Go, please visit:
+<http://www.gnu.org/software/gnugo>")
(defvar gnugo-board-mode-map nil
"Keymap for GNUGO Board mode.")
(defvar gnugo-board-mode-hook nil
"Hook run when entering GNUGO Board mode.")
+(defvar gnugo-start-game-hook nil
+ "Normal hook run immediately before the first move of the game.
+To find out who is to move first, use `gnugo-current-player'.
+See also `gnugo-board-mode'.")
+
(defvar gnugo-post-move-hook nil
"Normal hook run after a move and before the board is refreshed.
Initially, when `run-hooks' is called, the current buffer is the GNUGO
46 = 9 places * (4 moku + 1 empty) + 1 hoshi; see functions
`gnugo-toggle-image-display', `gnugo-yy' and `gnugo-yang'
- :lparen-ov -- overlays shuffled about to indicate the last move; only
- :rparen-ov one is used when displaying using images
+ :paren-ov -- a pair (left and right) of overlays shuffled about to indicate
+ the last move; only one is used when displaying using images
:last-user-bpos -- board position; keep the hapless human happy
See `gnugo-put'."
(gethash key gnugo-state))
+(defun gnugo--forget (&rest keys)
+ (dolist (key keys)
+ (remhash key gnugo-state)))
+
(defsubst gnugo--tree-mnum (tree)
(aref tree 1))
(defun gnugo-other (color)
(if (gnugo--blackp color) "white" "black"))
+(defun gnugo-current-player ()
+ "Return the current player, either \"black\" or \"white\"."
+ (gnugo-other (gnugo-get :last-mover)))
+
+(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")))
'face 'font-lock-warning-face)
")]"))
(when (eq proc (gnugo-get :proc))
- (gnugo-put :proc nil))))))))
+ (gnugo--forget :proc))))))))
(defun gnugo--begin-exchange (proc filter line)
(declare (indent 2)) ; good time, for a rime
(substring (apply 'gnugo--q message-format args)
2))
+(defun gnugo--nquery (cmd)
+ (string-to-number (gnugo-query cmd)))
+
(defun gnugo-lsquery (message-format &rest args)
(split-string (apply 'gnugo-query message-format args)))
(let ((fresh (or (gnugo-get :local-xpms) gnugo-xpms)))
(unless (eq fresh (gnugo-get :xpms))
(gnugo-put :xpms fresh)
- (gnugo-put :all-yy nil)))
+ (gnugo--forget :all-yy)))
(let* ((new (not (gnugo-get :display-using-images)))
(act (if new 'display 'do-not-display)))
(mapc (lambda (yy)
(setplist yy `(not-yet ,(cdr ent)))
yy))
(gnugo-get :xpms))
- (let ((imul (image-size (get (gnugo-yy 5 (gnugo-yang ?+))
- 'not-yet))))
- (gnugo-put :w-imul (car imul))
- (gnugo-put :h-imul (cdr imul)))))))
+ (gnugo-put :imul
+ (image-size (get (gnugo-yy 5 (gnugo-yang ?+))
+ 'not-yet)))))))
(setplist (gnugo-f 'ispc) (and new '(display (space :width 0))))
(gnugo-put :highlight-last-move-spec
(if new
(dolist (group (cdr (assq 'dead (gnugo-get :game-over))))
(mapc 'delete-overlay (cdar group))
(setcdr (car group) nil))
- (gnugo-put :wmul (if new (gnugo-get :w-imul) 1))
- (gnugo-put :hmul (if new (gnugo-get :h-imul) 1))
+ (gnugo-put :mul (if new
+ (gnugo-get :imul)
+ '(1 . 1)))
(gnugo-put :display-using-images new)))
(defun gnugo-toggle-grid ()
(bef (buffer-substring-no-properties (point-min) (point-max)))
(bef-start 0) (bef-idx 0)
(aft-start 0) (aft-idx 0)
- aft-sync-backtrack mis inc cut new very-strange)
+ aft-sync-backtrack mis inc cut new very-strange
+
+ (inhibit-read-only t))
(while (numberp (setq mis (gnugo--compare-strings
bef bef-start
aft aft-start)))
(+ ?A (- (if (> ?i col) col (1+ col)) ?a))
(- size (- (aref cc 1) ?a))))))))
-(defun gnugo-move-history (&optional rsel)
+(defun gnugo-move-history (&optional rsel color)
"Determine and return the game's move history.
Optional arg RSEL controls side effects and return value.
If nil, display the history in the echo area as \"(N moves)\"
followed by the space-separated list of moves. When called
interactively with a prefix arg (i.e., RSEL is `(4)'), display
similarly, but suffix with the mover (either \":B\" or \":W\").
-If RSEL is the symbol `car' return the most-recent move; if
-`cadr', the next-to-most-recent move; if `count' the number of
-moves thus far; if `two' the last two moves as a list, oldest last.
-
+RSEL may also be a symbol that selects what to return:
+ car -- the most-recent move
+ cadr -- the next-to-most-recent move
+ two -- the last two moves as a list, oldest last
+ bpos -- the last stone on the board placed by COLOR
For all other values of RSEL, do nothing and return nil."
(interactive "P")
(let* ((monkey (gnugo-get :monkey))
((as-pos-maybe (x) (if (string= "resign" x)
x
(funcall as-pos x)))
- (next (byp) (when (setq node (pop mem)
- mprop (gnugo--move-prop node))
- (setq move (as-pos-maybe (cdr mprop)))
+ (remem () (setq node (pop mem)
+ mprop (gnugo--move-prop node)))
+ (pretty () (setq move (as-pos-maybe (cdr mprop))))
+ (next (byp) (when (remem)
+ (pretty)
(push (if byp
(format "%s%s" move (car mprop))
move)
(`nil (finish nil))
(`car (car (nn)))
(`cadr (nn) (car (nn)))
- (`count (gethash (car mem) (gnugo--tree-mnum
- (gnugo-get :sgf-gametree))))
(`two (nn) (nn) acc)
+ (`bpos (loop with prop = (gnugo--prop<-color color)
+ when (and (remem)
+ (eq prop (car mprop))
+ (pretty)
+ (not (string= "resign" move))
+ (not (gnugo--passp move)))
+ return move))
(_ nil)))))
(define-derived-mode gnugo-frolic-mode special-mode "GNUGO Frolic"
(dead ,@dead))))))
(defun gnugo--unclose-game ()
- (dolist (prop '(:game-over ; all those in -close-game
- :scoring-seed
- :game-end-time))
- (gnugo-put prop nil))
+ (gnugo--forget :game-over ; all those in -close-game
+ :scoring-seed
+ :game-end-time)
(let* ((root (gnugo--root-node))
(cur (assq :RE root)))
(when cur
(string= ucolor color))
(gnugo-put :last-user-bpos (and (not passp) (not resignp) move)))
;; update :sgf-gametree and :monkey
- (let* ((property (if (gnugo--blackp color)
- :B :W))
+ (let* ((property (gnugo--prop<-color color))
(pair (cons property (cond (resignp move)
(passp "")
(t (funcall (gnugo--as-cc-func)
seems corrupted.) NOCACHE is silently ignored when GNU Go is thinking about
its move."
(interactive "P")
- (when (and nocache (not (gnugo-get :waiting)))
- (gnugo-propertize-board-buffer))
(let* ((last-mover (gnugo-get :last-mover))
(other (gnugo-other last-mover))
(move (gnugo-move-history 'car))
(game-over (gnugo-get :game-over))
+ (inhibit-read-only t)
window last)
+ (when (and nocache (not (gnugo-get :waiting)))
+ (gnugo-propertize-board-buffer))
;; last move
(when move
- (let ((l-ov (gnugo-get :lparen-ov))
- (r-ov (gnugo-get :rparen-ov)))
+ (destructuring-bind (l-ov . r-ov) (gnugo-get :paren-ov)
(if (member move '("PASS" "resign"))
(mapc 'delete-overlay (list l-ov r-ov))
(gnugo-goto-pos move)
(let* ((gridp (not (memq :nogrid buffer-invisibility-spec)))
(size (gnugo-get :SZ))
(under10p (< size 10))
+ (mul (gnugo-get :mul))
(h (- (truncate (- (window-height window)
- (* size (gnugo-get :hmul))
+ (* size (cdr mul))
(if gridp 2 0))
2)
(if gridp 0 1)))
(edges (window-edges window))
(right-w-edge (nth 2 edges))
(avail-width (- right-w-edge (nth 0 edges)))
- (wmul (gnugo-get :wmul))
+ (wmul (car mul))
(imagesp (symbol-plist (gnugo-f 'ispc)))
(w (/ (- avail-width
(* size wmul)
,(case c
(?b '(or (gnugo-get :black-captures) 0))
(?w '(or (gnugo-get :white-captures) 0))
- (?p '(gnugo-other (gnugo-get :last-mover)))
+ (?p '(gnugo-current-player))
(?t '(let ((ws (gnugo-get :waiting-start)))
(if ws
(cadr (time-since ws))
"-")))
(?u '(or (gnugo-get :last-waiting) "-"))
- (?m '(gnugo-move-history 'count))))
+ (?m '(let ((tree (gnugo-get :sgf-gametree))
+ (monkey (gnugo-get :monkey)))
+ (gethash (car (aref monkey 0))
+ (gnugo--tree-mnum tree)
+ ;; should be unnecessary
+ "?")))))
acc))
`(let ,(delete-dups (copy-sequence acc))
(format ,cur ,@(reverse (mapcar 'car acc))))))
(destructuring-bind (pos-or-pass color . suggestion)
(cons (match-string 1 full)
(gnugo-get :waiting))
- (gnugo-put :get-move-string nil)
- (gnugo-put :waiting nil)
+ (gnugo--forget :get-move-string
+ :waiting)
(if suggestion
(progn
(gnugo--rename-buffer-portion t)
"Do `gnugo-move' at mouse location."
(interactive "@e")
(mouse-set-point e)
- (when (looking-at "[.+]")
+ (when (memq (following-char) '(?. ?+))
(gnugo-move)))
(defun gnugo-pass ()
(defsubst gnugo--nodep (x)
(keywordp (caar x)))
-(defsubst gnugo--SZ! (size)
- (gnugo-put :SZ size))
+(defun gnugo--SZ! (size)
+ (gnugo-put :SZ size)
+ (gnugo-put :center-position
+ (funcall (gnugo--as-pos-func)
+ (let ((c (+ -1 ?a (truncate (1+ size) 2))))
+ (string c c)))))
+
+(defun gnugo--plant-and-climb (collection &optional sel)
+ (gnugo-put :sgf-collection collection)
+ (let ((tree (nth (or sel 0) collection)))
+ (gnugo-put :sgf-gametree tree)
+ (gnugo-put :monkey (vector
+ ;; mem
+ (aref (gnugo--tree-ends tree) 0)
+ ;; bidx
+ 0))
+ tree))
(defun gnugo-read-sgf-file (filename)
"Load the first game tree from FILENAME, a file in SGF format."
(interactive "fSGF file to load: ")
(when (file-directory-p filename)
(user-error "Cannot load a directory (try a filename with extension .sgf)"))
- (let (ans play wait samep coll tree)
+ (let (ans play wait samep coll tree game-over)
;; problem: requiring GTP `loadsgf' complicates network subproc support;
;; todo: skip it altogether when confident about `gnugo/sgf-create'
(unless (= ?= (aref (setq ans (gnugo--q "loadsgf %s"
(gnugo-put :gnugo-color wait)
(gnugo-put :user-color play))
(setq coll (gnugo/sgf-create filename)
- tree (nth (let ((n (length coll)))
- ;; This is better:
- ;; (if (= 1 n)
- ;; 0
- ;; (let* ((q (format "Which game? (1-%d)" n))
- ;; (choice (1- (read-number q 1))))
- ;; (if (and (< -1 choice) (< choice n))
- ;; choice
- ;; (message "(Selecting the first game)")
- ;; 0)))
- ;; but this is what we use (for now) to accomodate
- ;; (aka faithfully mimic) GTP `loadsgf' limitations:
- (unless (= 1 n)
- (message "(Selecting the first game)"))
- 0)
- coll))
- (gnugo-put :sgf-collection coll)
- (gnugo-put :sgf-gametree tree)
- (gnugo-put :monkey (vector (aref (gnugo--tree-ends tree) 0) 0))
+ tree (gnugo--plant-and-climb
+ coll (let ((n (length coll)))
+ ;; This is better:
+ ;; (if (= 1 n)
+ ;; 0
+ ;; (let* ((q (format "Which game? (1-%d)" n))
+ ;; (choice (1- (read-number q 1))))
+ ;; (if (and (< -1 choice) (< choice n))
+ ;; choice
+ ;; (message "(Selecting the first game)")
+ ;; 0)))
+ ;; but this is what we use (for now) to accomodate
+ ;; (aka faithfully mimic) GTP `loadsgf' limitations:
+ (unless (= 1 n)
+ (message "(Selecting the first game)"))
+ 0)))
;; This is deliberately undocumented for now.
(gnugo--SZ! (gnugo--root-prop :SZ tree))
- (let (game-over)
- (gnugo-put :game-over
- (setq game-over
- (or (gnugo--root-prop :RE tree)
- (and (equal '("PASS" "PASS") (gnugo-move-history 'two))
- 'two-passes))))
- (when (and game-over
- ;; (maybe) todo: user var to inhibit (can be slow)
- t)
- (gnugo-close-game nil game-over)))
+ (when (setq game-over (or (gnugo--root-prop :RE tree)
+ (when (equal '("PASS" "PASS")
+ (gnugo-move-history 'two))
+ 'two-passes)))
+ (gnugo-close-game nil game-over))
+ (gnugo-put :last-user-bpos
+ (gnugo-move-history 'bpos (gnugo-get :user-color)))
(gnugo-refresh t)
(set-buffer-modified-p nil)
(gnugo--who-is-who wait play samep)))
(unless (= ?= (aref ans 0))
(user-error "%s" ans))
(pop (aref monkey 0))
- (gnugo-put :last-mover (gnugo-other (gnugo-get :last-mover)))
+ (gnugo-put :last-mover (gnugo-current-player))
(gnugo-merge-showboard-results) ; all
(gnugo-refresh) ; this
(decf n) ; is
See also `gnugo-undo-two-moves'."
(interactive "P")
(gnugo-gate)
- (gnugo-magic-undo 1 t)
(when me-next
- (let* ((wait (gnugo-get :last-mover))
- (play (gnugo-other wait)))
+ (let* ((play (gnugo-get :last-mover))
+ (wait (gnugo-other play)))
(gnugo--who-is-who wait play (string= play (gnugo-get :user-color)))
(gnugo-put :user-color play)
- (gnugo-put :gnugo-color wait))))
+ (gnugo-put :gnugo-color wait)))
+ (gnugo-magic-undo 1 t))
(defun gnugo-undo-two-moves ()
"Undo a pair of moves (GNU Go's and yours).
(bidx (aref monkey 1))
(end (aref ends bidx))
(ucolor (gnugo-get :user-color))
- (uprop (if (gnugo--blackp ucolor)
- :B :W)))
+ (uprop (gnugo--prop<-color ucolor)))
(cl-flet ((mvno (node) (gethash node mnum)))
(loop
with ok = (if full
(let ((node (car (aref (gnugo-get :monkey) 0))))
(gnugo--decorate
(delq (assq :C node) node)
- (with-temp-buffer
+ (with-temp-buffer ; lame
(insert blurb)
+ (when (search-backward "\n\nGame start:" nil t)
+ (delete-region (point) (point-max)))
(cl-flet ((rep (old new)
(goto-char (point-min))
(while (search-forward old nil t)
(replace-match new))))
+ (rep "The game is over. " "")
(rep "territory" "T")
(rep "captures" "C")
(rep "komi" "K"))
(warning ""))
(if abd
;; disable
- (destructuring-bind (gcolor ucolor &optional color . suggestion)
- (list* (gnugo-get :gnugo-color)
- (gnugo-get :user-color)
- (gnugo-get :waiting))
- (assert (not suggestion))
+ (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-put :abd nil)
- (unless color
+ (gnugo--forget :abd)
+ (unless (gnugo-get :waiting)
(gnugo-get-move gcolor)))
;; enable
(gnugo--gate-game-over t)
;;;---------------------------------------------------------------------------
;;; Major mode for interacting with a GNUGO subprocess
-(put 'gnugo-board-mode 'mode-class 'special)
-(defun gnugo-board-mode ()
+(define-derived-mode gnugo-board-mode special-mode "GNUGO Board"
"Major mode for playing GNU Go.
Entering this mode runs the normal hook `gnugo-board-mode-hook'.
In this mode, keys do not self insert.
\\{gnugo-board-mode-map}"
- (switch-to-buffer (generate-new-buffer "(Uninitialized GNUGO Board)"))
(buffer-disable-undo) ; todo: undo undo undoing
- (kill-all-local-variables)
- (use-local-map gnugo-board-mode-map)
- (set (make-local-variable 'font-lock-defaults)
- '(gnugo-font-lock-keywords t))
- (setq major-mode 'gnugo-board-mode
- mode-name "GNUGO Board"
+ (setq font-lock-defaults '(gnugo-font-lock-keywords t)
truncate-lines t)
(add-hook 'kill-buffer-hook 'gnugo-cleanup nil t)
(set (make-local-variable 'gnugo-state)
(gnugo--mkht :size (1- 42)))
- (add-to-invisibility-spec :nogrid)
- (mapc (lambda (prop)
- (gnugo-put prop nil)) ; todo: separate display/game aspects;
- '(:game-over ; move latter to func `gnugo'
- :waiting
- :last-waiting
- :black-captures
- :white-captures
- :mode-line
- :mode-line-form
- :display-using-images
- :xpms
- :local-xpms
- :all-yy))
- (let ((name (if (string-match "[ ]" gnugo-program)
- (let ((p (substring gnugo-program 0 (match-beginning 0)))
- (o (substring gnugo-program (match-end 0)))
- (h (or (car gnugo-option-history) "")))
- (when (string-match "--mode" o)
- (user-error "Found \"--mode\" in `gnugo-program'"))
- (when (and o (cl-plusp (length o))
- h (cl-plusp (length o))
- (or (< (length h) (length o))
- (not (string= (substring h 0 (length o))
- o))))
- (push (concat o " " h) gnugo-option-history))
- p)
- gnugo-program))
- (args (read-string "GNU Go options: "
- (car gnugo-option-history)
- 'gnugo-option-history))
- proc
- board-size user-color handicap komi minus-l infile)
- (loop for (var default opt rx)
- in '((board-size 19 "--boardsize")
- (user-color "black" "--color" "\\(black\\|white\\)")
- (handicap 0 "--handicap")
- (komi 0.0 "--komi")
- (minus-l nil "\\([^-]\\|^\\)-l[ ]*" "[^ ]+")
- (infile nil "--infile" "[ ]*[^ ]+"))
- do (set var
- (or (when (string-match opt args)
- (let ((start (match-end 0)) s)
- (string-match (or rx "[0-9.]+") args start)
- (setq s (match-string 0 args))
- (if rx s (string-to-number s))))
- default)))
- (gnugo-put :user-color user-color)
- (let ((proc-args (split-string args)))
- (gnugo-put :proc-args proc-args)
- (gnugo-put :proc (setq proc (apply 'start-process "gnugo"
- (current-buffer) name
- "--mode" "gtp" "--quiet"
- proc-args))))
- (set-process-sentinel proc 'gnugo-sentinel)
- ;; Emacs is too protective sometimes, blech.
- (set-process-query-on-exit-flag proc nil)
- (when (or minus-l infile)
- (loop for (prop q)
- in '((board-size "query_boardsize")
- (komi "get_komi")
- (handicap "get_handicap"))
- do (set prop (string-to-number (gnugo-query q)))))
- (gnugo-put :diamond (substring (process-name proc) 5))
- (gnugo-put :gnugo-color (gnugo-other user-color))
- (gnugo-put :highlight-last-move-spec
- (gnugo-put :default-highlight-last-move-spec '("(" -1 nil)))
- (gnugo-put :lparen-ov (make-overlay 1 1))
- (gnugo-put :rparen-ov (let ((ov (make-overlay 1 1)))
- (overlay-put ov 'display ")")
- ov))
- (let* ((coll (gnugo/sgf-create "(;FF[4]GM[1])" t))
- (tree (car coll)))
- (gnugo-put :sgf-gametree tree)
- (gnugo-put :sgf-collection coll)
- (gnugo-put :monkey (vector (aref (gnugo--tree-ends tree) 0) 0)))
- (gnugo--SZ! board-size)
- (let ((root (gnugo--root-node)))
- (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! :SZ board-size
- :DT (format-time-string "%Y-%m-%d")
- :RU (if (string-match "--chinese-rules" args)
- "Chinese"
- "Japanese")
- :AP (cons "gnugo.el" gnugo-version)
- :KM komi)
- (let ((gb (gnugo--blackp (gnugo-other user-color))))
- (r! (if gb :PW :PB) (user-full-name)
- (if gb :PB :PW) (concat "GNU Go " (gnugo-query "version"))))
- (unless (zerop handicap)
- (r! :HA handicap
- :AB (mapcar (gnugo--as-cc-func)
- (gnugo-lsquery "fixed_handicap %d"
- handicap)))))))
- (gnugo-put :waiting-start (current-time))
- (gnugo-put :hmul 1)
- (gnugo-put :wmul 1)
- (run-hooks 'gnugo-board-mode-hook)
- (gnugo-refresh t))
+ (gnugo-put :highlight-last-move-spec
+ (gnugo-put :default-highlight-last-move-spec '("(" -1 nil)))
+ (gnugo-put :paren-ov (cons (make-overlay 1 1)
+ (let ((ov (make-overlay 1 1)))
+ (overlay-put ov 'display ")")
+ ov)))
+ (gnugo-put :mul '(1 . 1))
+ (add-to-invisibility-spec :nogrid))
;;;---------------------------------------------------------------------------
;;; Entry point
;;;###autoload
(defun gnugo (&optional new-game)
"Run gnugo in a buffer, or resume a game in progress.
-Prefix arg means skip the game-in-progress check and start a new
-game straight away.
-\\<gnugo-board-mode-map>
-To play, use \\[gnugo-move] to place a stone or \\[gnugo-pass] to pass.
+If there is already a game in progress you may resume it instead
+of starting a new one. Prefix arg means skip the game-in-progress
+check and start a new game straight away.
-You are queried for additional command-line options (Emacs supplies
-\"--mode gtp --quiet\" automatically). Here is a list of options
-that gnugo.el understands and handles specially:
+Before starting, Emacs queries you for additional command-line
+options (Emacs supplies \"--mode gtp --quiet\" automatically).
- --boardsize num Set the board size to use (5--19)
- --color <color> Choose your color ('black' or 'white')
- --handicap <num> Set the number of handicap stones (0--9)
+Note that specifying \"--infile FILENAME\" (or, \"-l FILENAME\")
+silently clobbers certain other options, such as \"--color\".
+For details, see info node `(gnugo) Invoking GNU Go'.
-If there is already a game in progress you may resume it instead of
-starting a new one. See `gnugo-board-mode' documentation for more info."
+\\<gnugo-board-mode-map>
+To play, use \\[gnugo-move] to place a stone or \\[gnugo-pass] to pass.
+See `gnugo-board-mode' for a full list of commands."
(interactive "P")
(let* ((all (let (acc)
(dolist (buf (buffer-list))
(if (string= "" sel)
(car all)
(assoc sel all))))))
+ ;; sanity check
+ (unless (executable-find gnugo-program)
+ (user-error "Invalid `gnugo-program': %S" gnugo-program))
;; set up a new board
+ (switch-to-buffer (generate-new-buffer "(Uninitialized GNUGO Board)"))
(gnugo-board-mode)
- (let ((half (truncate (1+ (gnugo-get :SZ)) 2)))
- (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))))
+ (let* ((filename nil)
+ (user-color "black")
+ (args (loop
+ with ls = (split-string
+ ;; todo: grok ‘gnugo --help’; completion
+ (read-string
+ "GNU Go options: "
+ (car gnugo-option-history)
+ 'gnugo-option-history))
+ with ok
+ while ls do
+ (let ((arg (pop ls)))
+ (cl-flet
+ ((ex (opt fn)
+ (if filename
+ (warn "%s %s ignored" opt fn)
+ (setq filename fn))))
+ (cond
+ ((string= "--color" arg)
+ (push arg ok)
+ (push
+ ;; Unfortunately, GTP does not provide
+ ;; a way to query the user color, so
+ ;; we must resort to this weirdness.
+ (setq user-color
+ (pop ls))
+ ok))
+ ((string= "--infile" arg)
+ (ex "--infile" (pop ls)))
+ ((string-match "^-l" arg)
+ (ex "-l" (if (< 2 (length arg))
+ (substring arg 2)
+ (pop ls))))
+ (t (push arg ok)))))
+ finally return (nreverse ok)))
+ (proc (apply 'start-process "gnugo"
+ (current-buffer)
+ gnugo-program
+ "--mode" "gtp" "--quiet"
+ args))
+ root board-size handicap komi)
+ (gnugo-put :user-color user-color)
+ (gnugo-put :proc proc)
+ (set-process-sentinel proc 'gnugo-sentinel)
+ ;; Emacs is too protective sometimes, blech.
+ (set-process-query-on-exit-flag proc nil)
+ (gnugo-put :diamond (substring (process-name proc) 5))
+ (gnugo-put :gnugo-color (gnugo-other user-color))
+ (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))))))
+ (gnugo--SZ!
+ (setq root (gnugo--root-node
+ (gnugo--plant-and-climb
+ (gnugo/sgf-create "(;FF[4]GM[1])" t)))
+ komi (gnugo--nquery "get_komi")
+ handicap (gnugo--nquery "get_handicap")
+ board-size (gnugo--nquery "query_boardsize")))
+ (r! :SZ board-size
+ :DT (format-time-string "%Y-%m-%d")
+ :RU (if (member "--chinese-rules" args)
+ "Chinese"
+ "Japanese")
+ :AP (cons "gnugo.el" gnugo-version)
+ :KM komi)
+ (let ((ub (gnugo--blackp user-color)))
+ (r! (if ub :PW :PB) (concat "GNU Go " (gnugo-query "version"))
+ (if ub :PB :PW) (user-full-name)))
+ (unless (zerop handicap)
+ (r! :HA handicap
+ :AB (mapcar (gnugo--as-cc-func)
+ (gnugo-lsquery "fixed_handicap %d"
+ handicap)))))))
+ (gnugo-put :waiting-start (current-time))
+ (gnugo-refresh t)
+ (gnugo-goto-pos (or (gnugo-get :last-user-bpos)
+ (gnugo-get :center-position)))
;; first move
(gnugo-put :game-start-time (current-time))
(let ((g (gnugo-get :gnugo-color))
(n (or (gnugo--root-prop :HA) 0))
(u (gnugo-get :user-color)))
- (gnugo-put :last-mover g)
- (when (or (and (gnugo--blackp u) (< 1 n))
- (and (gnugo--blackp g) (< n 2)))
- (gnugo-put :last-mover u)
+ (unless (gnugo-get :last-mover)
+ (gnugo-put :last-mover
+ (if (or (and (gnugo--blackp u) (< 1 n))
+ (and (gnugo--blackp g) (< n 2)))
+ u
+ g)))
+ (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))))))
(mapc (lambda (pair)
(define-key gnugo-frolic-mode-map (car pair) (cdr pair)))
'(("q" . gnugo-frolic-quit)
+ ("Q" . gnugo-frolic-quit)
("C" . gnugo-frolic-quit) ; like ‘View-kill-and-leave’
("\C-b" . gnugo-frolic-backward-branch)
("\C-f" . gnugo-frolic-forward-branch)
:output :discard
:post-thunk (lambda ()
(gnugo--unclose-game)
- (gnugo-put :last-mover nil)
+ (gnugo--forget :last-mover)
;; ugh
- (gnugo--SZ! (string-to-number
- (gnugo-query
- "query_boardsize")))
+ (gnugo--SZ! (gnugo--nquery "query_boardsize"))
(gnugo-refresh t)))
(deffull loadsgf