;;; ----------------------------------------------------------------------
;;;
;;; TTTPLAYE: Tic-tac-toe player protocol definitions
;;;
;;; ----------------------------------------------------------------------
;;;
;;; This file is part of ILOG Talk.
;;; Inquiries to ILOG S.A.
;;;              9 rue de Verdun, BP 85,
;;;              94253 Gentilly Cedex, France.
;;;
;;; Copyright (c) 1994-1996 by ILOG
;;; ----------------------------------------------------------------------
;;;

(defgeneric .tell-start-game (player other-name which)
  ;; Tell player that a new game has started against other-name,
  ;; playing which (either #\x or #\o).
  method: (((player .<player>) other-name which)
	   (.pprintf player "I'm playing %c against %s.\n" which other-name)))

(defgeneric .tell-move (player other-name move new-state)
  ;; Tell PLAYER that the other player (named OTHER-NAME, a string)
  ;; moved to position #move (an int).  The new board state is
  ;; NEW-STATE (a string of 9 chars).
  method: (((player .<player>) other-name move new-state)
	   (ignore player other-name move new-state)
	   ()))

(defgeneric .tell-winner (player winner-name positions)
  ;; Inform PLAYER that the player named WINNER-NAME (a string) has
  ;; won the current game.  The game is over.  If WINNER-NAME is (),
  ;; the game is a tie.
  method: (((player .<player>) winner-name positions)
	   (ignore player winner-name positions)
	   (signal (.make-exit-condition))))

(defgeneric .ask-move (player state legal-moves)
  ;; Ask PLAYER for a legal move among LEGAL-MOVES, a list of ints.
  ;; The current game state is STATE, a string of 9 chars.
  method: (((player .<player>) state legal-moves)
	   (error '.ask-move #!.no-method-specified player state
		  legal-moves)))

(defgeneric .ask-player-name (player)
  ;; Return a string for the player name.
  method: (((player .<player>)) (.player-name player)))

(defgeneric .tell-game-error (player msg rest: args)
  ;; There's been an error and the game was aborted.
  method: (((player .<player>) msg rest: args)
	   (apply #'.pprintf player msg args)
	   (signal (.make-exit-condition))))

(defgeneric .stop-ttt-player (player)
  method: (((player .<player>))
	   (.pprintf player "Shutting down.\n")))

(defgeneric .pprintf (player msg rest: args)
  method: (((player .<player>) msg rest: args)
	   (apply #'.message (.ask-player-name player) msg args)))

(defgeneric .pnewline (player)
  method: (((player .<random-player>))
	   (ignore player)
	   (when (dynamic .*verbosep*)
	     (newline))))

(defmethod prin-object ((p .<player>) stream)
  (let ((string (sprintf () "#<%A %s #p%08lp>"
			 (type-of p)
			 (.ask-player-name p)
			 p)))
    (prin-string string stream)))

(defmethod prin-object ((p .<server-player>) stream)
  (let ((string (sprintf () "#<server player %s (%s) #p%08lp>"
			 (.ask-player-name p)
			 (if (.server-player-socket p)
			     "open" "closed")
			 p)))
    (prin-string string stream)))

(defpredicate .playerp .<player>)

;;; The random player

(defmethod .tell-move ((player .<random-player>) other-name move new-state)
  (.pprintf player "%s moved to %d.\n" other-name move)
  (.print-board new-state))

(defmethod .tell-winner ((player .<random-player>) winner-name positions)
  (cond ((null winner-name)
	 (.pprintf player "The game has ended in a tie.\n"))
	((string= winner-name (.player-name player))
	 (.pprintf player "I won with %A!\n" positions))
	(t (.pprintf player "That damn %s won with %A. I hate him.\n"
		     winner-name positions)))
  (call-next-method))

(defmethod .ask-move ((player .<random-player>) state legal-moves)
  (ignore state)
  (let ((result (lref legal-moves (rand 0 (i1- (llen legal-moves))))))
    (.pnewline player)
    (.pprintf player "My turn...\n")
    (.pprintf player "I'll be moving to %d.\n" result)
    result))

;;; The server player

(defmethod .tell-start-game ((player .<server-player>) other-name which)
  (let ((socket (.server-player-socket player)))
    (assert socket)
    (print `(.tell-start-game ,other-name ,which) socket)))

(defmethod .tell-move ((player .<server-player>)
		       other-name move new-state)
  ;; Tell the client what happened.
  (let ((socket (.server-player-socket player)))
    (assert socket)
    (print (list '.tell-move other-name move new-state) socket)
    ))

(defmethod .tell-winner ((player .<server-player>) winner-name positions)
  ;; Tell the client who won.
  (let ((socket (.server-player-socket player)))
    (assert socket)
    (print `(.tell-winner ,winner-name ,positions) socket)
    ))

(defmethod .ask-move ((player .<server-player>) state legal-moves)
  ;; Ask the client for a move.
  (let ((socket (.server-player-socket player)))
    (assert socket)
    (print (list '.ask-move state legal-moves) socket)
    (prog1
	(read socket)
      (read-char socket))
    ))

(defmethod .ask-player-name ((player .<server-player>))
  ;; Cache the name locally.
  (or (.player-name player)
      (let ((socket (.server-player-socket player)))
	(if socket
	    (progn (print '(.ask-player-name) socket)
		   (let ((name (read socket)))
		     (read-char socket)
		     (setf (.player-name player) name)
		     name))
	  "<<Mystery player>>"))))

(defmethod .tell-game-error ((player .<server-player>) msg rest: args)
  (let ((socket (.server-player-socket player)))
    (when socket
      (print `(.tell-game-error ,(string msg) ,args) socket)
      (.stop-ttt-player player))))

(defmethod .stop-ttt-player ((player .<server-player>))
  (let ((socket (.server-player-socket player)))
    (when socket
      (print '(.stop-ttt-player) socket)
      (.close-server-player player))))

(defun .close-server-player (player)
  (let ((socket (.server-player-socket player)))
    (assert socket
      (warn '.close-server-player #!.player-already-closed player))
    (when socket
      (select-remove socket)
      (fclose socket)
      (setf (.server-player-socket player) ()))))

;;; Handling exit.

(defdynamic .*executablep* ())

(defhandler .exit-handler)

(define-handler-method .exit-handler ((c .<exit-condition>))
  ;; When this player is the sole object of an executable, exit when
  ;; the game is over.
  (ignore c)
  (when (dynamic .*executablep*)
    (exit)))
    

;;; messages

(defmessage .player-already-closed
  english: "server player already closed"
  french: "joueur de serveur déjà fermé")

(defmessage .no-method-specified
  english: "no method specified for player %A in state %A"
  french: "pas de méthode specifiée pour joueur %A dans l'état %A")
