;;; ----------------------------------------------------------------------
;;;
;;; TTTSERVE: The Tic-Tac-Toe game server.
;;;
;;; ----------------------------------------------------------------------
;;;
;;; 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
;;; ----------------------------------------------------------------------
;;;

;;; Start up the game server by calling (start-ttt-server).  The
;;; server sits around in an infinite loop, waiting for tic-tac-toe
;;; players to connect on its port.  Every time two players are
;;; connected, it tarts a new game.  Each player is represented
;;; locally by an instance of ttt.<server-player>, which stores the
;;; socket used for communication with the distant player.

(defglobal .ttt-server ())

(defglobal .waiting-player ())

(defglobal .player-games
  ;; Maps players to games.
  (make-hash-table))

(defglobal .games
  ;; List of all games.
  ())

(defun start-ttt-server (optional: (port .ttt-port) (host .ttt-host))
  ;; Start the server on the given PORT.  If PORT is unavailable, it
  ;; makes a feeble attempt to find one, and then gives up if it
  ;; can't.
  (stop-ttt-server)
  (.message 'svr "Starting server on %s using port %d\n" host port)
  (setf .ttt-server
    (.safe-listen port))
  (select-add .ttt-server #'.ttt-server-accept)
  ;; Infinite loop of waiting for players and doing game turns for
  ;; existing games.
  (while t
    (if .games
	;; Do a turn in a random game.  This is supposed to assure
	;; some kind of fairness.
	(let ((game (lref .games (rand 0 (i1- (llen .games))))))
	  (select 0)			; let new guys connect.
	  (.message 'svr "Doing turn in game %A\n" game)
	  (let ((turn (.do-game-turn game)))
	    (cond ((null turn)
		   ;; The game goes on.
		   (.message 'svr "Did a turn in game %A\n" game))
		  ((eq turn t)
		   ;; A tie.
		   (.message 'svr "Game %A ended in a tie.\n" game)
		   (.end-server-game game t))
		  (t
		   ;; Someone won.
		   (.message 'svr "Game %A was won by %A\n" game turn)
		   (.end-server-game game t)))))
      (progn
	(.message 'svr "No games; waiting for event.\n")
	;; Connections may have happenned during the .message
	(unless .games
	  (select))))))

(defun .safe-listen (port)
  ;; Try to listen at port PORT.  If that port is unavailable, tries the
  ;; next 10 in order until one is found.  If none is found, signals
  ;; an error.
  (block lis
    (repeat 10
      (trap-error (result condition ())
	(listen port)
	(if condition
	      (.message 'svr "Port %d failed; trying port %d...\n"
			port (incf port))
	  (return-from lis result))))
    (error '.safe-listen "too many ports failed; giving up." port)
    ))

(defun stop-ttt-server ()
  ;; Stop the server and all extant games.
  (.message 'svr "Shutting down server.\n")
  (for ((game in: .games))
    (.message 'svr "Shutting down game %A\n" game)
    (let ((p1 (.game-x-player game))
	  (p2 (.game-o-player game)))
      (.stop-ttt-player p1)
      (.stop-ttt-player p2)))
  (setf .games ())
  (when .waiting-player
    (.stop-ttt-player .waiting-player)
    (setf .waiting-player ()))
  (htclear .player-games)
  (when .ttt-server
    (when (member .ttt-server (select-managed-list))
      (select-remove .ttt-server))
    (when (member .ttt-server (open-posix-streams))
      (fclose .ttt-server))
    (setf .ttt-server ())))

(defun .ttt-server-accept (server)
  ;; Accept a distant player's request to start a game.  Create a
  ;; proxy player to work locally by transmitting the game protocol
  ;; through a socket.
  (let* ((socket (accept server))
	 (player (.make-server-player socket: socket)))
    (.message 'svr "Accepting player %A\n" player)
    (if .waiting-player
	(.start-server-game .waiting-player player)
      (progn
	(.message 'svr "Queueing up player %A\n" player)
	(setf .waiting-player player)))))

(defun .start-server-game (x-player o-player)
  ;; Now that we have two players ready, start up a game.  Tell both
  ;; players we are ready, and prepare the queue for another game.
  (let ((game (.make-game
	       x-player: x-player
	       o-player: o-player)))
    (.message 'svr "Starting game between %A and %A\n" x-player o-player)
    (assert (not (htref .player-games x-player)))
    (assert (not (htref .player-games o-player)))
    (setf (htref .player-games x-player) game)
    (setf (htref .player-games o-player) game)
    (setf .waiting-player ())
    (.tell-start-game x-player (.ask-player-name o-player) #\o)
    (.tell-start-game o-player (.ask-player-name x-player) #\x)
    (pushf .games game)))

(defun .end-server-game (game removep)
  ;; It's the end of the game.
  (let ((xplayer (.game-x-player game))
	(oplayer (.game-o-player game)))
    (assert (htrem .player-games xplayer))
    (assert (htrem .player-games oplayer))
    (.stop-ttt-player xplayer)
    (.stop-ttt-player oplayer)
    (when removep
      (setf .games (nremove game .games)))))

;;; messages

(defmessage .game-terminated-by-player
  english: "game terminated by player %s"
  french: "partie terminée par joueur %s")
