;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                             Players                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


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

;;; Player objects.
(defclass <player> (<animate>)
  ;; always have the same description, this is actually never used...
  (description :initvalue   "Human player.")
  ;; use an initializer so *initial-places* can change
  (location    :initializer (lambda (x) (random-elt *initial-places*)))
  ;; state stores an associative list, and is treated much like an
  ;; environment for the player.  It will hold things such as
  ;; the player's address, standing/sitting state, etc.
  (state       :type        <list>
               :accessor    state
               :initarg     :state
               :initvalue   '())
  ;; used to give a full name only the first time you get somehwere,
  ;; the first element is always the last you visited.
  (visited     :type        <list> ; (of <places>)
               :accessor    visited-places
               :initarg     :visited
               :initvalue   '())
  ;; holds the time of the last shout so players won't be too noisy
  (last-shout  :type        <number>
               :accessor    last-shout-time
               :initvalue   -1000)
  ;; Used for controlling execution in the player thread
  ;; by serializing the players actions
  (mutex       :accessor    player-mutex
               :initializer (lambda (x) (make-semaphore 0))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; Interface

;;; A predicate for players.
;;; (define (player? x) ...)

;;; Checks if a player object is still active.
(defgeneric (player-exists? player))

;;; Get input from a player.
(defgeneric (get-player-input player prompt))

;;; Returns a description of the object, possibly customized for the
;;; particular player asking for the description
(defgeneric (describe plyr game-object))

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

;;; Global list that hold player instances - used to make sure that we
;;; don't create invalid scenarios.
(define *players* '())


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

;;; A predicate for players.
(define (player? x)
  (instance-of? x <player>))


;;; Methods for game play

;;; Getting input is the same for all players - just read an expression.
(defmethod (get-player-input (p <player>) (prompt <string>))
  (echon prompt)
  (read-inp-line))

;;; A predicate that checks if a player object is still active.
(defmethod (player-exists? (p <player>))
  (memq p *players*))

;;; Default time for the next input event.
(defmethod (next-event-time (p <player>))
  0.5)

;;; Make this get and do the command for the player.
(defmethod (do-something (p <player>))
  (define (input-loop)
    (let ((inp (get-player-input p "> ")))
      (if inp
        ;; try to do it
        (let ((result (do-command p inp)))
          (cond
           ((not result)
            ;; a #f result says that we're done and no need for more
            ;; events to be generated.
            #f)
           ((string? result)
            ;; a string output means that we should do another command
            ;; immediately, show the result and loop.  An empty string
            ;; is not said.
            (unless (equal? "" result) (tell p result))
            (input-loop))
           ((number? result)
            ;; a number result is the delay until next input
            result)
           (else
            ;; other results means that the next input is at the
            ;; default time delay.
            (next-event-time p))))
        ;; got an eof
        (begin
          (logoff p)
          (error 'player-input "Received an EOF")))))
  (when (player-exists? p)
    (describe p (location p))
    ;; Make sure that current location is first in the list
    (set! (visited-places p)
          (cons (location p)
                (remq (location p) (visited-places p))))
    (input-loop)))


;;; Destruction methods

;;; Destroying player objects - once this is called it won't be a good
;;; idea to refer to the object so must use the above predicate.
(defmethod (destroy (p <player>))
  ;; drop everything in the inventory
  (call-next-method)
  (set! *players* (remq p *players*)))

;;; The default for logging off is to just destroy the player.
(defmethod (logoff (p <player>))
  (destroy p))

;;; Description methods

;;; When looking at a player, we only want to see a description.
;;; We don't want to see a set of commands.
(defmethod (describe (plyr <player>) (obj <player>))
  (list (random-elt
         '("You see a very intelligent person."
           "Hey, this is one of the other players."
           "What a nice treat! You found another person."
           "This one is classified as human."))))

;;; Augments the description method to include information about
;;; commands that pertain to it.
(defmethod (describe (plyr <player>) (obj <game-object>))
  (tell plyr (add "  " (description obj)))
  (let ((cmds (filter (lambda (c) (not (equal? (cmd-desc c) "")))
                      (commands plyr obj))))
    (unless (null? cmds)
      (tell plyr "  Things you can do:")
      (for-each (lambda (c)
                  (tell plyr (add "    " (cmd-desc c))))
                (commands plyr obj)))))