;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                              Places                              ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


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

;;; Places hold stuff, and they have exits to other places.
(defclass <place> (<container>)
  (exits :type      <list> ; (of <place>s)
         :accessor  exits
         :initarg   :exits
         :initvalue '()))


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

;;; This describe a place with its exits and contents for a player.
;;; This is not used for the same purpose as the describe geeric.
(defgeneric (describe-location place been-player))

;;; Say a message to everyone in a room, possibly except for someone.
;;; The type argument is the type of the message, #f means just a string
;;; but can also be 'say 'emote, 'shout etc - see tell-message.
(defgeneric (place-message place msg originator type))

;;; One way conection from the first place to the second
(defgeneric (directed-connect place1 place2))

;;; This makes them mutually connected.
(defgeneric (connect place1 place2))


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

;;; This global is used for created players.  It will be set! when we
;;; have the place objects.
(define *initial-place* #f)

;;; And this global is used as the location of killed animates - to
;;; check whether an animate is dead see if its location slot is eq? to
;;; this.  There is no need for any information on this object.
(define *null-place* (make <place> :nick 'null :name "null"))


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

;;; This gives a description the location, its contents and its exits
;;; for a player.
(defmethod (describe-location (loc <place>) (p <player>))
  (define (tell-nicks list)
    (for-each (lambda (x) (tell p (add "  " (name+nick x)))) list))
  ;; if we didn't move - don't say the whole thing
  (when (or (null? (visited-places p))
            (not (eq? loc (first (visited-places p))))
            ;; note that the following line can be considered a hack,
            ;; since such things should be accomplished using generics.
            (instance-of? p <multi-player>))
    (tell p (echos "You are"
                   (if (and (>= (length (visited-places p)) 2)
                            (eq? loc (second (visited-places p))))
                     "back in:"
                     "in:")
                   (name+nick loc)))
    (unless (memq loc (visited-places p))
      (for-each (lambda (x) (tell p (add "  " x))) (description loc)))
    (tell p (if (null? (exits loc))
              "There are no exits!"
              "From here you can go to:"))
    (tell-nicks (exits loc))
    (let ((contents (remq p (contents loc))))
      (tell p (if (null? contents)
                "There is nothing else here."
                "You can see:"))
      (tell-nicks contents))))

;;; Say a message to everyone in a room.  The except argument can be a
;;; player that won't receive the message - if it should be said to
;;; everyone, then use #f.
(defmethod (place-message (p <place>) (msg <string>) originator type)
  (for-each (lambda (x)
              (when (and (listener? x)
                         (or (not (and originator (eq? x originator)))
                             ;; emote goes to the originator as well
                             (eq? type 'emote)))
                (if type
                  (message x originator type msg)
                  (tell x msg))))
            (contents p)))

(defmethod (directed-connect (p1 <place>) (p2 <place>))
  (set! (exits p1) (cons p2 (exits p1))))

(defmethod (connect (p1 <place>) (p2 <place>))
  (directed-connect p1 p2)
  (directed-connect p2 p1))

;;; Override transfer as a "go" operation.
(defmethod (transfer (p <listener>) (from <place>) (to <place>))
  (cond
   ((eq? from to) #t) ; nothing to do...
   ((memq to (exits from))
    ;; the messages are reversed so the player won't see them
    (place-message from (name to) p 'leave)
    (call-next-method)
    (place-message to (name from) p 'enter)
    (tell p (echos "You go from" (name from) "to" (name to))))
   (else
    (tell p (echos "You cannot go to" (name to)))))
  #t)