;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                              Server                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; This hack loads the game if it wasn't loaded already so it is
;;; possible to load this file and get all loaded.
(unless (defined? '<game-object>) (load-relative "game.zo"))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Classes

;;; This represents a player object, more things should probably be
;;; added, like location, inventory etc.
(defclass <net-player> (<player>)
  ;; The following are used to maintain the player.
  (thread    :accessor player-thread)
  (in-port   :accessor in-port)
  (out-port  :accessor out-port))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Globals

;;; This is the default port used by the server.
(define *default-port* 12321)

;;; Maximum number of simultaneous connections.
(define *max-players* 20)

;;; Protects the player list which is the only objects that is accessed
;;; in parallel by the server.
(define *players-mutex* (make-semaphore 1))

;;; This will be the tcp server object, and the thread that listens
;;; for new network players.
(define *server* #f)
(define *server-thread* #f)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Utilities

;;; Use this for debug output.
(define (eprintf . args)
  (apply fprintf (current-error-port) args))

(define (ereport error-type player exception)
  (if player
    (eprintf "~a: (~a) ~a [~a]~%"
             error-type
             (name+nick player)
             (exn-message exception)
             (server-time))
    (eprintf "~a: ~a [~a]~%"
             error-type
             (exn-message exception)
             (server-time))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Redefinitions

;;; *what* is redefined to kill the current thread if #f was the result
;;; since it means an end of file so the client is probably lost.
(define (*what* something)
  (echon "*WHAT* is" something "? ")
  (or (read-inp-line)
      (kill-thread (current-thread))))

;;; Redefine these to use the newline chars because this is what the
;;; client expects.
(define (echo . args)
  (apply echon args)
  (display *return-chars*)
  (flush-output))
(define (echo-ns . args)
  (apply echon-ns args)
  (display *return-chars*)
  (flush-output))

;;; Keep track of when threads are being killed.
(let ((old-kill kill-thread))
  (set! kill-thread (lambda (t)
                      (eprintf "Forcefully killing a thread~%")
                      (old-kill t))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Implementation


;;; These simply use the ports.
(defmethod (tell (p <net-player>) (s <string>))
  (parameterize ((current-output-port (out-port p)))
    (with-handlers ((void (lambda (x) (ereport "TELL-ERROR:" p x))))
      (call-next-method))))


(defmethod (get-player-input (p <net-player>) (prompt <string>))
  (parameterize ((current-output-port (out-port p))
                 ;; protect input reading
                 (current-input-port
                  (let ((p (in-port p)))
                    (define (getc)
                      (if (char-ready? p)
                        (read-char p)
                        (begin (sleep 0.1) (getc))))
                    (make-input-port
                     getc
                     (thunk (char-ready p))
                     (thunk (close p))))))
    (or (call-next-method) (destroy p))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Exercise 3 of Problem Set 5 asks you to implement this method.   ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; (defmethod (destroy (p <net-player>) ...)


;;; Announces that the player left the game and destroys the object
(defmethod (logoff (p <net-player>))
  (tell p "Good bye!")
  (eprintf "(~a) is logging out.~%" (name+nick p))
  (destroy p)
  ;; tell this to everyone
  (message-to-all
   (echos "<<<" (name+nick p) "has left the game >>>") p))


(define (make-net-player in out)
  (when (some (lambda (x) (not (instance-of? x <net-player>)))
              *players*)
    (error '<net-player> "you already have a single player."))
  (parameterize ((current-output-port out)
                 (current-input-port  in))
    ;; avoid garbage characters
    (let* ((nick+name (read-player-nick+name))
           (player (no-errors (make-player <net-player> nick+name))))
      ;; if the player was not initialized, then there's no need
      ;; to continue... there was an error, so just stop this
      ;; thread (spawned by the server-loop)
      (unless player
        (kill-thread (current-thread)))
      ;; now, store the current ports with the player object
      (set! (out-port player) out)
      (set! (in-port player) in)
      ;; Welcome the player to the game
      (greet player)
      (message-to-all
       (echos "<<<" (name+nick player) "has joined the game >>>")
       player)
      (semaphore-post (player-mutex player))))) ; wake up player-loop

;;; Specialize the way that <player> objects are created and give
;;; them an initial do-something
(defmethod (initialize (p <net-player>) initargs)
  (define (player-loop)
    (let ((t (with-handlers ((void (lambda (x) (destroy p) #f)))
               (and (player-exists? p) (do-something p)))))
      (when t
        ;; technically, this should be a number but there's been
        ;; a few errors with t being #<void> (still unknown why)
        ;; so just test to see that t is a number
        (when (number? t) (sleep t))
        (player-loop))))
  (call-next-method)                 ; must call this
  (semaphore-wait *players-mutex*)
  (set! *players* (cons p *players*))
  (semaphore-post *players-mutex*)
  ;;; Create the thread for the player loop
  (set! (player-thread p)
        (thread (thunk (begin  ; use begin to ensure order of evaluation
                         (semaphore-wait (player-mutex p))
                         (player-loop))))))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Exercise 1 of Problem Set 5 asks you to implement this thread.   ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; This is the server loop that will wait and create players for
;;; incoming connections.
;;; (define (server-loop) ...)

  
;;; Start the server loop.
(define (server-game)
  ;; set this to comply with telnet protocol
  (set! *return-chars* (string #\return #\linefeed))
  ;; reset the initial time, so the game start time appears accurate
  (set! *initial-time* (current-milliseconds))
  ;; setup the server to listen for new connections
  (set! *server* (tcp-listen *default-port*))
  (set! *server-thread* (thread server-loop))
  (echo "Server is ready and waiting for connections on port"
        *default-port*)
  ;; make a thread that will gc every 10 seconds to prevent memory
  ;; blowout.
  (letrec ((gc (thunk (sleep 10) (collect-garbage) (gc))))
    (thread gc))
  ;; Fill the event-queue...
  (for-each (lambda (x) (apply insert-event x)) *first-events*)
  ;; define the game
  (define-game)
  ;; this loop now runs forever - use a thread so it is still possible
  ;; to work with Scheme.
  (thread event-loop))