;;; gmpgo.el -- mode for playing GO via the Go Modem Protocol
;;
;; $Id: gmpgo.el,v 1.12 2000/02/07 06:55:03 saschal Exp $

;;; Description:

;; Mode for playing GO against any GO-program implementing the
;; Standard Go Modem Protol.
;;
;; Have fun!
;;
;; This file implements the Standard Go Modem Protocol 1.0 (SGMP) as
;; described in: ftp://ftp.nuri.net/Go/programs/protocol.Z

;;; Usage:

;; Load this file and type
;;
;;    M-x gmpgo

;;; TODO (a lot, many details):

;; - make use of process sentinel to check state of go program
;; - set coding system of processes (?)
;; - fix all [pending], esp. enable more go progams than gnugo
;; - handle empty string in filter.  Indicates that other process stopped.
;; - different ruleset as japanese
;; - make options (board size, charset, ruleset, handicap, go prog) customizable
;; - retransmit last command in OKWAIT after some seconds
;; - forbid certain moves (if not rejected from prog)
;; - check if there is a game running
;; - implement PASS
;; - avoid recursion on gmpgo-execute-cmd. a pipeline of msg's would be far better!
;; - ommit handling of sequence bits in execute-cmd
;; - check english style of comments and defun documentation
;; - react on DENY from other prg
;; - implement takeback

;;; Author:

;; Sascha Luedecke <sascha@meta-x.de>

;;; Code:

(defconst gmpgo-version "0.5.1")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;  Variables for customization

