;;; ----------------------------------------------------------------------
;;;
;;; TTTCLIENTE: Client handling for Tic-Tac-Toe
;;;
;;; ----------------------------------------------------------------------
;;;
;;; 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
;;; ----------------------------------------------------------------------
;;;

(defun submit-ttt-player (player optional: (host .ttt-host) (port .ttt-port))
  ;;; Adds a player to the server.
  (unless (member #'.exit-handler (added-handlers))
    (add-handler #'.exit-handler))
  (let ((socket (.safe-connect port host)))
    (select-add socket (lambda (sock) (.ttt-client-read sock player)))
    player))

(defun .safe-connect (port host)
  (block con
    (repeat 10
      (trap-error (result condition ())
	(connect port host)
	(if condition
	    (.message 'client "Port %d failed; trying port %d...\n"
		      port (incf port))
	  (return-from con result))))
    (error '.safe-connect "too many ports failed; giving up" port)))

(defun .ttt-client-read (socket player)
  (let ((data (read socket () ())))
    (if data
	(progn
	  (read-char socket)
	  (.do-client-data data socket player))
      (progn
	(.pprintf player "End of game; shutting down.\n")
	(select-remove socket)
	(fclose socket)))))

(defun .do-client-data (data socket player)
  (assert (proper-list-p data)
    (progn (fclose socket)
	   (select-remove socket)
	   (error '.ttt-client-read
		  #!.invalid-request socket player data)))
  (case (car data)
    (.tell-start-game
     (destructuring-let (((other-name char) (cdr data)))
       (assert (stringp other-name))
       (assert (charp char))
       (.tell-start-game player other-name char)))
    (.tell-move
     (destructuring-let (((other-name move new-state)
			  (cdr data)))
       (assert (stringp other-name))
       (assert (intp move))
       (assert (stringp new-state))
       (.tell-move player other-name move new-state)))
    (.tell-winner
     (destructuring-let (((winner positions) (cdr data)))
       (assert (or (null winner) (stringp winner)))
       (assert (listp positions))
       (.tell-winner player winner positions)))
    (.tell-game-error
     (fclose socket)
     (destructuring-let (((message args) (cdr data)))
       (apply #'.tell-game-error player message args)))
    (.ask-player-name
     (assert (null (cdr data)))
     (let ((name (.ask-player-name player)))
       (print name socket)))
    (.ask-move
     (destructuring-let (((state legal-moves) (cdr data)))
       (assert (stringp state))
       (assert (listp legal-moves))
       (let ((move (.ask-move player state legal-moves)))
	 (print move socket))))
    (.stop-ttt-player
     (.stop-ttt-player player))
    (.start-game
     (print '(.start-game) socket))
    (t (.message 'client "Message not understood: %A\n" data)
       (select-remove socket)
       (fclose socket)
       (error '.ttt-client-read #!.invalid-request socket player
	      data))))

(defun .ttt-client-error (socket player)
  (fclose socket)
  (select-remove socket)
  (error '.ttt-client-error #!.error-in-socket socket player))

(defmessage .invalid-request
  english: "invalid tic-tac-toe request on socket %A, player %A"
  french:
  "requête de tic-tac-toe invalide sur le socket %A, joueur %A")

(defmessage .error-in-socket
  english: "error in socket %A, player %A"
  french: "erreur dans le socket %A, joueur %A")
