Download
(require 'cl)
(defconst mogo-version "1.0.2 (2008-05-08)")
(defconst mogo-buffer-name "*mogo*" "Name of the mogo buffer.")
(defconst mogo-process-name "mogo" "Name of the mogo process.")
(defconst mogo-handicap2 "g7 c3")
(defconst mogo-handicap3 "g7 c3 c7")
(defconst mogo-handicap4 "g7 c3 c7 g3")
(defconst mogo-handicap5 "g7 c3 c7 g3 e5")
(defconst mogo-handicap6 "g7 c3 c7 g3 c5 g5")
(defconst mogo-handicap7 "g7 c3 c7 g3 c5 g5 e5")
(defconst mogo-handicap8 "g7 c3 c7 g3 c5 g5 e3 e7")
(defconst mogo-handicap9 "g7 c3 c7 g3 c5 g5 e3 e7 e5")
(defvar mogo-command "~/bin/mogo"
"*Command to run to start the subordinate mogo process.
To run mogo over ssh, set mogo-command to \"ssh\" and do't forget
the option \"-t\" in `mogo-command-options'")
(defvar mogo-command-options nil "*Parameters for the mogo command.
See also `mogo-command'.")
(defvar mogo-mode-hook nil "*Hook run when entering MoGo mode.")
(defvar mogo-mode-map
(let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") 'mogo-send-dwim)
(define-key map (kbd "C-c ?") 'mogo-help)
(define-key map (kbd "C-c RET") 'mogo-send-command)
(define-key map (kbd "C-c C-s") 'mogo-show-board)
(define-key map (kbd "C-c C-w") 'mogo-swap-sides)
(define-key map (kbd "C-c C-g") 'mogo-genmove)
(define-key map (kbd "C-c C-p") 'mogo-pass)
(define-key map (kbd "C-c C-c") 'mogo-show-player-color)
(define-key map [right] 'mogo-forward)
(define-key map [left] 'mogo-backward)
(define-key map (kbd "M-<up>") 'mogo-back-to-board)
(define-key map (kbd "M-p") 'mogo-back-to-board)
map)
"Keymap for MoGo mode.")
(defface mogo-border-face
'((t (:foreground "blue" :weight bold)))
"Face for the goban border.")
(defface mogo-black-face
'((((class color) (background light)) (:foreground "black" :weight bold))
(((class color) (background dark)) (:foreground "green" :weight bold)))
"Face for the black stones.")
(defface mogo-white-face
'((((class color) (background light)) (:foreground "red" :weight bold))
(((class color) (background dark)) (:foreground "white" :weight bold)))
"Face for the white stones.")
(defvar mogo-mode-font-lock-keywords
'(("^ [0-9] \\(|\\)[O@. ()]*|" . (1 'mogo-border-face))
("^ [0-9] |[O@. ()]*\\(|\\)" . (1 'mogo-border-face))
("^ \\+---------------------------\\+" . 'mogo-border-face)
("O" . 'mogo-white-face)
("@" . 'mogo-black-face))
"*MoGo mode font lock patterns.")
(defvar mogo-player-color "b" "The player's color: b or w.")
(defun mogo ()
"Setup *mogo* buffer and switch to `mogo-mode'."
(interactive)
(switch-to-buffer mogo-buffer-name)
(mogo-mode))
(defun mogo-mode ()
"Major mode to interact with a mogo process whose output is in the same buffer.
\\<mogo-mode-map>\\[mogo-send-dwim] sends a command or move to the mogo process.
For details see `mogo-send-dwim'.
To (re-)display the board, for example if it has been garbled,
press \\[mogo-show-board].
Keymap:
\\{mogo-mode-map}"
(interactive)
(kill-all-local-variables)
(setq major-mode 'mogo-mode)
(setq mode-name "MoGo mode")
(use-local-map mogo-mode-map)
(setq font-lock-defaults '(mogo-mode-font-lock-keywords 't))
(put 'mogo-mode 'mode-class 'special)
(run-hooks 'mogo-mode-hook)
(unless (mogo-get-process) (mogo-start-mogo)))
(defun mogo-get-process ()
"Get mogo process by name."
(get-process mogo-process-name))
(defun mogo-start-mogo ()
"Start mogo process."
(interactive)
(insert "Starting mogo...\n\n")
(eval (append '(start-process mogo-process-name mogo-buffer-name mogo-command)
mogo-command-options))
(mogo-show-board))
(defun mogo-send-dwim ()
"Send a command or move to the mogo process.
When the command is invoked in a grid point, then the corresponding move is
sent to mogo and mogo is requested to answer the move.
\"?\" and \"help\" send \"list_commands\".
\"handicap2\" - \"handicap9\" place n fixed handicap stones.
\"swap\" changes sides.
Coordinates (including \"pass\") are passed on to mogo-move.
Everything else is passed on to mogo as it is."
(interactive)
(cond
((mogo-legal-move-on-board-p)
(mogo-move (mogo-coordinates-from-point)))
((= (point-at-eol) (point-max))
(let ((line (mogo-current-line)))
(cond
((or (equal "help" line) (equal "?" line)) (mogo-help))
((equal "swap" line) (mogo-swap-sides))
((equal "handicap2" line) (mogo-handicap mogo-handicap2))
((equal "handicap3" line) (mogo-handicap mogo-handicap3))
((equal "handicap4" line) (mogo-handicap mogo-handicap4))
((equal "handicap5" line) (mogo-handicap mogo-handicap5))
((equal "handicap6" line) (mogo-handicap mogo-handicap6))
((equal "handicap7" line) (mogo-handicap mogo-handicap7))
((equal "handicap8" line) (mogo-handicap mogo-handicap8))
((equal "handicap9" line) (mogo-handicap mogo-handicap9))
((mogo-coordinates-p line) (mogo-move line))
(t (mogo-send-command line)))))
))
(defun mogo-move-on-board-p ()
"Is the cursor on a line that that displays the board?"
(let ((line (buffer-substring (point-at-bol) (point-at-eol))))
(string-match "^ [0-9] |[O@. ()]*|" line)))
(defun mogo-legal-move-on-board-p ()
"Is the cursor on an empty intersection over the board?"
(and (mogo-move-on-board-p) (eq ?. (char-after))))
(defun mogo-current-line ()
"Get current line, strip leading \"> \" and trim the rest."
(let* ((line (buffer-substring (point-at-bol) (point-at-eol)))
(cmd (if (string-match "^> " line) (substring line 2) line)))
(string-match "^\\s-*\\(.*?\\)\\s-*$" cmd)
(match-string 1 cmd)))
(defun mogo-coordinates-from-point ()
"Compute the coordinates from the point position."
(let* ((xc (+ ?a (/ (- (current-column) 7) 3)))
(x (if (= ?i xc) "j" (string xc)))
(bol (point-at-bol))
(y (buffer-substring (+ bol 1) (+ bol 2))))
(concat x y)))
(defun mogo-coordinates-p (cmd)
"Is the command string a coordinate string or \"pass\"?"
(string-match "^\\([aAbBcCdDeEfFgGhHjJ][123456789]\\|pass\\)$" cmd))
(defun mogo-send-command (cmd)
"Send cmd plus carriage newline."
(interactive "sCommand: ")
(goto-char (point-max))
(insert "\n")
(set-marker (process-mark (mogo-get-process)) (point))
(insert "> ")
(process-send-string mogo-buffer-name (concat cmd "\n")))
(defun mogo-move (coords)
"Send move with given coordinates and ask mogo for a reply."
(mogo-send-command (concat "play " mogo-player-color " " coords))
(mogo-show-board)
(mogo-genmove))
(defun mogo-genmove ()
"Make mogo play. Equivalent to pass. Needed when playing black
in a handicap game."
(interactive)
(mogo-send-command (concat "genmove " (mogo-ai-color))))
(defalias 'mogo-pass 'mogo-genmove)
(defun mogo-ai-color ()
"The opposite color of mogo-player-color."
(mogo-opposite-color mogo-player-color))
(defun mogo-opposite-color (color)
"Map \"b\" to \"w\" and vice versa."
(case (intern color)
('b "w")
('w "b")
(t (assert nil nil "Illegal argument: %s" color))))
(defun mogo-help ()
"Get command list from mogo."
(interactive)
(mogo-send-command "list_commands"))
(defun mogo-show-board ()
"Make mogo show the board."
(interactive)
(mogo-send-command "showboard"))
(defun mogo-swap-sides ()
"Player and AI swap colors. Also, make mogo make a move."
(interactive)
(setq mogo-player-color (mogo-opposite-color mogo-player-color))
(mogo-show-player-color))
(defun mogo-show-player-color ()
"Show the player's color."
(interactive)
(goto-char (point-max))
(insert "\nYou are playing " mogo-player-color ".\n> "))
(defun mogo-handicap (coords)
"Place handicap stones at the given coordinates."
(mogo-send-command (concat "set_free_handicap " coords))
(mogo-show-board)
(mogo-show-player-color))
(defun mogo-forward ()
"Move cursor forward by one position or one grid position."
(interactive)
(if (mogo-move-on-board-p) (progn (search-forward " .") (backward-char))
(forward-char)))
(defun mogo-backward ()
"Move cursor backward by one position or one grid position."
(interactive)
(if (mogo-move-on-board-p) (search-backward ".") (backward-char)))
(defun mogo-back-to-board ()
"Move cursor backward to the previous board."
(interactive)
(search-backward-regexp "^ 1 |")
(mogo-forward))
(provide 'mogo)
(defun mogo-run-tests ()
"Run all tests."
(interactive)
(mogo-test-opposite-color)
(mogo-test-coordinates-p)
(mogo-test-current-line)
(mogo-test-coordinates-from-point)
(mogo-test-move-on-board-p)
(mogo-test-legal-move-on-board-p)
)
(defun mogo-assert-error (form)
"Assert that a quoted form, when evaluated, throws an error."
(let ((ok nil))
(condition-case nil (eval form)
(error (setq ok 't)))
(assert ok)))
(defun mogo-test-opposite-color ()
"Run tests for mogo-opposite-color."
(interactive)
(mogo-test-opposite-color-w)
(mogo-test-opposite-color-b)
(mogo-test-opposite-color-assert))
(defun mogo-test-opposite-color-w ()
(assert (equal "b" (mogo-opposite-color "w"))))
(defun mogo-test-opposite-color-b ()
(assert (equal "w" (mogo-opposite-color "b"))))
(defun mogo-test-opposite-color-assert ()
(mogo-assert-error '(mogo-opposite-color "B")))
(defun mogo-test-coordinates-p ()
"Run tests for mogo-coordinates-p."
(interactive)
(mogo-test-coordinates-p-true)
(mogo-test-coordinates-p-false-out-of-bounds)
(mogo-test-coordinates-p-false-noise)
(mogo-test-coordinates-p-false-i))
(defun mogo-test-coordinates-p-true ()
(assert (mogo-coordinates-p "e4"))
(assert (mogo-coordinates-p "F8"))
(assert (mogo-coordinates-p "a1"))
(assert (mogo-coordinates-p "j9")))
(defun mogo-test-coordinates-p-false-out-of-bounds ()
(assert (not (mogo-coordinates-p "e0")))
(assert (not (mogo-coordinates-p "e10")))
(assert (not (mogo-coordinates-p "k4")))
(assert (not (mogo-coordinates-p "z0"))))
(defun mogo-test-coordinates-p-false-noise ()
(assert (not (mogo-coordinates-p "")))
(assert (not (mogo-coordinates-p "5e")))
(assert (not (mogo-coordinates-p "e5x")))
(assert (not (mogo-coordinates-p "hello"))))
(defun mogo-test-coordinates-p-false-i ()
(assert (not (mogo-coordinates-p "i5")))
(assert (not (mogo-coordinates-p "I5"))))
(defun mogo-test-current-line ()
"Run tests for mogo-current-line on the following test lines:
MAGIC-current-line
hello world
another test !
space on both ends
> line with prompt
"
(interactive)
(save-excursion
(set-buffer "mogo.el")
(goto-char (point-min))
(search-forward "MAGIC-current-line")
(save-excursion (mogo-test-current-line-simple))
(save-excursion (mogo-test-current-line-trim))
(save-excursion (mogo-test-current-line-trim-both-ends))
(save-excursion (mogo-test-current-line-with-prompt))))
(defun mogo-test-current-line-simple ()
(search-forward "world")
(assert (equal "hello world" (mogo-current-line))))
(defun mogo-test-current-line-trim ()
(search-forward "another")
(assert (equal "another test !" (mogo-current-line))))
(defun mogo-test-current-line-trim-both-ends ()
(search-forward "space")
(assert (equal "space on both ends" (mogo-current-line))))
(defun mogo-test-current-line-with-prompt ()
(search-forward "prompt")
(assert (equal "line with prompt" (mogo-current-line))))
(defun mogo-test-coordinates-from-point ()
"Run tests for mogo-coordinates-from-point on the following test lines:
MAGIC-board
A B C D E F G H J
+---------------------------+
9 | . . . . . . . . Y |
8 | . . . . . . . . . |
7 | . . . . . . . . . |
6 | . . . . . . @ . . |
5 | . . . . (O) . . . . |
4 | . . . . . . . . . |
3 | . . . . . . . . . |
2 | . . . . . . . . . |
1 | X . . . . . . . . |
+---------------------------+"
(interactive)
(save-excursion
(set-buffer "mogo.el")
(goto-char (point-min))
(search-forward "MAGIC-board")
(save-excursion (mogo-test-coordinates-from-point-o))
(save-excursion (mogo-test-coordinates-from-point-at))
(save-excursion (mogo-test-coordinates-from-point-x))
(save-excursion (mogo-test-coordinates-from-point-y))))
(defun mogo-test-coordinates-from-point-o ()
(search-forward "O")
(assert (equal "e5" (mogo-coordinates-from-point))))
(defun mogo-test-coordinates-from-point-at ()
(search-forward "@")
(assert (equal "g6" (mogo-coordinates-from-point))))
(defun mogo-test-coordinates-from-point-x ()
(search-forward "X")
(assert (equal "a1" (mogo-coordinates-from-point))))
(defun mogo-test-coordinates-from-point-y ()
(search-forward "Y")
(assert (equal "j9" (mogo-coordinates-from-point))))
(defun mogo-test-move-on-board-p ()
"Test mogo-move-on-board-p on the MAGIC-board board above."
(interactive)
(save-excursion
(set-buffer "mogo.el")
(goto-char (point-min))
(search-forward "MAGIC-board")
(save-excursion (mogo-test-move-on-board-p-o))
(save-excursion (mogo-test-move-on-board-p-a))
(save-excursion (mogo-test-move-on-board-p-plus))
(save-excursion (mogo-test-move-on-board-p-plus2))))
(defun mogo-test-move-on-board-p-o ()
(search-forward "O")
(assert (mogo-move-on-board-p)))
(defun mogo-test-move-on-board-p-a ()
(search-forward "A")
(assert (not (mogo-move-on-board-p))))
(defun mogo-test-move-on-board-p-plus ()
(search-forward "+")
(assert (not (mogo-move-on-board-p))))
(defun mogo-test-move-on-board-p-plus2 ()
(search-forward "O")
(search-forward "+")
(assert (not (mogo-move-on-board-p))))
(defun mogo-test-legal-move-on-board-p ()
"Test mogo-legal-move-on-board-p on the MAGIC-board board above."
(interactive)
(save-excursion
(set-buffer "mogo.el")
(goto-char (point-min))
(search-forward "MAGIC-board")
(save-excursion (mogo-test-legal-move-on-board-p-o))
(save-excursion (mogo-test-legal-move-on-board-p-dot))))
(defun mogo-test-legal-move-on-board-p-o ()
(search-forward "O")
(assert (not (mogo-legal-move-on-board-p))))
(defun mogo-test-legal-move-on-board-p-dot ()
(search-forward "O")
(search-forward ".")
(backward-char)
(assert (mogo-legal-move-on-board-p)))