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


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

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

;;; Exits determine the distance between <place>s and have the lock
;;; and key to determine whether the exit can be taken
(defclass <exit> (<game-object>)
  (destination :type      <place>
               :accessor  destination
               :initarg   :destination)
  (locks       :type      <list>       ; list of predicates
               :accessor  locks
               :initarg   :locks
               :initvalue '())
  (distance    :type      <number>
               :accessor  distance
               :initarg   :distance
               :initvalue 0)
  (satisfy     :type      <function>   ; should be some or every
               :accessor  satisfy
               :initarg   :satisfy
               :initvalue some)
  (reason      :type      <string>
               :accessor  reason
               :initarg   :reason
               :initvalue ""))


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

;;; 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 filtered type msg))

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

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

;;; Gets the <exit> object so it can be modified or used
(defgeneric (get-exit place1 place2))

;;; Looks at the locks in the <exit> to see if the object can pass
(defgeneric (unlock? exit animate))

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

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


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

;;; This gives a description the location, its contents and its exits
;;; for a player.
(defmethod (describe (plyr <player>) (loc <place>))
  (define (tell-nicks xs)
    (for-each (lambda (x) (tell plyr (add "  " (name+nick x)))) xs))
  ;; if we didn't move - don't say the whole thing
  (when (or (null? (visited-places plyr))
            (not (eq? loc (first (visited-places plyr)))))
    (tell plyr (echos "You are"
                      (if (and (>= (length (visited-places plyr)) 2)
                               (eq? loc (second (visited-places plyr))))
                        "back in:"
                        "in:")
                      (name+nick loc)))
    (unless (memq loc (visited-places plyr))
      (tell plyr (add "  " (description loc))))
    (tell plyr (if (null? (exits loc))
                 "There are no exits!"
                 "From here you can go to:"))
    (tell-nicks (filter visible? (exits loc)))
    (let ((contents (remq plyr (contents loc))))
      (when (not (null? contents))
        (tell plyr "You can see:"))
      (tell-nicks (filter visible? contents)))))

;;; Say a message to everyone in a room.  The except argument is the
;;; an animate that should not receive the message - if it should be
;;; said to everyone, then use #f.
(defmethod (place-message (p <place>) filtered
                          type (msg <string>))
  (place-message p (list filtered) type msg))

;;; The except argument here is the list of animates that should not
;;; receive the message.  The first animate in the list is considered
;;; the originator of the message.
(defmethod (place-message (p <place>) (filtered <list>)
                          type (msg <string>))
  (for-each (lambda (x)
              (when (and (animate? x)
                         (or (not (memq x filtered))
                             ;; emote goes to the originator as well
                             (eq? type 'emote)))
                (message x (head filtered) type msg)))
            (contents p)))


;;; Methods for constructing the map

;;; Used when an exit has already been created - makes it possible for
;;; the exit to be different, such as a door. Ignore distance.
(defmethod (directed-connect (p <place>) (e <exit>) anything)
  (set! (exits p) (cons e (exits p))))

;;; Uses the destinations descriptions as the exit description.
(defmethod (directed-connect (p1 <place>) (p2 <place>) (nicks <list>))
  (let ((exit (make <exit> :name (name p2)
                    :nick nicks
                    :description
                      "You look, but it's too far to see anything"
                    :destination p2)))
    (directed-connect p1 exit #f)))

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

;;; Methods used in traversing the map

;;; Is the animate allowed to pass through the exit?
(define (unlock? (exit <exit>) (animate <animate>))
;;;  (define (try-locks locklist)
;;;    ((satisfy exit)            ; will be some or every
;;;     (lambda (p) (p animate))  ; test predicate
;;;     (locks exit)))            ; list of predicates
  (or (empty? (locks exit))
      ((satisfy exit)
       (lambda (p) (p animate))
       (locks exit))))
;;;      (try-locks (locks exit))))

(defmethod (get-exit (from <place>) (to <place>))
  (find-if (lambda (x) (eq? (destination x) to))
           (exits from)))

(defmethod (transfer (p <animate>) (from <place>) (to <exit>))
  (transfer p from (destination to)))

;;; Override transfer as a "go" operation.
(defmethod (transfer (p <animate>) (from <place>) (to <place>))
  (let ((exit (get-exit from to)))
    (cond
     ((eq? from to) 0) ; nothing to do...
     ((not exit) (echos (name to) "is no where nearby."))
     ((unlock? exit p)
      ;; the messages are reversed so the player won't see them
      (place-message from p 'leave (name to))
      (call-next-method)
      (place-message to p 'enter (name from))
      (tell p "")
      (tell p (echos "You go from" (name from) "to" (name to)))
      (distance exit))
     (else
      (reason exit)))))