(defgroup gmpgo
  nil
  "Custom group for GMP Go"
  :group 'games)
  

(defcustom gmpgo-prog-gnugo 
  '("gnugo" "--mode" "gmp" "-D" "2")
  "How to invoke gnugo to play via GMP"
  :group 'gmpgo
  :type 'list
  )

(defcustom gmpgo-prog-baduki 
  '("baduki" "-g")
  "How to invoke baduki to play via GMP"
  :group 'gmpgo
  :type 'list
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Symbols and internal variables
;;

(defvar gmpgo-mode-map nil)

(unless gmpgo-mode-map
  (setq gmpgo-mode-map (make-sparse-keymap))
  (define-key gmpgo-mode-map "q" 'gmpgo-shutdown)
  (define-key gmpgo-mode-map [mouse-2] 'gmpgo-user-move)
  (define-key gmpgo-mode-map [return] 'gmpgo-user-move))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; really internal functions (debug and stuff)
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-debug-convert-to-dual (char)
  "Returns the binary representation as a string."
  (interactive "cCharacter please: ")
  (let ((rep ""))
    (while (> char 0)
      (setq rep (concat (logand 1 char) rep))
      (setq char (lsh char -1))
      )
    rep
    )
  )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-debug (msg)
  "Put msg on GMP debug buffer."
  (save-excursion
    (pop-to-buffer (get 'gmpgo 'debug))
    (goto-char (point-max))
    (insert msg "\n")))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-console (msg)
  "Puts `MSG' to GMP console buffer."
  (save-excursion
    (pop-to-buffer (get 'gmpgo 'console))
    (goto-char (point-max))
    (insert msg)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; other protocol specific low level functions
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-gmp-filter (proc msg)
  "Filter function for gmp processes.  Implements a part of the SGMP
and acts as a DFA based stream listener ."
  (gmpgo-debug (concat "\nGMP: got '" msg "' length " 
		       (prin1-to-string (string-bytes msg))))
  (let ((i 0)
	(len (length msg))
	byte)
    (while (< i len)
      (setq byte (aref msg i))
      ;; cycle through four states (one for each byte of a SGMP message)
					; [pending] make this more efficient
      (cond ((equal (get 'gmpgo-gmp-filter 'state) 'WAIT)
	     (cond ((= (logand byte ?\xfc) 0) ; msg start
		    (aset (get 'gmpgo-gmp-filter 'msg) 0 byte)
		    (put 'gmpgo-gmp-filter 'state 'CHK))
		   ((gmpgo-console byte)))) ; anything else will be printed
	    ((equal (get 'gmpgo-gmp-filter 'state) 'CHK)
	     (cond ((> byte ?\x80)	; chksum
		    (aset (get 'gmpgo-gmp-filter 'msg) 1 byte)
		    (put 'gmpgo-gmp-filter 'state 'CMD1))
		   ((put 'gmpgo-gmp-filter 'state 'WAIT)))) ; else jump out
	    ((equal (get 'gmpgo-gmp-filter 'state) 'CMD1)
	     (cond ((and (> byte ?\x80)	; first cmd byte
			 (= (logand byte ?\x08) 0))
		    (aset (get 'gmpgo-gmp-filter 'msg) 2 byte)
		    (put 'gmpgo-gmp-filter 'state 'CMD2))
		   ((put 'gmpgo-gmp-filter 'state 'WAIT)))) ; else jump out		   
	    ((equal (get 'gmpgo-gmp-filter 'state) 'CMD2)
	     (cond ((> byte ?\x80)	; second cmd byte
		    (aset (get 'gmpgo-gmp-filter 'msg) 3 byte)
		    (gmpgo-receive-msg (get 'gmpgo-gmp-filter 'msg))
		    (put 'gmpgo-gmp-gilter 'msg "1234")))
	     (put 'gmpgo-gmp-filter 'state 'WAIT)))
      (setq i (1+ i)))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-receive-msg (msg)		; [pending] THIS is UGLY code.
  "Processes a SGMP `MSG'.  Must be four bytes long and normally comes
from a gmp connection.  Extracts a command and it's parameters from
SGMP message and invokes gmpgo-execute-cmd.  This DFA takes care of
the low level protocol, esp. the sequence bits."
  (gmpgo-debug (concat "GMP-recv: processing " msg))
  (when (/= (string-bytes msg) 4)
    (gmpgo-debug (concat "Msg '" msg "' had not the proper length of four bytes!")))
  (gmpgo-debug (format "GMP-recv: bytes %s %s %s %s" 
		       (gmpgo-debug-convert-to-dual (aref msg 0))
		       (gmpgo-debug-convert-to-dual (aref msg 1))
		       (gmpgo-debug-convert-to-dual (aref msg 2))
		       (gmpgo-debug-convert-to-dual (aref msg 3))))

  ;; extract data and analyse
  ;; see protocol specification mentioned above for message format
  (let ((hisseq (logand (aref msg 0) ?\x01)) ; [pending] order nicely
	(myseqlast (get 'gmpgo 'myseqlast))
	(myseq (lsh (logand (aref msg 0) ?\x02) -1))
	(hisseqlast (get 'gmpgo 'hisseqlast))
	(chksum (logand (aref msg 1) ?\x7f))
	(cmd (lsh (logand (aref msg 2) ?\x70) -4))
	cmdval
	(state (get 'gmpgo-receive-msg 'state))
	)
					; [pending] check chksum of msg's!
    (setq cmdval (lsh (logand (aref msg 2) ?\x07) 7))
    (setq cmdval (logior cmdval (logand (aref msg 3) ?\x7f)))

    (gmpgo-debug (format "GMP-recv: mseq: %d/%d hseq: %d/%d chksum: %d cmd: %d cmdval: %d" 
			 myseq myseqlast hisseq hisseqlast chksum cmd cmdval))

    ;; - check protocol state and admissability of current message in
    ;;   ongoing discussion
    ;; - makes use of DFA describes in protocol specification
    ;; - Yes, hardcoded DFA's are pretty bad, but this is small, so what?
    (cond ((equal state 'NEUTRAL)
	   (cond ((= myseq (logxor myseqlast 1))
					; discard some
		  (gmpgo-debug (format "GMP-recv: state NEUTRAL discarded %s" msg)))
		 ((and (= myseqlast myseq) (= hisseqlast hisseq))
					; resend last command, if it wasn't "OK"
		  (if (= cmd 0)
		      (gmpgo-execute-cmd myseq hisseq cmd cmdval)
		    (gmpgo-debug "GMP-recv: NEUTRAL resending last cmd")
		    (gmpgo-send-msg (get 'gmpgo 'lastcmd))))
		 ((and (= myseqlast myseq) (/= hisseqlast hisseq))
					; execute command
		  (gmpgo-execute-cmd myseq hisseq cmd cmdval))))
	  ((equal state 'OKWAIT)
	   (cond ((and (= cmd 0) (= myseq myseqlast) (= hisseq hisseqlast))
					; ACK/OK from the other side
		  (gmpgo-debug "GMP-recv: ACK/OK received.")
					; [pending] act on conflicts!
		  (put 'gmpgo-receive-msg 'state 'NEUTRAL))
		 ((or (= cmd 0)
		      (and (= myseq myseqlast) (= hisseq hisseqlast)))
					; discard all other ACK and my own, last cmd
		  (gmpgo-debug (format "GMP-recv: state OKWAIT discarded %s" msg)))
		 ((and (/= myseq myseqlast) (= hisseq hisseqlast))
					; retransmit last command
		  (gmpgo-debug "GMP-recv: OKWAIT resending last cmd")
		  (gmpgo-send-msg (get 'gmpgo 'lastcmd)))
		 ((and (= myseq myseqlast) (/= hisseq hisseqlast))
					; execute command
		  (put 'gmpgo-receive-msg 'state 'NEUTRAL)
		  (gmpgo-execute-cmd myseq hisseq cmd cmdval))
		 ((and (/= myseq myseqlast) (/= hisseq hisseqlast))
					; conflict !!
		  (gmpgo-debug (format "GMP-recv: conflicting msg %s" msg))
		  (put 'gmpgo 'state-process-msg 'NEUTRAL)))))))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-make-msg (myseq hisseq cmd cmdval)
  "Compose a SGMP message from `MYSEQ', `HISSEQ', `CMD' and `CMDVAL'.
No checks are done here!"
  (let ((msg "    "))
    ;; start byte
    (aset msg 0 (+ (lsh hisseq 1) myseq))
    ;; cmd bytes
    (aset msg 2 (+ ?\x80 (lsh cmd 4) (lsh cmdval -7)))
    (aset msg 3 (+ ?\x80 (logand ?\x7f cmdval)))
    ;; set checksum
    (aset msg 1 (+ 128 (logand ?\x7f (+ (aref msg 0) (aref msg 2) (aref msg 3)))))
    (gmpgo-debug (format "GMP-make: bytes %s %s %s %s" 
			 (gmpgo-debug-convert-to-dual (aref msg 0))
			 (gmpgo-debug-convert-to-dual (aref msg 1)) 
			 (gmpgo-debug-convert-to-dual (aref msg 2)) 
			 (gmpgo-debug-convert-to-dual (aref msg 3))))
    msg))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-send-msg (string)
  "Sends `string' to the GMP connection and affects the protocol state
by setting int to OKWAIT whenever needed."
					; [pending] check if proc is alive
					; [pending] remove cond.
  (let ((cmd (logand (lsh (aref string 2) -4) ?\x07)))
    ;; report cmd to ship
    (cond ((= cmd 0) (gmpgo-debug "GMP-send: OK sent."))
	  ((= cmd 1) (gmpgo-debug "GMP-send: DENY sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))
	  ((= cmd 2) (gmpgo-debug "GMP-send: NEWGAME sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))
	  ((= cmd 3) (gmpgo-debug "GMP-send: QUERY sent."))
	  ((= cmd 4) (gmpgo-debug "GMP-send: ANSWER sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))
	  ((= cmd 5) (gmpgo-debug "GMP-send: MOVE sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))
	  ((= cmd 6) (gmpgo-debug "GMP-send: TAKEBACK sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))
	  ((= cmd 7) (gmpgo-debug "GMP-send: EXTENDED sent.")
	   (put 'gmpgo 'protocol-state 'OKWAIT))))
  (put 'gmpgo 'lastcmd string)
  (put 'gmpgo 'myseqlast (logand 1 (aref string 0)))
  (put 'gmpgo 'hisseqlast (lsh (logand 2 (aref string 0)) -1))
  (process-send-string (get 'gmpgo 'proc) string))

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-play-move (move)
  "Places a stone on the board and removes any prisioners."
					; [pending] remove prisioners!
  (put 'gmpgo 'moves (append (list move) (get 'gmpgo 'moves)))
  ;; find and markany prisioners
  (let* ((size (get 'gmpgo 'size))
	 (closed ())
	 prisioners
	 p
	 (neighbours '( (+ move size)
		       (- move size) 
		       (- move 1)
		       (+ move 1))))
    ;; find them
    (while neighbours
      (setq prisioners 
	    (append prisioners
		    (gmpgo-find-prisioners (eval (car neighbours)) 
					   (logxor (lsh (logand ?\x200 move) -9) 1)
					   closed)))
      (setq neighbours (cdr neighbours))
      )

    ;; ok, now mark them in the movelist
    (let (moves
	  pos
	  found
	  )
      (while prisioners
	(setq p (car prisioners))
	(gmpgo-debug (format "Imprisioned stone number: %d." p))

	(setq moves (get 'gmpgo 'moves))
	(setq found nil)
	(while (and moves (not found))
	  (setq pos (car moves))
	  (gmpgo-debug (format "looking at %d" pos))
	  (when (= (logand ?\x1ff pos) 
		   p)
	    (setq found t)
	    (setcar moves (logior ?\x400 pos))
	    (gmpgo-debug (format "moves are: %S" moves))
	    )
	  (setq moves (cdr moves))
	  )

	(setq prisioners (cdr prisioners))
	)
      )
    )
  ;; check and mark prisioners
  (gmpgo-showboard)
  )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-get-move (move)
  "Returns the `MOVE' with color in movelist or nil if not yet played
or imprisioned.  Will get obsolete if better data structure is used
for the moves."
  (let ((moves (get 'gmpgo 'moves))
	pos
	found
	)
    (while (and moves (not found))
      (setq pos (car moves))
      (when (and (/= (logand ?\x400 pos) ?\x400)
		 (= (logand ?\x1ff pos) 
		    move))
	(setq found t))
      (setq moves (cdr moves))
      )
    (if found
	pos
      nil)
    )
  )


(defun gmpgo-find-prisioners (move color closed)
  "Checks if area colored `COLOR' around `MOVE' has any freedoms.  If
not, returns list of prisioners. `CLOSED' carries a list of visited
positions to avoid loops."
  (let ((moves (get 'gmpgo 'moves))
	(empty nil)
        ;; (color (lsh (logand move ?\x200) -9))
	(free nil) ;; asume we are not free.
	(prisioners nil)
	(neighbours nil)
	(size (get 'gmpgo 'size))
	pos
	)
    (setq move (logand ?\x1ff move))
    ;; move free? -> return nil
    (if (not (gmpgo-get-move move))
	(setq empty t)
      )

    (if empty
	nil  ;; ok, this is a side exit, hard to see, uhm?
      
      ;; closed += move
      (setq closed (append (list move) closed))

      ;; for pos in top, bot, left, right:
      (setq neighbours '( (+ move size)
			  (- move size) 
			  (- move 1)
			  (+ move 1)))
      (while (and neighbours (not free))
	(setq pos (eval (car neighbours)))
	;;  pos off board?
	(if (or (< pos 1)
		(> pos (expt (get 'gmpgo 'size) 2))
		;; left out
		(and (= 1 (mod move size))
		     (= 0 (mod pos size)))
		;; right out
		(and (= 1 (mod pos size))
		     (= 0 (mod move size))))
	    (gmpgo-debug (format "m: %d Pos %d offboard" move pos))
	  ;; Ok, we are on the board, go on

	  ;;  pos not in closed
	  (when (not (member pos closed))
	    ;;  pos is free?  we are free too!
	    (let ((i (gmpgo-get-move pos)))
	      (if (not i)
		  (setq free t)
		(when (= color (lsh (logand ?\x200 i) -9))
		  ;;  pos same color: pris += remp(pos, open)
		  (setq i (gmpgo-find-prisioners pos color closed))
		  ;; we are free if our neighbour is!
		  (if i
		      (setq prisioners (append prisioners i))
		    (setq free t))
		  )
		)
	      )
	    )
	  )
	(setq neighbours (cdr neighbours))
	)
      
      ;; when not free, pris += move
      (if free
	  (setq prisioners nil)
	(setq prisioners (append prisioners (list move))))

      prisioners
      )
    )
  )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-move-ok (move)
  "Checks if a given move can be done.  Will test for atari and stuff."
					; [pending] make check more plausible than always t
  (interactive)
  t)

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-execute-cmd (myseq hisseq cmd cmdval)
  "Executes a SGMP-command normally received from the opponent.
Contains the high level DFA for the gameplay itself."
  (gmpgo-debug (concat "executing: " (gmpgo-debug-convert-to-dual cmd)
		       " "  (gmpgo-debug-convert-to-dual cmdval)
		       "\t(" cmd "/" cmdval ")"))
  (let ((state (get 'gmpgo-game 'state)))
    ;; process cmd
    (cond ((= cmd 1)			; DENY is ignored by now
	   (gmpgo-debug "GMP-exec: DENY received and ignored."))

	  ((= cmd 2)			; NEWGAME rejected by now
					; [pending] implement "ask for new game"
	   (gmpgo-debug "GMP-exec: NEWGAME received and denied.")
	   (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 1 0)))
	  
	  ((= cmd 3)			; QUERY is always answered
	   (gmpgo-debug "GMP-exec: QUERY received.")
	   (setq myseq (logxor myseq 1))
	   (cond ((= cmdval 0)		; what game?
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 1))) ; GO
		 ((= cmdval 1)		; buffer size
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; minimal
		 ((= cmdval 2)		; protocol version
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; initial
		 ((= cmdval 3)		; stones on board? 
					; [pending] fix this, when moves are recoded!
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 (length (get 'gmpgo 'moves)))))
		 ((= cmdval 4)		; time black spend
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; dunno
		 ((= cmdval 5)		; time white spend
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; dunno
		 ((= cmdval 6)		; character set
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 1))) ; english (ascii)
		 ((= cmdval 7)		; ruleset?
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 1))) ; japanese
		 ((= cmdval 8)		; handicap?
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 1))) ; 1 (=dunno)
		 ((= cmdval 9)		; board size
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 (get 'gmpgo 'size))))
		 ((= cmdval 10)		; time limit
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; dunno
		 ((= cmdval 11)		; color playing on this side
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 (get 'gmpgo 'mycolor))))
		 ((= cmdval 12)		; who am i?
		  (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0))) ; dunno
		 (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 4 0)))) ; default is NO

	  ((= cmd 4)			; ANSWER
	   (gmpgo-debug "GMP-exec: ANSWER received.  Hm .. did I ask?")
	   ;; send OK by now
	   (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 0 1023)))

	  ((= cmd 6)			; TAKEBACK always rejected by now
	   (gmpgo-debug "GMP-exec: TAKEBACK received and denied.")
	   (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 1 0)))

	  ((= cmd 7)			; EXTENDED rejected, wo can't
	   (gmpgo-debug "GMP-exec: EXTENDED received and denied.")
	   (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 1 0)))

	  ;;
	  ;; From here, the five game-states come
	  ;;
	  
	  ;; NEWGAME -- only left by an OK which is end of interrogation
	  ;; and starts exchange of moves
	  ((equal state 'NEWGAME) 
	   (gmpgo-debug "STATE: NEWGAME")
	   (if (/= cmd 0)
	       (gmpgo-debug (concat "STATE: NEWGAME skipped " cmd))
	     (gmpgo-showboard)
	     (if (equal (get 'gmpgo 'mycolor) 1) ; am I white?
		 (put 'gmpgo-game 'state 'WAIT-HIS)
	       ;; reenter this method.      ; [pending] better to have some message pipe than recursion!
	       (put 'gmpgo-game 'state 'MY-MOVE)
	       (gmpgo-execute-cmd myseq hisseq -1 -1))))

	  ;; MY-MOVE -- get a move from the user and wait for ack from remote prg
	  ((equal state 'MY-MOVE)
	   (gmpgo-debug "STATE: MY-MOVE")
	   (gmpgo-debug (concat "STATE: MY-MOVE ignored " cmd "\nThis is ok."))
	   (message "Make your move!"))

	  ;; WAIT-ACK -- waiting for ACK for my last move
	  ((equal state 'WAIT-ACK)
	   (gmpgo-debug "STATE: WAIT-ACK")
					; [pending] accept implict OK from other commands too
	   (cond ((= cmd 0)		; OK, user move was accepted, so play it
		  (gmpgo-play-move (get 'gmpgo-game 'mymove))
		  (put 'gmpgo-game 'state 'WAIT-HIS))
		 ((= cmd 1)		; DENY, make user move again!
		  (put 'gmpgo-state 'MY-MOVE)
		  (gmpgo-execute-cmd myseq hisseq -1 -1))
		 ((= cmd 5)		; MOVE, implict OK, play mine, check his
		  (gmpgo-play-move (get 'gmpgo-game 'mymove))
		  (put 'gmpgo-game 'state 'CHECK-HIS)
		  (gmpgo-execute-cmd myseq hisseq cmd cmdval))))

	  ;; WAIT-HIS  -- waiting for his move
	  ((equal state 'WAIT-HIS)
	   (gmpgo-debug "STATE: WAIT-HIS")
	   (if (/= cmd 5)		; MOVE, check it !
	       (gmpgo-debug (concat "STATE: only accepting moves.  Skipped " cmd))
	     (put 'gmpgo-game 'state 'CHECK-HIS)
	     (gmpgo-execute-cmd myseq hisseq cmd cmdval)))

	  ;; CHECK-HIS -- check if we accept his move
	  ((equal state 'CHECK-HIS)
	   (gmpgo-debug "STATE: CHECK-HIS")
	   (if (gmpgo-move-ok cmdval)
	       (progn (gmpgo-debug "STATE: good move received.  playing.")
		      (put 'gmpgo-game 'state 'MY-MOVE)
		      (gmpgo-play-move cmdval)
		      (gmpgo-send-msg (gmpgo-make-msg myseq hisseq 0 1023))
		      (gmpgo-execute-cmd myseq hisseq -1 -1))
	     (gmpgo-debug "STATE: Bad move received, denying.")
	     (put 'gmpgo-game 'state 'WAIT-HIS)
	     (gmpgo-send-msg (gmpgo-make-msg (logxor myseq 1) hisseq 1 0))))

	  ;; DEAD END -- should never be reached
	  (gmpgo-debug (concat "STATE: DEAD END. This message should never be seen:" 
			       (prin1-to-string state)))
	  )
    )
  )


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; High level functions like user-move, setup and others
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-user-move ()
  "Places a stone on the current position.  This is the ONLY function
which changes `gmpgo-game' state from outside gmpgo-execute-cmd."
  (interactive)
  (if (not (equal (get 'gmpgo-game 'state) 'MY-MOVE))
      (error "Hey, wait for your opponent to move!")
    (save-excursion
      ;; get pos
      (let ((pos (point)))
	(beginning-of-line)
	;; onboard?
	(if (looking-at  "^\\s +\\([0-9]+\\) \\( [XO\\+\\.]\\)+\\s +[0-9]+$")
	    ;; free?
	    (cond  ((or (equal (char-after pos) ?O)
			(equal (char-after pos) ?X))
		    (error "This position is not free!  Consider glasses."))
		   ((or (equal (char-after pos) ?.)
			(equal (char-after pos) ?+))
		    ;; Yes, make the move
		    (let ((row (string-to-number (match-string 1)))
			  col
			  move
			  (line (buffer-substring-no-properties (point) (1+ pos))))
		      (string-match " \\( [XO\\+\\.]\\)*$" line)
		      (setq col (/ (length (match-string 0 line)) 2)) ; get col
		      (setq move (+ (* (get 'gmpgo 'size) (1- row)) col)) ; calc move num
		      (gmpgo-debug (concat "MOVE: r: " row " c: " col " m: " move))

		      (when (= (get 'gmpgo 'mycolor) 1) ; add color bit if we are white
			(setq move (+ move ?\x200)))
		      (put 'gmpgo-game 'state 'WAIT-ACK)
		      (put 'gmpgo-game 'mymove move)
		      ;; (put 'gmpgo 'moves (append (list move) (get 'gmpgo 'moves)))
		      (gmpgo-send-msg (gmpgo-make-msg 
				       (logxor 1 (get 'gmpgo 'myseqlast)) 
				       (get 'gmpgo 'hisseqlast)
				       5
				       move))))
		   ((error "This is not a place on the board.  Maybe a larger font helps.")))
	  (error "You are far from the board!  Try to aim better."))))))


;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-showboard ()
  "Display current board in board buffer.  Calculates the board from
the list of moves and renders it afterwards."
  (set-buffer (get 'gmpgo 'board))
  (erase-buffer)
  (goto-char (point-max))
  (let ((size (get 'gmpgo 'size))
	(i 0)
	j
	line
	(board ()))
    ;; build board
    (while (< i size)
      (setq line "")
      (setq j 0)
      (while (< j size)
	(setq line (concat line " ."))
	(setq j (1+ j))
	)
      
      (setq board (append board (list line)))
      (setq i (1+ i)))

    ;; set stones
					; [pending] apply to all (mapcar?)
					; [pending] What about handicaps?
    (let ((moves (get 'gmpgo 'moves))
	  move
	  stone)
      ;; mark tengen and hoshi
      (cond ((= size 9)
	     (setq line (nth 2 board))
	     (aset line 5 ?+) (aset line 13 ?+)
	     (setq line (nth 4 board))
	     (aset line 9 ?+)
	     (setq line (nth 6 board))
	     (aset line 5 ?+) (aset line 13 ?+))
	    ((= size 13)
	     (setq line (nth 3 board))
	     (aset line 7 ?+) (aset line 13 ?+) (aset line 21 ?+)
	     (setq line (nth 6 board))
	     (aset line 7 ?+) (aset line 13 ?+) (aset line 21 ?+)
	     (setq line (nth 9 board))
	     (aset line 7 ?+) (aset line 13 ?+) (aset line 21 ?+))
	    ((= size 19)
	     (setq line (nth 3 board))
	     (aset line 7 ?+) (aset line 21 ?+) (aset line 33 ?+)
	     (setq line (nth 9 board))
	     (aset line 7 ?+) (aset line 21 ?+) (aset line 33 ?+)
	     (setq line (nth 15 board))
	     (aset line 7 ?+) (aset line 21 ?+) (aset line 33 ?+)))

      ;; place stones
      (while (not (null moves))
	(setq move (car moves))
	(when (and (< 0 move)
		   (= 0 (logand ?\x400 move))) ; not a prisioner
	  (setq stone (if (< 0 (logand ?\x200 move)) ?O ?X)) ; determine color
	  (setq move (1- (logand ?\x1ff move))) ; strip color bit, adjust numbering
	  (setq line (nth (/ move size) board))
	  (aset line (1+ (* 2 (% move size))) stone))
	(setq moves (cdr moves))
	)

      ;; mark last move
      (setq move (car (get 'gmpgo 'moves)))
      (when move
	(setq move (1- (logand ?\x1ff move))) ; strip color bit, adjust numbering
	(setq line (nth (/ move size) board))
	(put-text-property (1+ (* 2 (% move size))) 
			   (+ 2 (* 2 (% move size))) 
			   'face 'font-lock-warning-face line))

      ;; display board
      (insert "    " (get 'gmpgo 'letterbar) "\n")
      (setq i size)
      (while (< 0 i)
	;; line
	(insert " " (format "%2d" i) " " 
		(nth (1- i) board)
		" " (format "%2d" i) "\n")
	(setq i (1- i)) )
      (insert "    " (get 'gmpgo 'letterbar) "\n\n")
      (when move 
	(insert (format "Last move was: %s%d" 
			(substring (get 'gmpgo 'letterbar) 
				   (1+ (* 2 (% move size))) 
				   (+ 2 (* 2 (% move size))) )
			(1+(/ move size)) )))
      )) ;; let
  ) ;; defun

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-setup ()
  "Setup GMP GO."

  (kill-buffer (get 'gmpgo 'debug)) ;[pending] kill me too!
  ;; Make some variables/buffers
					; [pending] dist. symbols !
  (put 'gmpgo 'orig-windows (current-window-configuration))
  (put 'gmpgo 'orig-point (point))
  (put 'gmpgo 'board (get-buffer-create "*GMP GO*"))
  (put 'gmpgo 'console (get-buffer-create "*GMP Go Console*"))
  (put 'gmpgo 'debug (get-buffer-create "*GMP Go debug*"))
  (put 'gmpgo 'size 9)
  (put 'gmpgo 'letterbar (substring " A B C D E F G H J K L M N O P Q R S T U V W X Y Z" 0 
				    (* 2 (get 'gmpgo 'size))))
  (put 'gmpgo 'moves ())
  (put 'gmpgo 'mycolor 2) ; [pending] black!

  (put 'gmpgo 'myseqlast 0)
  (put 'gmpgo 'hisseqlast 0)
  (put 'gmpgo-game 'state 'NEWGAME)

  (put 'gmpgo-receive-msg 'state 'NEUTRAL)
  (put 'gmpgo-gmp-filter 'state 'WAIT)
  (put 'gmpgo-gmp-filter 'msg "1234")

  ;; Setup view
					; [pending] This surely can be done better!
  (switch-to-buffer (get 'gmpgo 'board))
  (use-local-map gmpgo-mode-map)
  (setq major-mode 'gmpgo)
  (setq mode-name "GMP Go")
  (delete-other-windows)
  (split-window-vertically (- (frame-height) 19))
  (other-window 1)
  (switch-to-buffer (get 'gmpgo 'console))
  (insert "\n--------------------------------------------------\n"
	  "Welcome to GMP Go " gmpgo-version "\n"
	  "By now you will play against GNUGO.\n"
	  "--------------------------------------------------\n")
  (split-window-horizontally)
  (other-window 1)
  (switch-to-buffer (get 'gmpgo 'debug))
  (other-window 1)

  ;; Start program
  (put 'gmpgo 'program (car gmpgo-prog-gnugo))
  (put 'gmpgo 'program-args (cdr gmpgo-prog-gnugo))
  (let ((process-connection-type nil))
    (put 'gmpgo 'proc (start-process "gmpgo" 
				     (get 'gmpgo 'console)  
				     (get 'gmpgo 'program)
					; [pending] fixme later ...
				     "--mode" "gmp" "-D" "1"
				     ;; (get 'gmpgo 'program-args)
				     ))
    )
  (set-process-filter (get 'gmpgo 'proc) 'gmpgo-gmp-filter)
  (gmpgo-send-msg (gmpgo-make-msg 1 0 2 0))	; [pending] try to iniitiate game
  )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo-shutdown ()
  "Shutdown GMP Go."
  (interactive)

  ;; Clean environment
  (delete-process (get 'gmpgo 'proc))
  (kill-buffer (get 'gmpgo 'board))
  (kill-buffer (get 'gmpgo 'console))
;;  (kill-buffer (get 'gmpgo 'debug)) ;[pending] kill me too!

  ;; Restore view
  (set-window-configuration (get 'gmpgo 'orig-windows))
  (goto-char (get 'gmpgo 'orig-point))

  (message "Have a nice day!")
  )

;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun gmpgo ()
  "Play Go against any GMP capable program."
  (interactive)
  (gmpgo-setup)
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'gmpgo)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Local Variables:
;;; mode: outline-minor
;;; End: