;;; gnugo-extra.el
;;;
;;; Copyright (C) 2004, 2005, 2007, 2008 Thien-Thi Nguyen
;;;
;;; This file is part of ttn's personal elisp library, released under
;;; the terms of the GNU General Public License as published by the
;;; Free Software Foundation; either version 3, or (at your option) any
;;; later version.  There is NO WARRANTY.  See file COPYING for details.

;;; Description: Various gnugo-related toys and bits of work-in-progress.

;;; Commentary:

;; This file does not have a `provide' form.
;; YMMV; munge to taste.

;;; Code:

(require 'cl)
(require 'gnugo)


;; Buffer management is a very personal thing, so gnugo.el provides the
;; primitives `gnugo-board-buffer-p' and `gnugo-board-user-play-ok-p' upon
;; which lists, rings and ...(insert your topological metaphor here) can be
;; slung around at whim w/ a SMOP (subtle manifestation of personality ;-).
;; Here is a simple one-key approach favored by at least one simple person.

(define-key gnugo-board-mode-map "p"
  (defun ttn-pop-to-another-gnugo-game ()
    (interactive)
    (let ((cur (current-buffer)))
      (switch-to-buffer (find-if 'gnugo-board-buffer-p
                                 (reverse (buffer-list))))
      (when (eq cur (current-buffer))
        (message "(only one)")))))


;; Like the `:' command but additionally do eval-expression w/ the return
;; value of the command (presumed to be a list of vertices) pre-split and
;; quoted.  The common operation (counting) is suggested by default.

(define-key gnugo-board-mode-map "\C-c\M-:"
  (lambda (command) (interactive "sCommand that produces a list: ")
    (eval-expression
     (read
      (read-string "Eval: "
                   (cons (format "(length '%S)"
                                 (split-string (gnugo-query command)))
                         2))))))


;; Like the NEWS file suggests but w/ a little more slack.

(add-hook 'gnugo-board-mode-hook
          (lambda () (ignore-errors (gnugo-toggle-image-display))))


;; GNU Go vs GNU Go

;; To initiate, use `ttn-kick-gnugo-v-gnugo'.  This may eventually make it
;; into gnugo.el as a "GNU Go Assist" minor mode that can be toggled with a
;; single keystroke since GNU Go vs GNU Go is a just special case of that more
;; general facility.  Some edge conditions (and accounting mish mash) need to
;; be worked through.  Testing, feedback and patches welcome.

(defvar gnugo-v-gnugo-mode nil)
(add-to-list 'minor-mode-alist '(gnugo-v-gnugo-mode " Auto") t)

(defun ttn-gnugo-v-gnugo-schedule-next ()
  (gnugo-put :ttn-gnugo-v-gnugo-mode
    (and (gnugo-get :ttn-gnugo-v-gnugo-mode)
         (not (gnugo-get :game-over))
         (run-at-time
          2 nil (lambda (buf color)
                  (with-current-buffer buf
                    (gnugo-get-move color)))
          (current-buffer)
          ;; standard practice, but still somewhat of a crock
          (gnugo-put :gnugo-color
            (gnugo-other (gnugo-put :user-color
                           (gnugo-get :last-mover))))))))

(defun ttn-kick-gnugo-v-gnugo ()
  (interactive)
  (let ((new (or (not (gnugo-board-buffer-p))
                 (gnugo-get :game-over))))
    (when new
      (gnugo new)
      ;; let's be honest here
      (let* ((setup-node (car (gnugo-get :sgf-gametree)))
             (pb (assq :PB setup-node))
             (pw (assq :PW setup-node)))
        ;; important note: sometimes "PB" means "problem"!  haha.
        (unless (gnugo-get :original-PB)
          (gnugo-put :original-PB (cdr pb))
          (gnugo-put :original-PW (cdr pw)))
        (if (string-match "^GNU Go" (cdr pb))
            (setcdr pw (cdr pb))
          (setcdr pb (cdr pw)))))
    (add-hook 'gnugo-post-move-hook
              'ttn-gnugo-v-gnugo-schedule-next
              t t)
    (set (make-local-variable 'gnugo-v-gnugo-mode) t)
    (gnugo-put :ttn-gnugo-v-gnugo-mode t)
    (unless new
      (gnugo-note :C (format "Player change: GNU Go now plays both %s and %s."
                             ;; order matters only very subtly but it matters
                             (gnugo-get :user-color)
                             (gnugo-get :gnugo-color))))
    (when (or (string= (gnugo-get :gnugo-color)
                       (gnugo-get :last-mover))
              (not new))
      (ttn-gnugo-v-gnugo-schedule-next))))

(defun ttn-interrupt-gnugo-v-gnugo ()
  (interactive)
  (unless (gnugo-board-buffer-p)
    (error "No GNUGO game here, sorry"))
  (let ((timer (gnugo-get :ttn-gnugo-v-gnugo-mode)))
    (unless timer
      (error "No GNU Go vs GNU Go game in progress, sorry"))
    (unless (eq t timer)
      (cancel-timer timer))
    (gnugo-put :ttn-gnugo-v-gnugo-mode nil))
  (setq gnugo-v-gnugo-mode nil)
  (if (gnugo-get :waitingp)
      (message "You can play as %s when GNU Go is finished playing %s"
               (gnugo-get :user-color) (gnugo-get :gnugo-color))
    (gnugo-put :gnugo-color
      (gnugo-other (gnugo-put :user-color
                     (gnugo-get :gnugo-color))))
    (message "You can now play as %s" (gnugo-get :user-color)))
  ;; let's be honest here
  (gnugo-note :C (format "Player change: %s now plays as %s."
                         (user-full-name) (gnugo-get :user-color))))


;; NEXT!

(define-key gnugo-board-mode-map "N"
  (defun ttn-new-gnugo-game-please () (interactive)
    (let ((normalp (not (gnugo-get :original-PB))))
      (kill-buffer nil)
      (if normalp
          (gnugo t)
        (switch-to-buffer (get-buffer-create "*scratch*"))
        (ttn-kick-gnugo-v-gnugo)))))


;; Play w/ fulminated XPMs.

(defvar gnugo-xpm-hash (make-hash-table :test 'equal))

(define-key gnugo-board-mode-map "X"
  (defun ttn-new-gnugo-xpms-please (props globalp)
    (interactive "sProps: \nP")
    (let ((new (or (gethash props gnugo-xpm-hash)
                   (puthash props (apply 'fulminate-gnugo-xpms 'ttn
                                         (read (format "(%s)" props)))
                            gnugo-xpm-hash))))
      (if (or (not (gnugo-board-buffer-p)) globalp)
          (setq gnugo-xpms new)
        (gnugo-put :local-xpms new))
      (unless (featurep 'gnugo-xpms)
        (provide 'gnugo-xpms))
      (unless (and (boundp 'gnugo-xpms) gnugo-xpms)
        (setq gnugo-xpms new)))))


;; Better boss-is-near command.

(define-key gnugo-board-mode-map "\M-_"
  (defun ttn-bury-until-non-gnugo-board () (interactive)
    (while (gnugo-board-buffer-p)
      (bury-buffer))))

;;; gnugo-extra.el ends here